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

2 files changed, 8 insertions, 8 deletions

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index d7b8828fcb..d7c7ef69bb 100644
--- 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);
     }
+    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);
diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 7ab59c66da..e71b385d85 100644
--- 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);
-    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");
 }