This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
warn and fail on writes to SVf_UTF8 SVs
authorTony Cook <tony@develop-help.com>
Thu, 24 Jan 2013 10:37:25 +0000 (21:37 +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 3be9944..e7e8330 100644 (file)
@@ -187,6 +187,12 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
        SvGETMAGIC(sv);
        if (!SvROK(sv)) sv_force_normal(sv);
        if (SvOK(sv)) SvPV_force_nomg_nolen(sv);
+       if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) {
+           if (ckWARN(WARN_UTF8))
+               Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
+           SETERRNO(EINVAL, SS_IVCHAN);
+           return 0;
+       }
        if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
            dst = SvGROW(sv, SvCUR(sv) + count + 1);
            offset = SvCUR(sv);
index 833bb20..d6bd8cf 100644 (file)
@@ -447,7 +447,6 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in
     seek($fh, 1, SEEK_SET);
     ok((print $fh "A"), "print to an upgraded byte string");
     seek($fh, 1, SEEK_SET);
-    local $TODO = "write to utf8 flagged strings is broken";
     is($content, "\xA1A\xA3", "check result");
 
     $content = "\x{101}\x{102}\x{103}";