#include "perliol.h"
+static const char code_point_warning[] =
+ "Strings with code points over 0xFF may not be mapped into in-memory file handles\n";
+
typedef struct {
struct _PerlIO base; /* Base "class" info */
SV *var;
}
if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) {
if (ckWARN(WARN_UTF8))
- Perl_warner(aTHX_ packWARN(WARN_UTF8), "Strings with code points over 0xFF may not be mapped into in-memory file handles\n");
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
SETERRNO(EINVAL, SS_IVCHAN);
SvREFCNT_dec(s->var);
s->var = Nullsv;
STRLEN len;
I32 got;
p = SvPV(sv, len);
+ if (SvUTF8(sv)) {
+ if (sv_utf8_downgrade(sv, TRUE)) {
+ p = SvPV_nomg(sv, len);
+ }
+ else {
+ if (ckWARN(WARN_UTF8))
+ Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
+ SETERRNO(EINVAL, SS_IVCHAN);
+ return -1;
+ }
+ }
got = len - (STRLEN)(s->posn);
if (got <= 0)
return 0;
}
{ # changes after open
my $content = "abc";
- ok(open(my $fh, "<", \$content), "open a scalar");
+ ok(open(my $fh, "+<", \$content), "open a scalar");
my $tmp;
is(read($fh, $tmp, 1), 1, "basic read");
seek($fh, 1, SEEK_SET);
$content = "\xA1\xA2\xA3";
utf8::upgrade($content);
is(read($fh, $tmp, 1), 1, "read from post-open upgraded scalar");
- local $TODO = "read doesn't handle a post open non-byte scalar";
is($tmp, "\xA2", "check we read the correct value");
seek($fh, 1, SEEK_SET);
$content = "\x{101}\x{102}\x{103}";
$! = 0;
is(read($fh, $tmp, 1), undef, "read from scalar with >0xff chars");
is(0+$!, EINVAL, "check errno set correctly");
- {
- local $TODO;
- is_deeply(\@warnings, [], "should be no warning (yet)");
- }
+ is_deeply(\@warnings, [], "should be no warning (yet)");
use warnings "utf8";
seek($fh, 1, SEEK_SET);
is(read($fh, $tmp, 1), undef, "read from scalar with >0xff chars");