fail to open scalars containing characters that don't fit in a byte
authorTony Cook <tony@develop-help.com>
Thu, 24 Jan 2013 10:29:32 +0000 (21:29 +1100)
committerTony Cook <tony@develop-help.com>
Thu, 24 Jan 2013 23:27:29 +0000 (10:27 +1100)
ext/PerlIO-scalar/scalar.xs
ext/PerlIO-scalar/t/scalar.t

index d7b8828..d7c7ef6 100644 (file)
@@ -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);
index 7ab59c6..e71b385 100644 (file)
@@ -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");
 }