op.c: Scalar filehandles in errors UTF8 cleanup.

diff --git a/op.c b/op.c
index c08edd0..3a3acb8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7829,6 +7829,7 @@ Perl_ck_fun(pTHX_ OP *o)
                        if (is_handle_constructor(o,numargs)) {
                             const char *name = NULL;
                            STRLEN len = 0;
+                            U32 name_utf8 = 0;
 
                            flags = 0;
                            /* Set a flag to tell rv2gv to vivify
@@ -7840,6 +7841,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                SV *const namesv
                                    = PAD_COMPNAME_SV(kid->op_targ);
                                name = SvPV_const(namesv, len);
+                                name_utf8 = SvUTF8(namesv);
                            }
                            else if (kid->op_type == OP_RV2SV
                                     && kUNOP->op_first->op_type == OP_GV)
@@ -7847,6 +7849,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                GV * const gv = cGVOPx_gv(kUNOP->op_first);
                                name = GvNAME(gv);
                                len = GvNAMELEN(gv);
+                                name_utf8 = GvNAMEUTF8(gv) ? SVf_UTF8 : 0;
                            }
                            else if (kid->op_type == OP_AELEM
                                     || kid->op_type == OP_HELEM)
@@ -7886,6 +7889,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                      }
                                      if (tmpstr) {
                                           name = SvPV_const(tmpstr, len);
+                                           name_utf8 = SvUTF8(tmpstr);
                                           sv_2mortal(tmpstr);
                                      }
                                 }
@@ -7903,6 +7907,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                if (*name != '$')
                                    sv_setpvs(namesv, "$");
                                sv_catpvn(namesv, name, len);
+                                if ( name_utf8 ) SvUTF8_on(namesv);
                            }
                        }
                        kid->op_sibling = 0;

diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 0e1b08f..338fc02 100644 (file)
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -165,7 +165,6 @@ 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';
@@ -318,7 +317,6 @@ 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 );

diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index 225d9ec..6975627 100644 (file)
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -659,7 +659,7 @@ lstat() on filehandle FH at - line 5.
 lstat() on filehandle FH at - line 6.
 lstat() on filehandle $fh at - line 8.
 ########
-# TODO ? 1 ? "Scalar filehandles not yet UTF-8 clean" : ''
+
 # pp_sys.c [pp_lstat]
 use warnings 'io';
 use utf8;
@@ -674,8 +674,8 @@ lstat $ｆᚺ;
 close ᶠḨ;
 close $ｆᚺ;
 EXPECT
-lstat() on filehandle ᶠḨ at - line 6.
-lstat() on filehandle $ｆᚺ at - line 8.
+lstat() on filehandle ᶠḨ at - line 7.
+lstat() on filehandle $ｆᚺ at - line 9.
 ########
 # pp_sys.c [pp_getc]
 use warnings qw(unopened closed) ;
@@ -750,7 +750,7 @@ EXPECT
 Opening dirhandle FOO also as a file at - line 5.
 Opening dirhandle $foo also as a file at - line 6.
 ########
-# TODO ? 1 ? "Scalar filehandles not yet UTF-8 clean" : ''
+
 # pp_sys.c [pp_open]
 use utf8;
 use open qw( :utf8 :std );
@@ -763,8 +763,8 @@ no warnings qw(io deprecated);
 open ＦＯＯ, "../harness";
 open $ｆｏｏ, "../harness";
 EXPECT
-Opening dirhandle ＦＯＯ also as a file at - line 7.
-Opening dirhandle $ｆｏｏ also as a file at - line 8.
+Opening dirhandle ＦＯＯ also as a file at - line 8.
+Opening dirhandle $ｆｏｏ also as a file at - line 9.
 ########
 # pp_sys.c [pp_open_dir]
 use warnings;
@@ -779,7 +779,7 @@ EXPECT
 Opening filehandle FOO also as a directory at - line 5.
 Opening filehandle $foo also as a directory at - line 6.
 ########
-# TODO ? 1 ? "Scalar filehandles not yet UTF-8 clean" : ''
+
 # pp_sys.c [pp_open_dir]
 use utf8;
 use open qw( :utf8 :std );
@@ -793,8 +793,8 @@ no warnings qw(io deprecated);
 opendir ＦＯＯ, ".";
 opendir $ｆｏｏ, ".";
 EXPECT
-Opening filehandle ＦＯＯ also as a directory at - line 7.
-Opening filehandle $ｆｏｏ also as a directory at - line 8.
+Opening filehandle ＦＯＯ also as a directory at - line 9.
+Opening filehandle $ｆｏｏ also as a directory at - line 10.
 ########
 # pp_sys.c [pp_*dir]
 use warnings 'io';
@@ -827,7 +827,7 @@ seekdir() attempted on invalid dirhandle $foo at - line 16.
 rewinddir() attempted on invalid dirhandle $foo at - line 17.
 closedir() attempted on invalid dirhandle $foo at - line 18.
 ########
-# TODO ? 1 ? "Scalar filehandles not yet UTF-8 clean" : ''
+
 # pp_sys.c [pp_*dir]
 use utf8;
 use open qw( :utf8 :std );
@@ -852,13 +852,13 @@ rewinddir($ｆｏｏ);
 closedir($ｆｏｏ);
 
 EXPECT
-readdir() attempted on invalid dirhandle ＦＯＯ at - line 12.
-telldir() attempted on invalid dirhandle ＦＯＯ at - line 13.
-seekdir() attempted on invalid dirhandle ＦＯＯ at - line 14.
-rewinddir() attempted on invalid dirhandle ＦＯＯ at - line 15.
-closedir() attempted on invalid dirhandle ＦＯＯ at - line 16.
-readdir() attempted on invalid dirhandle $ｆｏｏ at - line 18.
-telldir() attempted on invalid dirhandle $ｆｏｏ at - line 19.
-seekdir() attempted on invalid dirhandle $ｆｏｏ at - line 20.
-rewinddir() attempted on invalid dirhandle $ｆｏｏ at - line 21.
-closedir() attempted on invalid dirhandle $ｆｏｏ at - line 22.
+readdir() attempted on invalid dirhandle ＦＯＯ at - line 13.
+telldir() attempted on invalid dirhandle ＦＯＯ at - line 14.
+seekdir() attempted on invalid dirhandle ＦＯＯ at - line 15.
+rewinddir() attempted on invalid dirhandle ＦＯＯ at - line 16.
+closedir() attempted on invalid dirhandle ＦＯＯ at - line 17.
+readdir() attempted on invalid dirhandle $ｆｏｏ at - line 19.
+telldir() attempted on invalid dirhandle $ｆｏｏ at - line 20.
+seekdir() attempted on invalid dirhandle $ｆｏｏ at - line 21.
+rewinddir() attempted on invalid dirhandle $ｆｏｏ at - line 22.
+closedir() attempted on invalid dirhandle $ｆｏｏ at - line 23.