summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-08-19 23:17:08 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-08-20 12:50:00 -0700
commit3a6ce63afe9bfc9bf645e0c127824d8426a7ee67 (patch)
tree6a994506662ea1964fea6cddf3afc61f994ca276
parent25451ceff7e8f05c501ecc72a1b3536005f391f7 (diff)
downloadperl-3a6ce63afe9bfc9bf645e0c127824d8426a7ee67.tar.gz
Fix skip logic in pad_tidy and cv_clone
Commit 325e1816dc changed the logic for determining whether a pad entry is to be treated like a constant; i.e., shared between recursion levels and sub clones. According the old logic, a pad entry must be shared if it is marked READONLY or is a shared hash key scalar. According to the new logic, the entry must be shared if the pad name has a zero-length PV (i.e., &PL_sv_no). Two pieces of code were still following the old logic. Changing them fixes this old bug: my $close_over_me; sub { () = $close_over_me; open my $fh, "/dev/null"; print "$$fh\n" }->(); __END__ Output: *main:: The name attached to the implicit rv2gv op in open() was not being copied by sub clones. The previous commit is also part of the fix. In the tests, I tested the combination of sub cloning and recursion, since it seemed like a good idea (and also as a result of copying and pasting :-). S_pmtrans was still relying on the old logic, so it gets changed, too.
-rw-r--r--op.c2
-rw-r--r--pad.c12
-rw-r--r--t/op/gv.t16
3 files changed, 22 insertions, 8 deletions
diff --git a/op.c b/op.c
index 44d2f203fb..c5964eb88f 100644
--- a/op.c
+++ b/op.c
@@ -4268,7 +4268,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
swash = MUTABLE_SV(swash_init("utf8", "", listsv, bits, none));
#ifdef USE_ITHREADS
- cPADOPo->op_padix = pad_alloc(OP_TRANS, SVs_PADTMP);
+ cPADOPo->op_padix = pad_alloc(OP_TRANS, SVf_READONLY);
SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix));
PAD_SETSV(cPADOPo->op_padix, swash);
SvPADTMP_on(swash);
diff --git a/pad.c b/pad.c
index d2b6c4fd81..d8d9322c60 100644
--- a/pad.c
+++ b/pad.c
@@ -1773,16 +1773,16 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
- if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
- continue;
/*
* The only things that a clonable function needs in its
- * pad are anonymous subs.
+ * pad are anonymous subs, constants and GVs.
* The rest are created anew during cloning.
*/
+ if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
+ continue;
if (!((namesv = namep[ix]) != NULL &&
- namesv != &PL_sv_undef &&
- *SvPVX_const(namesv) == '&'))
+ PadnamePV(namesv) &&
+ (!PadnameLEN(namesv) || *SvPVX_const(namesv) == '&')))
{
SvREFCNT_dec(PL_curpad[ix]);
PL_curpad[ix] = NULL;
@@ -2120,7 +2120,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
SvPADSTALE_on(sv);
}
}
- else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+ else if (IS_PADGV(ppad[ix]) || (namesv && PadnamePV(namesv))) {
sv = SvREFCNT_inc_NN(ppad[ix]);
}
else {
diff --git a/t/op/gv.t b/t/op/gv.t
index c01c5d21c2..7494e09ab8 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan( tests => 253 );
+plan( tests => 254 );
# type coercion on assignment
$foo = 'foo';
@@ -651,6 +651,20 @@ is join(' ', r(4)),
'*main::$fh *main::$fh *main::$fh *main::$fh *main::$fh',
'recursion does not cause lex handles to lose their names';
+# And sub cloning, too; not just recursion
+my $close_over_me;
+is join(' ', sub {
+ () = $close_over_me;
+ my @output;
+ @output = CORE::__SUB__->($_[0]-1) if $_[0];
+ open my $fh, "TEST";
+ push @output, $$fh;
+ close $fh;
+ @output;
+ }->(4)),
+ '*main::$fh *main::$fh *main::$fh *main::$fh *main::$fh',
+ 'sub cloning does not cause lex handles to lose their names';
+
# [perl #71254] - Assigning a glob to a variable that has a current
# match position. (We are testing that Perl_magic_setmglob respects globs'
# special used of SvSCREAM.)