summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-12-03 21:51:45 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-12-03 21:51:45 +0000
commit133706a6af5890d9737eb5c4dacb6252623311ea (patch)
tree9cfa88f97ca4f18c0a72ee7f852eb9feda593dfe
parent7a1e2023d90d879c7a6110f7be3e3c6e22bddc33 (diff)
downloadperl-133706a6af5890d9737eb5c4dacb6252623311ea.tar.gz
$foo::_ was wrongly forced as $main::_.
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
-rw-r--r--gv.c4
-rw-r--r--op.c3
-rw-r--r--t/op/mydef.t11
3 files changed, 12 insertions, 6 deletions
diff --git a/gv.c b/gv.c
index 64acb371b3..7f630d94a2 100644
--- 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 8a5c765bc7..96be415fd7 100644
--- 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 */
diff --git a/t/op/mydef.t b/t/op/mydef.t
index f089c31b0c..d2ff35b686 100644
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -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' );
+}