List assignment to fake globs fails #10588
Comments
From @cpansproutSee ticket #1804. This bug occurs with list assignment as well: $ perl5.13.4 -le' $f = *a; *$f = {}; print $f' Flags: Site configuration information for perl 5.13.4: Configured by sprout at Sun Aug 29 17:21:22 PDT 2010. Summary of my perl5 (revision 5 version 13 subversion 4 patch v5.13.4-30-g9b47cdd) configuration: Locally applied patches: @INC for perl 5.13.4: Environment for perl 5.13.4: |
From @cpansproutOn Aug 29, 2010, at 6:48 PM, Father Chrysostomos wrote:
I’ve attached a patch for this. I recommend against applying it, though. When I had almost finished writing, I realised what the real problem was. That is described in ticket #77810. |
From @cpansproutInline Patchdiff -Nup blead-77508-fake-glob-list-assignment.base/op.c blead-77508-fake-glob-list-assignment/op.c
--- blead-77508-fake-glob-list-assignment.base/op.c 2010-08-23 03:36:10.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/op.c 2010-09-06 20:34:15.000000000 -0700
@@ -4479,6 +4479,11 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *le
} else {
/* Other ops in the list. */
maybe_common_vars = TRUE;
+
+ if (lop->op_type == OP_RV2GV) {
+ o->op_flags |= OPf_SPECIAL;
+ lop->op_private |= OPpAASSIGN_LHS;
+ }
}
lop = lop->op_sibling;
}
@@ -5372,6 +5377,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *lab
iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
sv->op_type = OP_RV2GV;
sv->op_ppaddr = PL_ppaddr[OP_RV2GV];
+ sv->op_private &= ~1; /* rv2gv uses this bit */
/* The op_type check is needed to prevent a possible segfault
* if the loop variable is undeclared and 'strict vars' is in
@@ -7084,7 +7090,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
PERL_ARGS_ASSERT_CK_RVCONST;
o->op_private |= (PL_hints & HINT_STRICT_REFS);
- if (o->op_type == OP_RV2CV)
+ if (o->op_type == OP_RV2CV || o->op_type == OP_RV2GV)
o->op_private &= ~1;
if (kid->op_type == OP_CONST) {
diff -Nup blead-77508-fake-glob-list-assignment.base/op.h blead-77508-fake-glob-list-assignment/op.h
--- blead-77508-fake-glob-list-assignment.base/op.h 2010-08-20 18:55:11.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/op.h 2010-09-06 16:24:03.000000000 -0700
@@ -138,6 +138,8 @@ Deprecated. Use C<GIMME_V> instead.
/* On OP_SMARTMATCH, an implicit smartmatch */
/* On OP_ANONHASH and OP_ANONLIST, create a
reference to the new anon hash or array */
+ /* On OP_AASSIGN, there are globs on the
+ LHS. */
/* On OP_ENTER, store caller context */
/* On OP_HELEM and OP_HSLICE, localization will be followed
by assignment, so do not wipe the target if it is special
@@ -218,6 +220,7 @@ Deprecated. Use C<GIMME_V> instead.
#define OPpDONT_INIT_GV 4 /* Call gv_fetchpv with GV_NOINIT */
/* (Therefore will return whatever is currently in the symbol table, not
guaranteed to be a PVGV) */
+#define OPpAASSIGN_LHS 1 /* On LHS of list assignment */
/* OP_RV2CV only */
#define OPpMAY_RETURN_CONSTANT 1 /* If a constant sub, return the constant */
diff -Nup blead-77508-fake-glob-list-assignment.base/pp.c blead-77508-fake-glob-list-assignment/pp.c
--- blead-77508-fake-glob-list-assignment.base/pp.c 2010-08-20 16:24:10.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/pp.c 2010-09-06 21:32:18.000000000 -0700
@@ -217,7 +217,10 @@ PP(pp_rv2gv)
}
if (PL_op->op_private & OPpLVAL_INTRO)
save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
- SETs(sv);
+ if (PL_op->op_type == OP_RV2GV && PL_op->op_private & OPpAASSIGN_LHS) {
+ SETs(&PL_sv_placeholder); XPUSHs(sv);
+ }
+ else SETs(sv);
RETURN;
}
diff -Nup blead-77508-fake-glob-list-assignment.base/pp_hot.c blead-77508-fake-glob-list-assignment/pp_hot.c
--- blead-77508-fake-glob-list-assignment.base/pp_hot.c 2010-08-20 18:55:11.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/pp_hot.c 2010-09-06 17:18:03.000000000 -0700
@@ -998,6 +998,7 @@ PP(pp_aassign)
int magic;
int duplicates = 0;
SV **firsthashrelem = NULL; /* "= 0" keeps gcc 2.95 quiet */
+ const bool glob_assign = PL_op->op_flags & OPf_SPECIAL;
PL_delaymagic = DM_DELAY; /* catch simultaneous items */
gimme = GIMME_V;
@@ -1094,7 +1095,14 @@ PP(pp_aassign)
}
break;
default:
- if (SvIMMORTAL(sv)) {
+ {
+ bool wasfake = FALSE;
+ if (glob_assign && sv == &PL_sv_placeholder) {
+ sv = *lelem++;
+ if (isGV_with_GP(sv) && (wasfake = SvFAKE(sv) ? 1 : 0))
+ SvFAKE_off(sv);
+ }
+ else if (SvIMMORTAL(sv)) {
if (relem <= lastrelem)
relem++;
break;
@@ -1106,7 +1114,9 @@ PP(pp_aassign)
else
sv_setsv(sv, &PL_sv_undef);
SvSETMAGIC(sv);
+ if (wasfake) SvFAKE_on(sv);
break;
+ }
}
}
if (PL_delaymagic & ~DM_DELAY) {
diff -rup blead-77508-fake-glob-list-assignment.base/ext/B/B/Concise.pm blead-77508-fake-glob-list-assignment/ext/B/B/Concise.pm
--- blead-77508-fake-glob-list-assignment.base/ext/B/B/Concise.pm 2010-06-21 14:31:10.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/ext/B/B/Concise.pm 2010-09-07 06:28:37.000000000 -0700
@@ -609,6 +609,7 @@ $priv{"leaveloop"}{64} = "CONT";
$priv{$_}{4} = "DREFed" for (qw(rv2sv rv2av rv2hv));
@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
for (qw(rv2gv rv2sv padsv aelem helem));
+@{$priv{rv2gv}}{1,4} = ("LHS","NOINIT");
$priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
@{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD");
@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
diff -rup blead-77508-fake-glob-list-assignment.base/ext/B/t/f_map.t blead-77508-fake-glob-list-assignment/ext/B/t/f_map.t
--- blead-77508-fake-glob-list-assignment.base/ext/B/t/f_map.t 2009-11-19 08:51:38.000000000 -0800
+++ blead-77508-fake-glob-list-assignment/ext/B/t/f_map.t 2010-09-07 06:21:43.000000000 -0700
@@ -169,7 +169,7 @@ checkOptree(note => q{},
# b <#> gv[*array] s
# c <1> rv2av[t6] sKRM/1
# d <#> gv[*_] s
-# e <1> rv2gv sKRM/1
+# e <1> rv2gv sKRM
# f <{> enteriter(next->q last->t redo->g) lKS/8
# r <0> iter s
# s <|> and(other->g) K/1
@@ -202,7 +202,7 @@ EOT_EOT
# b <$> gv(*array) s
# c <1> rv2av[t3] sKRM/1
# d <$> gv(*_) s
-# e <1> rv2gv sKRM/1
+# e <1> rv2gv sKRM
# f <{> enteriter(next->q last->t redo->g) lKS/8
# r <0> iter s
# s <|> and(other->g) K/1
diff -rup blead-77508-fake-glob-list-assignment.base/ext/B/t/optree_samples.t blead-77508-fake-glob-list-assignment/ext/B/t/optree_samples.t
--- blead-77508-fake-glob-list-assignment.base/ext/B/t/optree_samples.t 2010-05-04 03:23:11.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/ext/B/t/optree_samples.t 2010-09-07 06:22:45.000000000 -0700
@@ -531,7 +531,7 @@ checkOptree ( name => '%h=(); for $_(@a)
# 9 <#> gv[*a] s
# a <1> rv2av[t6] sKRM/1
# b <#> gv[*_] s
-# c <1> rv2gv sKRM/1
+# c <1> rv2gv sKRM
# d <{> enteriter(next->o last->r redo->e) lKS/8
# p <0> iter s
# q <|> and(other->e) K/1
@@ -561,7 +561,7 @@ EOT_EOT
# 9 <$> gv(*a) s
# a <1> rv2av[t3] sKRM/1
# b <$> gv(*_) s
-# c <1> rv2gv sKRM/1
+# c <1> rv2gv sKRM
# d <{> enteriter(next->o last->r redo->e) lKS/8
# p <0> iter s
# q <|> and(other->e) K/1
diff -rup blead-77508-fake-glob-list-assignment.base/t/op/gv.t blead-77508-fake-glob-list-assignment/t/op/gv.t
--- blead-77508-fake-glob-list-assignment.base/t/op/gv.t 2010-07-26 01:29:10.000000000 -0700
+++ blead-77508-fake-glob-list-assignment/t/op/gv.t 2010-09-06 20:38:31.000000000 -0700
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
require './test.pl';
-plan( tests => 192 );
+plan( tests => 193 );
# type coersion on assignment
$foo = 'foo';
@@ -624,6 +624,7 @@ is (scalar $::{fake}, "*main::sym",
"Localized FAKE glob's value was correctly restored");
# [perl #1804] *$x assignment when $x is a copy of another glob
+# And [perl #77508] (same thing with list assignment)
{
no warnings 'once';
my $x = *_random::glob_that_is_not_used_elsewhere;
@@ -632,6 +633,12 @@ is (scalar $::{fake}, "*main::sym",
"$x", '*_random::glob_that_is_not_used_elsewhere',
'[perl #1804] *$x assignment when $x is FAKE',
);
+ $x = *_random::glob_that_is_not_used_elsewhere;
+ (my $dummy, *$x) = (undef,[]);
+ is(
+ "$x", '*_random::glob_that_is_not_used_elsewhere',
+ '[perl #77508] *$x list assignment when $x is FAKE',
+ ) or require Devel::Peek, Devel::Peek::Dump($x);
}
__END__ |
From @cpansproutOn Sun Sep 12 12:34:21 2010, sprout wrote:
This was fixed by 2acc331. The tests in the patch have been |
From [Unknown Contact. See original ticket]On Sun Sep 12 12:34:21 2010, sprout wrote:
This was fixed by 2acc331. The tests in the patch have been |
|
@cpansprout - Status changed from 'new' to 'resolved' |
Migrated from rt.perl.org#77508 (status was 'resolved')
Searchable as RT77508$
The text was updated successfully, but these errors were encountered: