This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t use CopFILESV for ‘once’ warnings
authorFather Chrysostomos <sprout@cpan.org>
Mon, 5 Aug 2013 08:55:31 +0000 (01:55 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 5 Aug 2013 09:23:37 +0000 (02:23 -0700)
CopFILESV points to ${"_<filename"}, which can be modified by Perl
code.  Under non-threaded builds, newGP (which records the file name
used by ‘used once’ warnings) was using CopFILESV for the file name.
It is safer just to use the name of the GV itself.

gv.c
t/lib/warnings/perl

diff --git a/gv.c b/gv.c
index b66eced..f66c6ba 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -165,7 +165,7 @@ Perl_newGP(pTHX_ GV *const gv)
     const char *file;
     STRLEN len;
 #ifndef USE_ITHREADS
-    SV * temp_sv;
+    GV *filegv;
 #endif
     dVAR;
 
@@ -193,10 +193,10 @@ Perl_newGP(pTHX_ GV *const gv)
 #else
     if(PL_curcop)
        gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
-    temp_sv = CopFILESV(PL_curcop);
-    if (temp_sv) {
-       file = SvPVX(temp_sv);
-       len = SvCUR(temp_sv);
+    filegv = CopFILEGV(PL_curcop);
+    if (filegv) {
+       file = GvNAME(filegv)+2;
+       len = GvNAMELEN(filegv)-2;
     } else {
        file = "";
        len = 0;
index 3a0af11..ad44bbe 100644 (file)
@@ -239,3 +239,10 @@ use warnings 'once';
 $foo++; BEGIN { eval q|@a =~ s///; sub foo;| }
 EXPECT
 Name "main::foo" used only once: possible typo at - line 3.
+########
+
+use warnings 'once';
+BEGIN { ${"_<".__FILE__} = \1 } # should not affect file name in warning
+$foo++;
+EXPECT
+Name "main::foo" used only once: possible typo at - line 4.