diff options
Diffstat (limited to 'ext/PerlIO-scalar')
-rw-r--r-- | ext/PerlIO-scalar/scalar.xs | 8 | ||||
-rw-r--r-- | ext/PerlIO-scalar/t/scalar.t | 8 |
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"); } |