Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

List assignment to fake globs fails #10588

Closed
p5pRT opened this issue Aug 30, 2010 · 6 comments
Closed

List assignment to fake globs fails #10588

p5pRT opened this issue Aug 30, 2010 · 6 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Aug 30, 2010

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

Searchable as RT77508$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 30, 2010

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
Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 12, 2010

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
Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 12, 2010

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
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 25, 2010

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
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 25, 2010

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
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 25, 2010

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.