warn and fail on writes to SVf_UTF8 SVs

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index 3be9944..e7e8330 100644 (file)
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -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);

diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 833bb20..d6bd8cf 100644 (file)
--- a/ext/PerlIO-scalar/t/scalar.t
+++ b/ext/PerlIO-scalar/t/scalar.t
@@ -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}";