This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
doio.c: Make warnings UTF8- and nul-clean
authorBrian Fraser <fraserbn@gmail.com>
Wed, 28 Sep 2011 03:33:02 +0000 (20:33 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:11 +0000 (13:01 -0700)
doio.c
t/lib/warnings/doio

diff --git a/doio.c b/doio.c
index 022b499..9d06cbe 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -126,8 +126,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        if (result == EOF && fd > PL_maxsysfd) {
            /* Why is this not Perl_warn*() call ? */
            PerlIO_printf(Perl_error_log,
-                         "Warning: unable to close filehandle %s properly.\n",
-                         GvENAME(gv));
+                         "Warning: unable to close filehandle %"SVf" properly.\n",
+                         SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
        }
        IoOFP(io) = IoIFP(io) = NULL;
     }
@@ -541,14 +541,14 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STD%s reopened as %s only for input",
+                           "Filehandle STD%s reopened as %"SVf" only for input",
                            ((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
-                           GvENAME(gv));
+                           SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STDIN reopened as %s only for output",
-                           GvENAME(gv));
+                           "Filehandle STDIN reopened as %"SVf" only for output",
+                           SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
        }
     }
 
@@ -1337,8 +1337,8 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
            return PL_laststatval;
        }
        if (ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
-                   GvENAME(cGVOP_gv));
+           Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %"SVf,
+                   SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(cGVOP_gv)))));
        }
        return (PL_laststatval = -1);
     }
index 8f6e558..0e1b08f 100644 (file)
@@ -164,6 +164,20 @@ no warnings 'io';
 EXPECT
 Use of -l on filehandle STDIN at - line 3.
 ########
+# doio.c [Perl_my_stat]
+# TODO ? 1 ? "Scalar filehandles aren't yet clean" : ''
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'io';
+-l $ᶠᚻ;
+open $ᶠᚻ, $0 or die "# $!";
+-l $ᶠᚻ;
+no warnings 'io';
+-l $ᶠᚻ;
+close $ᶠᚻ;
+EXPECT
+Use of -l on filehandle $ᶠᚻ at - line 7.
+########
 # doio.c [Perl_do_aexec5]
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
@@ -264,6 +278,27 @@ Filehandle STDOUT reopened as FH1 only for input at - line 14.
 ########
 # doio.c [Perl_do_openn]
 use Config;
+use utf8;
+use open qw( :utf8 :std );
+BEGIN {
+    if (!$Config{useperlio}) {
+       print <<EOM;
+SKIPPED
+# warns only with perlio
+EOM
+       exit;
+    }
+}
+use warnings 'io' ;
+close STDOUT;
+open ᶠᚻ1, "../harness"; close ᶠᚻ1;
+no warnings 'io' ;
+open ᶠᚻ2, "../harness"; close ᶠᚻ2;
+EXPECT
+Filehandle STDOUT reopened as ᶠᚻ1 only for input at - line 16.
+########
+# doio.c [Perl_do_openn]
+use Config;
 BEGIN {
     if (!$Config{useperlio}) {
        print <<EOM;
@@ -281,3 +316,48 @@ open my $fh2, ">doiowarn.tmp"; close $fh2;
 unlink "doiowarn.tmp";
 EXPECT
 Filehandle STDIN reopened as $fh1 only for output at - line 14.
+########
+# doio.c [Perl_do_openn]
+# TODO ? 1 ? "Scalar filehandles aren't yet clean" : ''
+use Config;
+use utf8;
+use open qw( :utf8 :std );
+BEGIN {
+    if (!$Config{useperlio}) {
+       print <<EOM;
+SKIPPED
+# warns only with perlio
+EOM
+       exit;
+    }
+}
+use warnings 'io' ;
+close STDIN;
+open my $ᶠᚻ1, ">doiowarn.tmp"; close $ᶠᚻ1;
+no warnings 'io' ;
+open my $ᶠᚻ2, ">doiowarn.tmp"; close $ᶠᚻ2;
+unlink "doiowarn.tmp";
+EXPECT
+Filehandle STDIN reopened as $ᶠᚻ1 only for output at - line 16.
+########
+# doio.c [Perl_do_openn]
+use Config;
+use utf8;
+use open qw( :utf8 :std );
+BEGIN {
+    if (!$Config{useperlio}) {
+       print <<EOM;
+SKIPPED
+# warns only with perlio
+EOM
+       exit;
+    }
+}
+use warnings 'io' ;
+close STDIN;
+open ᶠᚻ1, ">doiowarn.tmp"; close ᶠᚻ1;
+no warnings 'io' ;
+open ᶠᚻ2, ">doiowarn.tmp"; close ᶠᚻ2;
+unlink "doiowarn.tmp";
+EXPECT
+Filehandle STDIN reopened as ᶠᚻ1 only for output at - line 16.