List assignment to fake globs fails

[p5pRT]

Migrated from rt.perl.org#77508 (status was 'resolved')

Searchable as RT77508$

[p5pRT]

From @cpansprout

See ticket #1804. This bug occurs with list assignment as well​:

$ perl5.13.4 -le' $f = *a; *$f = {}; print $f'
*main​::a
$ perl5.13.4 -le' $f = *a; (*$f) = {}; print $f'
HASH(0x8039f0)

---

Flags​:
  category=core
  severity=low

---

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​:
  Snapshot of​: 9b47cdd
  Platform​:
  osname=darwin, osvers=10.4.0, archname=darwin-thread-multi-2level
  uname='darwin pint.local 10.4.0 darwin kernel version 10.4.0​: fri apr 23 18​:28​:53 pdt 2010; root​:xnu-1504.7.4~1release_i386 i386 '
  config_args='-de -Dusedevel -Duseithreads'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=undef, use64bitall=undef, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include',
  optimize='-O3',
  cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.2.1 (Apple Inc. build 5664)', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib
  libs=-ldbm -ldl -lm -lutil -lc
  perllibs=-ldl -lm -lutil -lc
  libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector'

Locally applied patches​:
 

---

@​INC for perl 5.13.4​:
  /usr/local/lib/perl5/site_perl/5.13.4/darwin-thread-multi-2level
  /usr/local/lib/perl5/site_perl/5.13.4
  /usr/local/lib/perl5/5.13.4/darwin-thread-multi-2level
  /usr/local/lib/perl5/5.13.4
  /usr/local/lib/perl5/site_perl
  .

---

Environment for perl 5.13.4​:
  DYLD_LIBRARY_PATH (unset)
  HOME=/Users/sprout
  LANG=en_US.UTF-8
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/usr/bin​:/bin​:/usr/sbin​:/sbin​:/usr/local/bin​:/usr/X11/bin​:/usr/local/bin
  PERL_BADLANG (unset)
  SHELL=/bin/bash

[p5pRT]

From @cpansprout

On Aug 29, 2010, at 6​:48 PM, Father Chrysostomos wrote​:

See ticket #1804. This bug occurs with list assignment as well​:

$ perl5.13.4 -le' $f = *a; *$f = {}; print $f'
*main​::a
$ perl5.13.4 -le' $f = *a; (*$f) = {}; print $f'
HASH(0x8039f0)

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.

[p5pRT]

From @cpansprout

Inline Patch

diff -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__

[p5pRT]

From @cpansprout

On Sun Sep 12 12​:34​:21 2010, sprout wrote​:

On Aug 29, 2010, at 6​:48 PM, Father Chrysostomos wrote​:

See ticket #1804. This bug occurs with list assignment as well​:

$ perl5.13.4 -le' $f = *a; *$f = {}; print $f'
*main​::a
$ perl5.13.4 -le' $f = *a; (*$f) = {}; print $f'
HASH(0x8039f0)

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.

This was fixed by 2acc331. The tests in the patch have been
applied as 0095ccd.

[p5pRT]

From [Unknown Contact. See original ticket]

On Sun Sep 12 12​:34​:21 2010, sprout wrote​:

On Aug 29, 2010, at 6​:48 PM, Father Chrysostomos wrote​:

See ticket #1804. This bug occurs with list assignment as well​:

$ perl5.13.4 -le' $f = *a; *$f = {}; print $f'
*main​::a
$ perl5.13.4 -le' $f = *a; (*$f) = {}; print $f'
HASH(0x8039f0)

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.

This was fixed by 2acc331. The tests in the patch have been
applied as 0095ccd.

[p5pRT]

@cpansprout - Status changed from 'new' to 'resolved'