fail to open scalars containing characters that don't fit in a byte

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index d7b8828..d7c7ef6 100644 (file)
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -52,6 +52,14 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        sv_force_normal(s->var);
        SvCUR_set(s->var, 0);
     }
        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);
     if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
     {
        sv_force_normal(s->var);

diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 7ab59c6..e71b385 100644 (file)
--- a/ext/PerlIO-scalar/t/scalar.t
+++ b/ext/PerlIO-scalar/t/scalar.t
@@ -388,34 +388,26 @@ SKIP: {
 # [perl #109828] PerlIO::scalar does not handle UTF-8
 {
     use Errno qw(EINVAL);
 # [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");
     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";
     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");
     $! = 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);
     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");
     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;
     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");
 }
     is_deeply(\@warnings, [], "should be no more warnings");
 }