Skip to content

Commit

Permalink
fail to open scalars containing characters that don't fit in a byte
Browse files Browse the repository at this point in the history
  • Loading branch information
tonycoz committed Jan 24, 2013
1 parent 7af8b2b commit 02c3c86
Show file tree
Hide file tree
Showing 2 changed files with 8 additions and 8 deletions.
8 changes: 8 additions & 0 deletions ext/PerlIO-scalar/scalar.xs
Expand Up @@ -52,6 +52,14 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
sv_force_normal(s->var);
SvCUR_set(s->var, 0);
}
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");
SETERRNO(EINVAL, SS_IVCHAN);
SvREFCNT_dec(s->var);
s->var = Nullsv;
return -1;
}
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
{
sv_force_normal(s->var);
Expand Down
8 changes: 0 additions & 8 deletions ext/PerlIO-scalar/t/scalar.t
Expand Up @@ -388,34 +388,26 @@ SKIP: {
# [perl #109828] PerlIO::scalar does not handle UTF-8
{
use Errno qw(EINVAL);
my $todo = "open doesn't know about UTf-8 scalars";
local $TODO = $todo;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, "@_" };
my $content = "12\x{101}";
$! = 0;
ok(!open(my $fh, "<", \$content), "non-byte open should fail");
is(0+$!, EINVAL, "check \$! is updated");
undef $TODO;
is_deeply(\@warnings, [], "should be no warnings (yet)");
use warnings "utf8";
$TODO = $todo;
$! = 0;
ok(!open(my $fh, "<", \$content), "non byte open should fail (and warn)");
is(0+$!, EINVAL, "check \$! is updated even when we warn");
$TODO = $todo;
my $warning = "Strings with code points over 0xFF may not be mapped into in-memory file handles\n";
is_deeply(\@warnings, [ $warning ], "should have warned");
@warnings = ();
$content = "12\xA1";
utf8::upgrade($content);
undef $TODO;
ok(open(my $fh, "<", \$content), "open upgraded scalar");
$TODO = $todo;
my $tmp;
is(read($fh, $tmp, 4), 3, "read should get the downgraded bytes");
is($tmp, "12\xA1", "check we got the expected bytes");
close $fh;
undef $TODO;
is_deeply(\@warnings, [], "should be no more warnings");
}

0 comments on commit 02c3c86

Please sign in to comment.