This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$foo::_ was wrongly forced as $main::_.
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 3 Dec 2004 21:51:45 +0000 (21:51 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 3 Dec 2004 21:51:45 +0000 (21:51 +0000)
Since we still want "our $_" to be always forced to $main::_,
deplace the forcing code at our-pad allocation time.
(Making execution probably a tiny bit faster)

p4raw-id: //depot/perl@23608

gv.c
op.c
t/op/mydef.t

diff --git a/gv.c b/gv.c
index 64acb37..7f630d9 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -702,10 +702,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     }
     len = namend - name;
 
-    /* $_ should always be in main:: even when our'ed */
-    if (*name == '_' && !name[1])
-       stash = PL_defstash;
-
     /* No stash in name, so see how we can default */
 
     if (!stash) {
diff --git a/op.c b/op.c
index 8a5c765..96be415 100644 (file)
--- a/op.c
+++ b/op.c
@@ -256,7 +256,8 @@ Perl_allocmy(pTHX_ char *name)
     off = pad_add_name(name,
                    PL_in_my_stash,
                    (PL_in_my == KEY_our 
-                       ? (PL_curstash ? PL_curstash : PL_defstash)
+                       /* $_ is always in main::, even with our */
+                       ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
                        : Nullhv
                    ),
                    0 /*  not fake */
index f089c31..d2ff35b 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..66\n";
+print "1..70\n";
 
 my $test = 0;
 sub ok ($$) {
@@ -189,3 +189,12 @@ END { unlink $file; }
     ok( $x eq "hello\n", 'reading from <$_> works' );
     close $_;
 }
+
+{
+    $fqdb::_ = 'fqdb';
+    ok( $fqdb::_ eq 'fqdb', 'fully qualified $_ is not in main' );
+    ok( eval q/$fqdb::_/ eq 'fqdb', 'fully qualified, evaled $_ is not in main' );
+    package fqdb;
+    ::ok( $_ ne 'fqdb', 'unqualified $_ is in main' );
+    ::ok( q/$_/ ne 'fqdb', 'unqualified, evaled $_ is in main' );
+}