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

LVALUE magic should know how to assign to globs #7939

Closed
p5pRT opened this issue May 31, 2005 · 24 comments
Closed

LVALUE magic should know how to assign to globs #7939

p5pRT opened this issue May 31, 2005 · 24 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented May 31, 2005

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

Searchable as RT36051$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 31, 2005

From @nwc10

Created by @nwc10

If you pass a hash element as an argument to a subroutine and assign a glob
to it, you get inconsistent results.

If the element did not exist​:

$ perl5.9.3 -MDevel​::eeek -le 'sub f { $_[0] = *FOO } f($h{foo}); Dump $h{foo}'
SV = PVNV(0x8167370) at 0x81633b0
  REFCNT = 1
  FLAGS = (POK,pPOK)
  IV = 0
  NV = 0
  PV = 0x81620d0 "*main​::FOO"\0
  CUR = 10
  LEN = 11

If the element exists before the call​:

$ perl5.9.3 -MDevel​::Peek -le 'sub f { $_[0] = *FOO } $h{foo}=1; f($h{foo}); Dump $h{foo}'
SV = PVGV(0x818c210) at 0x81630a0
  REFCNT = 1
  FLAGS = (GMG,SMG,FAKE,MULTI)
  IV = 1
  NV = 0
  MAGIC = 0x81886c0
  MG_VIRTUAL = &PL_vtbl_glob
  MG_TYPE = PERL_MAGIC_glob(*)
  MG_OBJ = 0x81630a0
  NAME = "FOO"
  NAMELEN = 3
  GvSTASH = 0x81630d0 "main"
  GP = 0x8174880
  SV = 0x8176270
  REFCNT = 2
  IO = 0x0
  FORM = 0x0
  AV = 0x0
  HV = 0x0
  CV = 0x0
  CVGEN = 0x0
  GPFLAGS = 0x0
  LINE = 1
  FILE = "-e"
  FLAGS = 0x2
  EGV = 0x8176280 "FOO"

Presumably now that PVLVs are large enough to hold the full PVGV info, the
LVALUE tie magic should know how to assign out a typeglob.

Nicholas Clark

Perl Info

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.9.3:

Configured by nick at Fri May 27 21:32:46 BST 2005.

Summary of my perl5 (revision 5 version 9 subversion 3 patch 24610) configuration:
  Platform:
    osname=freebsd, osvers=5.3-release-p2, archname=i386-freebsd
    uname='freebsd saigo.etla.org 5.3-release-p2 freebsd 5.3-release-p2 #1: wed dec 15 21:05:13 gmt 2004 root@saigo.etla.org:usrobjusrsrcsyssaigo i386 '
    config_args='-Dusedevel=y -Dcc=ccache gcc -Dld=gcc -Ubincompat5005 -Uinstallusrbinperl -Dcf_email=nick@ccl4.org -Dperladmin=nick@ccl4.org -Dinc_version_list=  -Dinc_version_list_init=0 -Uuselongdouble -Uuse64bitint -Uusethreads -Dinstallman1dir=none -Dinstallman3dir=none -Dprefix=~/Sandpit/blead-pentagram24610 -Doptimize=-O2 -falign-loops=16 -falign-jumps=16 -falign-functions=16 -falign-labels=16 -mpreferred-stack-boundary=4 -minline-all-stringops -de'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='ccache gcc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include',
    optimize='-O2 -falign-loops=16 -falign-jumps=16 -falign-functions=16 -falign-labels=16 -mpreferred-stack-boundary=4 -minline-all-stringops',
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include'
    ccversion='', gccversion='3.4.2 [FreeBSD] 20040728', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lm -lcrypt -lutil -lc
    perllibs=-lm -lcrypt -lutil -lc
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fPIC', lddlflags='-shared  -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.9.3:
    /home/nick/Sandpit/blead-pentagram24610/lib/perl5/5.9.3/i386-freebsd
    /home/nick/Sandpit/blead-pentagram24610/lib/perl5/5.9.3
    /home/nick/Sandpit/blead-pentagram24610/lib/perl5/site_perl/5.9.3/i386-freebsd
    /home/nick/Sandpit/blead-pentagram24610/lib/perl5/site_perl/5.9.3
    /home/nick/Sandpit/blead-pentagram24610/lib/perl5/site_perl
    .


Environment for perl v5.9.3:
    HOME=/home/nick
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/games:/usr/local/sbin:/usr/local/bin:/usr/X11R6/bin:/home/nick/bin:/usr/local/sbin:/sbin:/usr/sbin
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 22, 2010

From @cpansprout

This doesn’t work​:

sub{ $_[0] = *_​:: }->($a{b});
use Devel​::Peek;
Dump $a{b};
$a{b} = *_​::;
Dump $a{b}

It 5.8.x and earlier, the $_[0] assignment caused an error. (Can't upgrade....)

In 5.10.0 and later, the glob is stringified and assigned to $a{b}.

I was poring over sv_setsv_flags, and read it six times trying to understand it, until I realised it didn’t make sense to me because it was buggy. I still don’t understand it well enough to fix this.

Take this bit, for instance​:
  case SVt_PVGV​:
  if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
  glob_assign_glob(dstr, sstr, dtype);
  return;
  }

Should that SVt_PVGV be changed to SVt_PVLV, or would that have strange side-effects? (This same logic occurs in several other places in the same function.)

And this bit, a little lower​:
  if (stype == SVt_PVLV)
  SvUPGRADE(dstr, SVt_PVNV);
  else
  SvUPGRADE(dstr, (svtype)stype);

Why would an SVt_PVLV require the LHS to be SVt_PVNV and not something else?

Near the bottom​:
  if (isGV_with_GP(sstr)) {
  /* This stringification rule for globs is spread in 3 places.
  This feels bad. FIXME. */
  const U32 wasfake = sflags & SVf_FAKE;

  /* FAKE globs can get coerced, so need to turn this off
  temporarily if it is on. */
  SvFAKE_off(sstr);
  gv_efullname3(dstr, MUTABLE_GV(sstr), "*");
  SvFLAGS(sstr) |= wasfake;
  }

When is a glob ever supposed to be stringified when assigned to something? If I’m reading the code correctly, this is only reached when a glob is assigned to an SVt_PVLV (which causes this bug) or an SVt_PVIO (how can that ever happen?). Is this code really supposed to be reached?

A note to anyone fixing this​: When this is fixed, if the lvalue points to a stash element whose names ends with :​: then the assignment may necessitate a call to MRO_INVALIDATE_ISA, mro_package_moved, or whatever it ends up being called. My first patch for bug #75176 (which is unfinished) will add that macro or function.


Flags​:
  category=core
  severity=low


This perlbug was built using Perl 5.10.1 - Thu Sep 24 18​:07​:44 PDT 2009
It is being executed now by Perl 5.13.2 - Tue Jun 22 20​:22​:10 PDT 2010.

Site configuration information for perl 5.13.2​:

Configured by sprout at Tue Jun 22 20​:22​:10 PDT 2010.

Summary of my perl5 (revision 5 version 13 subversion 2 patch v5.13.2-3-gd1e2db0) configuration​:
  Snapshot of​: d1e2db0
  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 5659)', 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.2​:
  lib
  /usr/local/lib/perl5/site_perl/5.13.2/darwin-thread-multi-2level
  /usr/local/lib/perl5/site_perl/5.13.2
  /usr/local/lib/perl5/5.13.2/darwin-thread-multi-2level
  /usr/local/lib/perl5/5.13.2
  /usr/local/lib/perl5/site_perl
  .


Environment for perl 5.13.2​:
  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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 25, 2010

From @iabyn

On Sun, Aug 22, 2010 at 12​:24​:36PM -0700, Father Chrysostomos wrote​:

This doesn’t work​:

sub{ $_[0] = *_​:: }->($a{b});
use Devel​::Peek;
Dump $a{b};
$a{b} = *_​::;
Dump $a{b}

It 5.8.x and earlier, the $_[0] assignment caused an error. (Can't upgrade....)

In 5.10.0 and later, the glob is stringified and assigned to $a{b}.

I was poring over sv_setsv_flags, and read it six times trying to understand it, until I realised it didn’t make sense to me because it was buggy. I still don’t understand it well enough to fix this.

Take this bit, for instance​:
case SVt_PVGV​:
if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}

Should that SVt_PVGV be changed to SVt_PVLV, or would that have strange
side-effects? (This same logic occurs in several other places in the
same function.)

Answer​: yes, it should probably be changed. Try it and see if anything
breaks!

And this bit, a little lower​:
if (stype == SVt_PVLV)
SvUPGRADE(dstr, SVt_PVNV);
else
SvUPGRADE(dstr, (svtype)stype);

Why would an SVt_PVLV require the LHS to be SVt_PVNV and not something else?

I think that was a mistake. I think the original intent of the change
(ded42b9) was to stop upgrading the
destination to an LV just because the src was an LV. I suspect just
skipping an upgrade in the LV case would be ok.

Near the bottom​:
if (isGV_with_GP(sstr)) {
/* This stringification rule for globs is spread in 3 places.
This feels bad. FIXME. */
const U32 wasfake = sflags & SVf_FAKE;

    /\* FAKE globs can get coerced\, so need to turn this off
       temporarily if it is on\.  \*/
    SvFAKE\_off\(sstr\);
    gv\_efullname3\(dstr\, MUTABLE\_GV\(sstr\)\, "\*"\);
    SvFLAGS\(sstr\) |= wasfake;
\}

When is a glob ever supposed to be stringified when assigned to something? If I’m reading the code correctly, this is only reached when a glob is assigned to an SVt_PVLV (which causes this bug) or an SVt_PVIO (how can that ever happen?). Is this code really supposed to be reached?>

Well I put in an assert(dtype == SVt_PVLV) there and no tests failed, so
it looks like your conclusion is probably correct, and that this code
chunk should removed once the LV is handled earlier.

--
Fire extinguisher (n) a device for holding open fire doors.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 25, 2010

The RT System itself - Status changed from 'new' to 'open'

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 29, 2010

From @cpansprout

On, Wed, 25 Aug 2010 17​:27​:18 +0100, Dave Mitchell wrote​:

On Sun, Aug 22, 2010 at 12​:24​:36PM -0700, Father Chrysostomos wrote​:

Take this bit, for instance​:
case SVt_PVGV​:
if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}

Should that SVt_PVGV be changed to SVt_PVLV, or would that have strange
side-effects? (This same logic occurs in several other places in the
same function.)

Answer​: yes, it should probably be changed. Try it and see if anything
breaks!

One test fails, and dozens of other things break without any tests failing, because so many parts of the perl source code don’t take globs-as-PVLVs into account. So, in trying to fix one little niggling bug, I’ve set off a chain reaction. :-) I’ve fixed all of those I know about. I tried to avoid a megapatch, but the problems turned out to be so intertwined that I couldn’t help it.

Why would an SVt_PVLV require the LHS to be SVt_PVNV and not something else?

I think that was a mistake. I think the original intent of the change
(ded42b9) was to stop upgrading the
destination to an LV just because the src was an LV. I suspect just
skipping an upgrade in the LV case would be ok.

But wouldn’t that cause problems if the RHS is an lvalue holding a number and the LHS is undef?

After learning this code more throughly than I had intended, I believe this can be left as it is.

Near the bottom​:
if (isGV_with_GP(sstr)) {
/* This stringification rule for globs is spread in 3 places.
This feels bad. FIXME. */
const U32 wasfake = sflags & SVf_FAKE;

    /\* FAKE globs can get coerced\, so need to turn this off
       temporarily if it is on\.  \*/
    SvFAKE\_off\(sstr\);
    gv\_efullname3\(dstr\, MUTABLE\_GV\(sstr\)\, "\*"\);
    SvFLAGS\(sstr\) |= wasfake;
\}

When is a glob ever supposed to be stringified when assigned to something? If I’m reading the code correctly, this is only reached when a glob is assigned to an SVt_PVLV (which causes this bug) or an SVt_PVIO (how can that ever happen?). Is this code really supposed to be reached?>

Well I put in an assert(dtype == SVt_PVLV) there and no tests failed, so
it looks like your conclusion is probably correct, and that this code
chunk should removed once the LV is handled earlier.

Out of paranoia, I’ve left that code unchanged, in case some XS code is assigning a glob to an IO thingy and expecting the latter to morph into a scalar. I think any such code would be buggy, so it probably can be removed; but I leave it to you.

Here is some text for perldelta. The various PVLV fixups throughout the source are not deserving of mention, since they fix bugs that couldn’t have occurred before the changes to sv_setsv_flags.

(Under Selected Bug Fixes​:)

=item *

Assigning a glob to a PVLV used to convert it to a plain string. Now it
works correctly, and a PVLV can hold a glob. This would happen when a
nonexistent hash or array element was passed to a subroutine​:

  sub { $_[0] = *foo }->($hash{key});
  # $_[0] would have been the string "*main​::foo"

It also happened when a glob was assigned to, or returned from, an element
of a tied array or hash.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 29, 2010

From @cpansprout

From​: Father Chrysostomos <sprout@​cpan.org>

[perl #77362] Assigning glob to lvalue causes stringification

This test from t/op/gv.t was added by change 22315/4ce457a6​:

{
  # test the assignment of a GLOB to an LVALUE
  my $e = '';
  local $SIG{__DIE__} = sub { $e = $_[0] };
  my $v;
  sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
  f($v);
  is ($v, '*main​::DATA');
  my $x = <$v>;
  is ($x, "perl\n");
}

That change was the one that made glob-to-lvalue assignment work to
begin with. But this test passes in perl version *prior* to that
change.

This patch fixes the test and adds tests to make sure what is assigned
is actually a glob, and not just a string.

It also happens to fix the stringification bug. In doing so, it essen-
tially ‘enables’ globs-as-PVLVs.

It turns out that many different parts of the perl source don’t fully
take this into account, so this patch also fixes the following to work
with them (I tried to make these into separate patches, but they are
so intertwined it just got too complicated)​:

• GvIO(gv) to make readline and other I/O ops work.

• Autovivification of glob slots.

• tie *$pvlv

• *$pvlv = undef, *$pvlv = $number, *$pvlv = $ref

• Duplicating a filehandle accessed through a PVLV glob when the
  stringified form of the glob cannot be used to access the file
  handle (!)

• Using a PVLV glob as a subroutine reference

• Coderef assignment when the glob is no longer in the symbol table

• open with a PVLV glob for the filehandle

• -t and -T

• Unopened file handle warnings

Inline Patch
diff -Nup blead-77362-glob2lv0/gv.c blead-77362-glob2lv8/gv.c
--- blead-77362-glob2lv0/gv.c	2010-07-24 08:14:09.000000000 -0700
+++ blead-77362-glob2lv8/gv.c	2010-08-23 22:21:43.000000000 -0700
@@ -45,7 +45,13 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype
 {
     SV **where;
 
-    if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
+    if (
+        !gv
+     || (
+            SvTYPE((const SV *)gv) != SVt_PVGV
+         && SvTYPE((const SV *)gv) != SVt_PVLV
+        )
+    ) {
 	const char *what;
 	if (type == SVt_PVIO) {
 	    /*
diff -Nup blead-77362-glob2lv0/gv.h blead-77362-glob2lv8/gv.h
--- blead-77362-glob2lv0/gv.h	2010-06-04 13:48:10.000000000 -0700
+++ blead-77362-glob2lv8/gv.h	2010-08-23 20:39:17.000000000 -0700
@@ -88,7 +88,17 @@ Return the SV from the GV.
 #endif
 
 #define GvREFCNT(gv)	(GvGP(gv)->gp_refcnt)
-#define GvIO(gv)	((gv) && SvTYPE((const SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : NULL)
+#define GvIO(gv)                         \
+ (                                        \
+     (gv)                                  \
+  && (                                      \
+         SvTYPE((const SV*)(gv)) == SVt_PVGV \
+      || SvTYPE((const SV*)(gv)) == SVt_PVLV  \
+     )                                         \
+  && GvGP(gv)                                   \
+   ? GvIOp(gv)                                   \
+   : NULL                                         \
+ )
 #define GvIOp(gv)	(GvGP(gv)->gp_io)
 #define GvIOn(gv)	(GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
 
diff -Nup blead-77362-glob2lv0/pp_hot.c blead-77362-glob2lv8/pp_hot.c
--- blead-77362-glob2lv0/pp_hot.c	2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/pp_hot.c	2010-08-25 13:25:56.000000000 -0700
@@ -123,7 +123,7 @@ PP(pp_sassign)
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
 	SV * const cv = SvRV(left);
 	const U32 cv_type = SvTYPE(cv);
-	const U32 gv_type = SvTYPE(right);
+	const bool is_gv = isGV_with_GP(right);
 	const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
 	if (!got_coderef) {
@@ -133,7 +133,7 @@ PP(pp_sassign)
 	/* Can do the optimisation if right (LVALUE) is not a typeglob,
 	   left (RVALUE) is a reference to something, and we're in void
 	   context. */
-	if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+	if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
 	    /* Is the target symbol table currently empty?  */
 	    GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
 	    if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
@@ -151,7 +151,7 @@ PP(pp_sassign)
 	}
 
 	/* Need to fix things up.  */
-	if (gv_type != SVt_PVGV) {
+	if (!is_gv) {
 	    /* Need to fix GV.  */
 	    right = MUTABLE_SV(gv_fetchsv(right, GV_ADD, SVt_PVGV));
 	}
@@ -201,7 +201,7 @@ PP(pp_sassign)
     /* Allow glob assignments like *$x = ..., which, when the glob has a
        SVf_FAKE flag, cannot be distinguished from $x = ... without looking
        at the op tree. */
-    if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+    if( isGV_with_GP(right) && cBINOP->op_last->op_type == OP_RV2GV
      && (wasfake = SvFLAGS(right) & SVf_FAKE) )
 	SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
@@ -2730,6 +2730,7 @@ PP(pp_entersub)
     case SVt_PVGV:
 	if (!isGV_with_GP(sv))
 	    DIE(aTHX_ "Not a CODE reference");
+      we_have_a_glob:
 	if (!(cv = GvCVu((const GV *)sv))) {
 	    HV *stash;
 	    cv = sv_2cv(sv, &stash, &gv, 0);
@@ -2740,6 +2741,9 @@ PP(pp_entersub)
 	    goto try_autoload;
 	}
 	break;
+    case SVt_PVLV:
+	if(isGV_with_GP(sv)) goto we_have_a_glob;
+	/*FALLTHROUGH*/
     default:
 	if (sv == &PL_sv_yes) {		/* unfound import, ignore */
 	    if (hasargs)
diff -Nup blead-77362-glob2lv0/pp_sys.c blead-77362-glob2lv8/pp_sys.c
--- blead-77362-glob2lv0/pp_sys.c	2010-08-19 18:47:10.000000000 -0700
+++ blead-77362-glob2lv8/pp_sys.c	2010-08-25 18:03:31.000000000 -0700
@@ -505,7 +505,7 @@ PP(pp_open)
 
     GV * const gv = MUTABLE_GV(*++MARK);
 
-    if (!isGV(gv))
+    if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv)))
 	DIE(aTHX_ PL_no_usym, "filehandle");
 
     if ((io = GvIOp(gv))) {
@@ -825,6 +825,7 @@ PP(pp_tie)
 	    methname = "TIEARRAY";
 	    break;
 	case SVt_PVGV:
+	case SVt_PVLV:
 	    if (isGV_with_GP(varsv)) {
 		methname = "TIEHANDLE";
 		how = PERL_MAGIC_tiedscalar;
@@ -3338,7 +3339,7 @@ PP(pp_fttty)
 
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
-    else if (isGV(TOPs))
+    else if (isGV_with_GP(TOPs))
 	gv = MUTABLE_GV(POPs);
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
 	gv = MUTABLE_GV(SvRV(POPs));
@@ -3391,7 +3392,7 @@ PP(pp_fttext)
 
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
-    else if (isGV(TOPs))
+    else if (isGV_with_GP(TOPs))
 	gv = MUTABLE_GV(POPs);
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
 	gv = MUTABLE_GV(SvRV(POPs));
diff -Nup blead-77362-glob2lv0/sv.c blead-77362-glob2lv8/sv.c
--- blead-77362-glob2lv0/sv.c	2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/sv.c	2010-08-25 20:37:26.000000000 -0700
@@ -3774,7 +3774,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
     switch (stype) {
     case SVt_NULL:
       undef_sstr:
-	if (dtype != SVt_PVGV) {
+	if (dtype != SVt_PVGV && dtype != SVt_PVLV) {
 	    (void)SvOK_off(dstr);
 	    return;
 	}
@@ -3790,6 +3790,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 		sv_upgrade(dstr, SVt_PVIV);
 		break;
 	    case SVt_PVGV:
+	    case SVt_PVLV:
 		goto end_of_first_switch;
 	    }
 	    (void)SvIOK_only(dstr);
@@ -3821,6 +3822,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 		sv_upgrade(dstr, SVt_PVNV);
 		break;
 	    case SVt_PVGV:
+	    case SVt_PVLV:
 		goto end_of_first_switch;
 	    }
 	    SvNV_set(dstr, SvNVX(sstr));
@@ -3873,7 +3875,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	/* case SVt_BIND: */
     case SVt_PVLV:
     case SVt_PVGV:
-	if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
+	if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
 	    glob_assign_glob(dstr, sstr, dtype);
 	    return;
 	}
@@ -3883,12 +3885,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
     case SVt_PVMG:
 	if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
 	    mg_get(sstr);
-	    if (SvTYPE(sstr) != stype) {
+	    if (SvTYPE(sstr) != stype)
 		stype = SvTYPE(sstr);
-		if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <= SVt_PVGV) {
+	    if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
 		    glob_assign_glob(dstr, sstr, dtype);
 		    return;
-		}
 	    }
 	}
 	if (stype == SVt_PVLV)
@@ -3923,7 +3924,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	else
 	    Perl_croak(aTHX_ "Cannot copy to %s", type);
     } else if (sflags & SVf_ROK) {
-	if (isGV_with_GP(dstr) && dtype == SVt_PVGV
+	if (isGV_with_GP(dstr)
 	    && SvTYPE(SvRV(sstr)) == SVt_PVGV && isGV_with_GP(SvRV(sstr))) {
 	    sstr = SvRV(sstr);
 	    if (sstr == dstr) {
@@ -3940,7 +3941,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	}
 
 	if (dtype >= SVt_PV) {
-	    if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+	    if (isGV_with_GP(dstr)) {
 		glob_assign_ref(dstr, sstr);
 		return;
 	    }
@@ -3958,7 +3959,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	assert(!(sflags & SVf_NOK));
 	assert(!(sflags & SVf_IOK));
     }
-    else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+    else if (isGV_with_GP(dstr)) {
 	if (!(sflags & SVf_OK)) {
 	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
 			   "Undefined value assigned to typeglob");
@@ -4559,7 +4560,7 @@ Perl_sv_force_normal_flags(pTHX_ registe
 #endif
     if (SvROK(sv))
 	sv_unref_flags(sv, flags);
-    else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+    else if (SvFAKE(sv) && isGV_with_GP(sv))
 	sv_unglob(sv);
     else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
 	/* Need to downgrade the REGEXP to a simple(r) scalar. This is analagous
@@ -8372,6 +8373,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
 	io = MUTABLE_IO(sv);
 	break;
     case SVt_PVGV:
+    case SVt_PVLV:
 	if (isGV_with_GP(sv)) {
 	    gv = MUTABLE_GV(sv);
 	    io = GvIO(gv);
@@ -8975,7 +8977,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *co
     return sv;
 }
 
-/* Downgrades a PVGV to a PVMG.
+/* Downgrades a PVGV to a PVMG. If it’s actually a PVLV, we leave the type
+ * as it is after unglobbing it.
  */
 
 STATIC void
@@ -8988,7 +8991,7 @@ S_sv_unglob(pTHX_ SV *const sv)
 
     PERL_ARGS_ASSERT_SV_UNGLOB;
 
-    assert(SvTYPE(sv) == SVt_PVGV);
+    assert(SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV);
     SvFAKE_off(sv);
     gv_efullname3(temp, MUTABLE_GV(sv), "*");
 
@@ -9008,14 +9011,16 @@ S_sv_unglob(pTHX_ SV *const sv)
     }
     isGV_with_GP_off(sv);
 
-    /* need to keep SvANY(sv) in the right arena */
-    xpvmg = new_XPVMG();
-    StructCopy(SvANY(sv), xpvmg, XPVMG);
-    del_XPVGV(SvANY(sv));
-    SvANY(sv) = xpvmg;
+    if(SvTYPE(sv) == SVt_PVGV) {
+	/* need to keep SvANY(sv) in the right arena */
+	xpvmg = new_XPVMG();
+	StructCopy(SvANY(sv), xpvmg, XPVMG);
+	del_XPVGV(SvANY(sv));
+	SvANY(sv) = xpvmg;
 
-    SvFLAGS(sv) &= ~SVTYPEMASK;
-    SvFLAGS(sv) |= SVt_PVMG;
+	SvFLAGS(sv) &= ~SVTYPEMASK;
+	SvFLAGS(sv) |= SVt_PVMG;
+    }
 
     /* Intentionally not calling any local SET magic, as this isn't so much a
        set operation as merely an internal storage change.  */
diff -Nup blead-77362-glob2lv0/util.c blead-77362-glob2lv8/util.c
--- blead-77362-glob2lv0/util.c	2010-07-27 00:51:15.000000000 -0700
+++ blead-77362-glob2lv8/util.c	2010-08-25 22:26:49.000000000 -0700
@@ -3828,7 +3828,8 @@ Perl_my_fflush_all(pTHX)
 void
 Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 {
-    const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
+    const char * const name
+     = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
 
     if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
 	if (ckWARN(WARN_IO)) {
diff -Nurp blead-77362-glob2lv0/t/op/gv.t blead-77362-glob2lv8/t/op/gv.t
--- blead-77362-glob2lv0/t/op/gv.t	2010-07-26 01:29:10.000000000 -0700
+++ blead-77362-glob2lv8/t/op/gv.t	2010-08-25 22:25:50.000000000 -0700
@@ -7,12 +7,12 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 use warnings;
 
-require './test.pl';
-plan( tests => 192 );
+plan( tests => 217 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -253,11 +253,12 @@ is($j[0], 1);
     # test the assignment of a GLOB to an LVALUE
     my $e = '';
     local $SIG{__DIE__} = sub { $e = $_[0] };
-    my $v;
+    my %v;
     sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
-    f($v);
-    is ($v, '*main::DATA');
-    my $x = <$v>;
+    f($v{v});
+    is ($v{v}, '*main::DATA');
+    is (ref\$v{v}, 'GLOB', 'lvalue assignment preserves globs');
+    my $x = readline $v{v};
     is ($x, "perl\n");
 }
 
@@ -272,6 +273,10 @@ is($j[0], 1);
     tie my @ary => "T";
     $ary[0] = *DATA;
     is ($ary[0], '*main::DATA');
+    is (
+      ref\tied(@ary)->[0], 'GLOB',
+     'tied elem assignment preserves globs'
+    );
     is ($e, '');
     my $x = readline $ary[0];
     is($x, "rocks\n");
@@ -634,6 +639,125 @@ is (scalar $::{fake}, "*main::sym",
     );
 }
 
+# [perl #77362] various bugs related to globs as PVLVs
+{
+ no warnings 'once';
+ my %h; # We pass a key of this hash to the subroutine to get a PVLV.
+ sub { for(shift) {
+  # Set up our glob-as-PVLV
+  $_ = *hon;
+
+  # Bad symbol for array
+  ok eval{ @$_; 1 }, 'PVLV glob slots can be autovivified' or diag $@;
+
+  # This should call TIEHANDLE, not TIESCALAR
+  *thext::TIEHANDLE = sub{};
+  ok eval{ tie *$_, 'thext'; 1 }, 'PVLV globs can be tied as handles'
+   or diag $@;
+
+  # Assigning undef to the glob should not overwrite it...
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w = shift };
+   *$_ = undef;
+   is $_, "*main::hon", 'PVLV: assigning undef to the glob does nothing';
+   like $w, qr\Undefined value assigned to typeglob\,
+    'PVLV: assigning undef to the glob warns';
+  }
+
+  # Neither should number assignment...
+  *$_ = 1;
+  is $_, "*main::1", "PVLV: integer-to-glob assignment assigns a glob";
+  *$_ = 2.0;
+  is $_, "*main::2", "PVLV: float-to-glob assignment assigns a glob";
+
+  # Nor reference assignment.
+  *$_ = \*thit;
+  is $_, "*main::thit", "PVLV: globref-to-glob assignment assigns a glob";
+  *$_ = [];
+  is $_, "*main::thit", "PVLV: arrayref assignment assigns to the AV slot";
+
+  # Concatenation should still work.
+  ok eval { $_ .= 'thlew' }, 'PVLV concatenation does not die' or diag $@;
+  is $_, '*main::thitthlew', 'PVLV concatenation works';
+
+  # And we should be able to overwrite it with a string, number, or refer-
+  # ence, too, if we omit the *.
+  $_ = *hon; $_ = 'tzor';
+  is $_, 'tzor', 'PVLV: assigning a string over a glob';
+  $_ = *hon; $_ = 23;
+  is $_, 23, 'PVLV: assigning an integer over a glob';
+  $_ = *hon; $_ = 23.23;
+  is $_, 23.23, 'PVLV: assigning a float over a glob';
+  $_ = *hon; $_ = \my $sthat;
+  is $_, \$sthat, 'PVLV: assigning a reference over a glob';
+
+  # This bug was found by code inspection. Could this ever happen in
+  # real life? :-)
+  # This duplicates a file handle, accessing it through a PVLV glob, the
+  # glob having been removed from the symbol table, so a stringified form
+  # of it does not work. This checks that sv_2io does not stringify a PVLV.
+  $_ = *quin;
+  open *quin, "test.pl"; # test.pl is as good a file as any
+  delete $::{quin};
+  ok eval { open my $zow, "<&", $_ }, 'PVLV: sv_2io stringifieth not'
+   or diag $@;
+
+  # Similar tests to make sure sv_2cv etc. do not stringify.
+  *$_ = sub { 1 };
+  ok eval { &$_ }, "PVLV glob can be called as a sub" or diag $@;
+  *flelp = sub { 2 };
+  $_ = 'flelp';
+  is eval { &$_ }, 2, 'PVLV holding a string can be called as a sub'
+   or diag $@;
+
+  # Coderef-to-glob assignment when the glob is no longer accessible
+  # under its name: These tests are to make sure the OPpASSIGN_CV_TO_GV
+  # optimisation takes PVLVs into account, which is why the RHSs have to be
+  # named subs.
+  use constant gheen => 'quare';
+  $_ = *ming;
+  delete $::{ming};
+  *$_ = \&gheen;
+  is eval { &$_ }, 'quare',
+   'PVLV: constant assignment when the glob is detached from the symtab'
+    or diag $@;
+  $_ = *bength;
+  delete $::{bength};
+  *gheck = sub { 'lon' };
+  *$_ = \&gheck;
+  is eval { &$_ }, 'lon',
+   'PVLV: coderef assignment when the glob is detached from the symtab'
+    or diag $@;
+
+  # open should accept a PVLV as its first argument
+  $_ = *hon;
+  ok eval { open $_,'<', \my $thlext }, 'PVLV can be the first arg to open'
+   or diag $@;
+
+  # -t should not stringify
+  $_ = *thlit; delete $::{thlit};
+  *$_ = *STDOUT{IO};
+  ok defined -t $_, 'PVLV: -t does not stringify';
+
+  # neither should -T
+  open my $quile, "<", 'test.pl';
+  $_ = *$quile;
+  ok -T $_, "PVLV: -T does not stringify";
+  
+  # Unopened file handle
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w .= shift };
+   $_ = *vor;
+   close $_;
+   like $w, qr\unopened filehandle vor\,
+    'PVLV globs get their names reported in unopened error messages';
+  }
+
+ }}->($h{k});
+}
+
 __END__
 Perl
 Rules

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 5, 2010

From @cpansprout

On Aug 29, 2010, at 12​:49 PM, Father Chrysostomos wrote​:

On, Wed, 25 Aug 2010 17​:27​:18 +0100, Dave Mitchell wrote​:

On Sun, Aug 22, 2010 at 12​:24​:36PM -0700, Father Chrysostomos wrote​:

Take this bit, for instance​:
case SVt_PVGV​:
if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
glob_assign_glob(dstr, sstr, dtype);
return;
}

Should that SVt_PVGV be changed to SVt_PVLV, or would that have strange
side-effects? (This same logic occurs in several other places in the
same function.)

Answer​: yes, it should probably be changed. Try it and see if anything
breaks!

One test fails, and dozens of other things break without any tests failing, because so many parts of the perl source code don’t take globs-as-PVLVs into account. So, in trying to fix one little niggling bug, I’ve set off a chain reaction. :-) I’ve fixed all of those I know about. I tried to avoid a megapatch, but the problems turned out to be so intertwined that I couldn’t help it.

Here is a better patch that avoids a void warning.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 5, 2010

From @cpansprout

From​: Father Chrysostomos <sprout@​cpan.org>

[perl #77362] Assigning glob to lvalue causes stringification

This test from t/op/gv.t was added by change 22315/4ce457a6​:

{
  # test the assignment of a GLOB to an LVALUE
  my $e = '';
  local $SIG{__DIE__} = sub { $e = $_[0] };
  my $v;
  sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
  f($v);
  is ($v, '*main​::DATA');
  my $x = <$v>;
  is ($x, "perl\n");
}

That change was the one that made glob-to-lvalue assignment work to
begin with. But this test passes in perl version *prior* to that
change.

This patch fixes the test and adds tests to make sure what is assigned
is actually a glob, and not just a string.

It also happens to fix the stringification bug. In doing so, it essen-
tially ‘enables’ globs-as-PVLVs.

It turns out that many different parts of the perl source don’t fully
take this into account, so this patch also fixes the following to work
with them (I tried to make these into separate patches, but they are
so intertwined it just got too complicated)​:

• GvIO(gv) to make readline and other I/O ops work.

• Autovivification of glob slots.

• tie *$pvlv

• *$pvlv = undef, *$pvlv = $number, *$pvlv = $ref

• Duplicating a filehandle accessed through a PVLV glob when the
  stringified form of the glob cannot be used to access the file
  handle (!)

• Using a PVLV glob as a subroutine reference

• Coderef assignment when the glob is no longer in the symbol table

• open with a PVLV glob for the filehandle

• -t and -T

• Unopened file handle warnings

Inline Patch
diff -Nup blead-77362-glob2lv0/gv.c blead-77362-glob2lv8/gv.c
--- blead-77362-glob2lv0/gv.c	2010-07-24 08:14:09.000000000 -0700
+++ blead-77362-glob2lv8/gv.c	2010-08-23 22:21:43.000000000 -0700
@@ -45,7 +45,13 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype
 {
     SV **where;
 
-    if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
+    if (
+        !gv
+     || (
+            SvTYPE((const SV *)gv) != SVt_PVGV
+         && SvTYPE((const SV *)gv) != SVt_PVLV
+        )
+    ) {
 	const char *what;
 	if (type == SVt_PVIO) {
 	    /*
diff -Nup blead-77362-glob2lv0/gv.h blead-77362-glob2lv8/gv.h
--- blead-77362-glob2lv0/gv.h	2010-06-04 13:48:10.000000000 -0700
+++ blead-77362-glob2lv8/gv.h	2010-08-23 20:39:17.000000000 -0700
@@ -88,7 +88,17 @@ Return the SV from the GV.
 #endif
 
 #define GvREFCNT(gv)	(GvGP(gv)->gp_refcnt)
-#define GvIO(gv)	((gv) && SvTYPE((const SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : NULL)
+#define GvIO(gv)                         \
+ (                                        \
+     (gv)                                  \
+  && (                                      \
+         SvTYPE((const SV*)(gv)) == SVt_PVGV \
+      || SvTYPE((const SV*)(gv)) == SVt_PVLV  \
+     )                                         \
+  && GvGP(gv)                                   \
+   ? GvIOp(gv)                                   \
+   : NULL                                         \
+ )
 #define GvIOp(gv)	(GvGP(gv)->gp_io)
 #define GvIOn(gv)	(GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
 
diff -Nup blead-77362-glob2lv0/pp_hot.c blead-77362-glob2lv8/pp_hot.c
--- blead-77362-glob2lv0/pp_hot.c	2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/pp_hot.c	2010-08-25 13:25:56.000000000 -0700
@@ -123,7 +123,7 @@ PP(pp_sassign)
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
 	SV * const cv = SvRV(left);
 	const U32 cv_type = SvTYPE(cv);
-	const U32 gv_type = SvTYPE(right);
+	const bool is_gv = isGV_with_GP(right);
 	const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
 	if (!got_coderef) {
@@ -133,7 +133,7 @@ PP(pp_sassign)
 	/* Can do the optimisation if right (LVALUE) is not a typeglob,
 	   left (RVALUE) is a reference to something, and we're in void
 	   context. */
-	if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+	if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
 	    /* Is the target symbol table currently empty?  */
 	    GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
 	    if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
@@ -151,7 +151,7 @@ PP(pp_sassign)
 	}
 
 	/* Need to fix things up.  */
-	if (gv_type != SVt_PVGV) {
+	if (!is_gv) {
 	    /* Need to fix GV.  */
 	    right = MUTABLE_SV(gv_fetchsv(right, GV_ADD, SVt_PVGV));
 	}
@@ -201,7 +201,7 @@ PP(pp_sassign)
     /* Allow glob assignments like *$x = ..., which, when the glob has a
        SVf_FAKE flag, cannot be distinguished from $x = ... without looking
        at the op tree. */
-    if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+    if( isGV_with_GP(right) && cBINOP->op_last->op_type == OP_RV2GV
      && (wasfake = SvFLAGS(right) & SVf_FAKE) )
 	SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
@@ -2730,6 +2730,7 @@ PP(pp_entersub)
     case SVt_PVGV:
 	if (!isGV_with_GP(sv))
 	    DIE(aTHX_ "Not a CODE reference");
+      we_have_a_glob:
 	if (!(cv = GvCVu((const GV *)sv))) {
 	    HV *stash;
 	    cv = sv_2cv(sv, &stash, &gv, 0);
@@ -2740,6 +2741,9 @@ PP(pp_entersub)
 	    goto try_autoload;
 	}
 	break;
+    case SVt_PVLV:
+	if(isGV_with_GP(sv)) goto we_have_a_glob;
+	/*FALLTHROUGH*/
     default:
 	if (sv == &PL_sv_yes) {		/* unfound import, ignore */
 	    if (hasargs)
diff -Nup blead-77362-glob2lv0/pp_sys.c blead-77362-glob2lv8/pp_sys.c
--- blead-77362-glob2lv0/pp_sys.c	2010-08-19 18:47:10.000000000 -0700
+++ blead-77362-glob2lv8/pp_sys.c	2010-08-25 18:03:31.000000000 -0700
@@ -505,7 +505,7 @@ PP(pp_open)
 
     GV * const gv = MUTABLE_GV(*++MARK);
 
-    if (!isGV(gv))
+    if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv)))
 	DIE(aTHX_ PL_no_usym, "filehandle");
 
     if ((io = GvIOp(gv))) {
@@ -825,6 +825,7 @@ PP(pp_tie)
 	    methname = "TIEARRAY";
 	    break;
 	case SVt_PVGV:
+	case SVt_PVLV:
 	    if (isGV_with_GP(varsv)) {
 		methname = "TIEHANDLE";
 		how = PERL_MAGIC_tiedscalar;
@@ -3338,7 +3339,7 @@ PP(pp_fttty)
 
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
-    else if (isGV(TOPs))
+    else if (isGV_with_GP(TOPs))
 	gv = MUTABLE_GV(POPs);
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
 	gv = MUTABLE_GV(SvRV(POPs));
@@ -3391,7 +3392,7 @@ PP(pp_fttext)
 
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
-    else if (isGV(TOPs))
+    else if (isGV_with_GP(TOPs))
 	gv = MUTABLE_GV(POPs);
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
 	gv = MUTABLE_GV(SvRV(POPs));
diff -Nup blead-77362-glob2lv0/sv.c blead-77362-glob2lv8/sv.c
--- blead-77362-glob2lv0/sv.c	2010-08-20 18:55:11.000000000 -0700
+++ blead-77362-glob2lv8/sv.c	2010-08-25 20:37:26.000000000 -0700
@@ -3774,7 +3774,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
     switch (stype) {
     case SVt_NULL:
       undef_sstr:
-	if (dtype != SVt_PVGV) {
+	if (dtype != SVt_PVGV && dtype != SVt_PVLV) {
 	    (void)SvOK_off(dstr);
 	    return;
 	}
@@ -3790,6 +3790,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 		sv_upgrade(dstr, SVt_PVIV);
 		break;
 	    case SVt_PVGV:
+	    case SVt_PVLV:
 		goto end_of_first_switch;
 	    }
 	    (void)SvIOK_only(dstr);
@@ -3821,6 +3822,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 		sv_upgrade(dstr, SVt_PVNV);
 		break;
 	    case SVt_PVGV:
+	    case SVt_PVLV:
 		goto end_of_first_switch;
 	    }
 	    SvNV_set(dstr, SvNVX(sstr));
@@ -3873,7 +3875,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	/* case SVt_BIND: */
     case SVt_PVLV:
     case SVt_PVGV:
-	if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
+	if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
 	    glob_assign_glob(dstr, sstr, dtype);
 	    return;
 	}
@@ -3883,12 +3885,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
     case SVt_PVMG:
 	if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
 	    mg_get(sstr);
-	    if (SvTYPE(sstr) != stype) {
+	    if (SvTYPE(sstr) != stype)
 		stype = SvTYPE(sstr);
-		if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <= SVt_PVGV) {
+	    if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
 		    glob_assign_glob(dstr, sstr, dtype);
 		    return;
-		}
 	    }
 	}
 	if (stype == SVt_PVLV)
@@ -3923,7 +3924,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	else
 	    Perl_croak(aTHX_ "Cannot copy to %s", type);
     } else if (sflags & SVf_ROK) {
-	if (isGV_with_GP(dstr) && dtype == SVt_PVGV
+	if (isGV_with_GP(dstr)
 	    && SvTYPE(SvRV(sstr)) == SVt_PVGV && isGV_with_GP(SvRV(sstr))) {
 	    sstr = SvRV(sstr);
 	    if (sstr == dstr) {
@@ -3940,7 +3941,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	}
 
 	if (dtype >= SVt_PV) {
-	    if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+	    if (isGV_with_GP(dstr)) {
 		glob_assign_ref(dstr, sstr);
 		return;
 	    }
@@ -3958,7 +3959,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
 	assert(!(sflags & SVf_NOK));
 	assert(!(sflags & SVf_IOK));
     }
-    else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
+    else if (isGV_with_GP(dstr)) {
 	if (!(sflags & SVf_OK)) {
 	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
 			   "Undefined value assigned to typeglob");
@@ -4559,7 +4560,7 @@ Perl_sv_force_normal_flags(pTHX_ registe
 #endif
     if (SvROK(sv))
 	sv_unref_flags(sv, flags);
-    else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+    else if (SvFAKE(sv) && isGV_with_GP(sv))
 	sv_unglob(sv);
     else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
 	/* Need to downgrade the REGEXP to a simple(r) scalar. This is analagous
@@ -8372,6 +8373,7 @@ Perl_sv_2io(pTHX_ SV *const sv)
 	io = MUTABLE_IO(sv);
 	break;
     case SVt_PVGV:
+    case SVt_PVLV:
 	if (isGV_with_GP(sv)) {
 	    gv = MUTABLE_GV(sv);
 	    io = GvIO(gv);
@@ -8975,7 +8977,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *co
     return sv;
 }
 
-/* Downgrades a PVGV to a PVMG.
+/* Downgrades a PVGV to a PVMG. If it’s actually a PVLV, we leave the type
+ * as it is after unglobbing it.
  */
 
 STATIC void
@@ -8988,7 +8991,7 @@ S_sv_unglob(pTHX_ SV *const sv)
 
     PERL_ARGS_ASSERT_SV_UNGLOB;
 
-    assert(SvTYPE(sv) == SVt_PVGV);
+    assert(SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV);
     SvFAKE_off(sv);
     gv_efullname3(temp, MUTABLE_GV(sv), "*");
 
@@ -9008,14 +9011,16 @@ S_sv_unglob(pTHX_ SV *const sv)
     }
     isGV_with_GP_off(sv);
 
-    /* need to keep SvANY(sv) in the right arena */
-    xpvmg = new_XPVMG();
-    StructCopy(SvANY(sv), xpvmg, XPVMG);
-    del_XPVGV(SvANY(sv));
-    SvANY(sv) = xpvmg;
+    if(SvTYPE(sv) == SVt_PVGV) {
+	/* need to keep SvANY(sv) in the right arena */
+	xpvmg = new_XPVMG();
+	StructCopy(SvANY(sv), xpvmg, XPVMG);
+	del_XPVGV(SvANY(sv));
+	SvANY(sv) = xpvmg;
 
-    SvFLAGS(sv) &= ~SVTYPEMASK;
-    SvFLAGS(sv) |= SVt_PVMG;
+	SvFLAGS(sv) &= ~SVTYPEMASK;
+	SvFLAGS(sv) |= SVt_PVMG;
+    }
 
     /* Intentionally not calling any local SET magic, as this isn't so much a
        set operation as merely an internal storage change.  */
diff -Nup blead-77362-glob2lv0/util.c blead-77362-glob2lv8/util.c
--- blead-77362-glob2lv0/util.c	2010-07-27 00:51:15.000000000 -0700
+++ blead-77362-glob2lv8/util.c	2010-08-25 22:26:49.000000000 -0700
@@ -3828,7 +3828,8 @@ Perl_my_fflush_all(pTHX)
 void
 Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 {
-    const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
+    const char * const name
+     = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
 
     if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
 	if (ckWARN(WARN_IO)) {
diff -Nurp blead-77362-glob2lv0/t/op/gv.t blead-77362-glob2lv8/t/op/gv.t
--- blead-77362-glob2lv0/t/op/gv.t	2010-07-26 01:29:10.000000000 -0700
+++ blead-77362-glob2lv8/t/op/gv.t	2010-08-25 22:25:50.000000000 -0700
@@ -7,12 +7,12 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 use warnings;
 
-require './test.pl';
-plan( tests => 192 );
+plan( tests => 217 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -253,11 +253,12 @@ is($j[0], 1);
     # test the assignment of a GLOB to an LVALUE
     my $e = '';
     local $SIG{__DIE__} = sub { $e = $_[0] };
-    my $v;
+    my %v;
     sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
-    f($v);
-    is ($v, '*main::DATA');
-    my $x = <$v>;
+    f($v{v});
+    is ($v{v}, '*main::DATA');
+    is (ref\$v{v}, 'GLOB', 'lvalue assignment preserves globs');
+    my $x = readline $v{v};
     is ($x, "perl\n");
 }
 
@@ -272,6 +273,10 @@ is($j[0], 1);
     tie my @ary => "T";
     $ary[0] = *DATA;
     is ($ary[0], '*main::DATA');
+    is (
+      ref\tied(@ary)->[0], 'GLOB',
+     'tied elem assignment preserves globs'
+    );
     is ($e, '');
     my $x = readline $ary[0];
     is($x, "rocks\n");
@@ -634,6 +639,125 @@ is (scalar $::{fake}, "*main::sym",
     );
 }
 
+# [perl #77362] various bugs related to globs as PVLVs
+{
+ no warnings qw 'once void';
+ my %h; # We pass a key of this hash to the subroutine to get a PVLV.
+ sub { for(shift) {
+  # Set up our glob-as-PVLV
+  $_ = *hon;
+
+  # Bad symbol for array
+  ok eval{ @$_; 1 }, 'PVLV glob slots can be autovivified' or diag $@;
+
+  # This should call TIEHANDLE, not TIESCALAR
+  *thext::TIEHANDLE = sub{};
+  ok eval{ tie *$_, 'thext'; 1 }, 'PVLV globs can be tied as handles'
+   or diag $@;
+
+  # Assigning undef to the glob should not overwrite it...
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w = shift };
+   *$_ = undef;
+   is $_, "*main::hon", 'PVLV: assigning undef to the glob does nothing';
+   like $w, qr\Undefined value assigned to typeglob\,
+    'PVLV: assigning undef to the glob warns';
+  }
+
+  # Neither should number assignment...
+  *$_ = 1;
+  is $_, "*main::1", "PVLV: integer-to-glob assignment assigns a glob";
+  *$_ = 2.0;
+  is $_, "*main::2", "PVLV: float-to-glob assignment assigns a glob";
+
+  # Nor reference assignment.
+  *$_ = \*thit;
+  is $_, "*main::thit", "PVLV: globref-to-glob assignment assigns a glob";
+  *$_ = [];
+  is $_, "*main::thit", "PVLV: arrayref assignment assigns to the AV slot";
+
+  # Concatenation should still work.
+  ok eval { $_ .= 'thlew' }, 'PVLV concatenation does not die' or diag $@;
+  is $_, '*main::thitthlew', 'PVLV concatenation works';
+
+  # And we should be able to overwrite it with a string, number, or refer-
+  # ence, too, if we omit the *.
+  $_ = *hon; $_ = 'tzor';
+  is $_, 'tzor', 'PVLV: assigning a string over a glob';
+  $_ = *hon; $_ = 23;
+  is $_, 23, 'PVLV: assigning an integer over a glob';
+  $_ = *hon; $_ = 23.23;
+  is $_, 23.23, 'PVLV: assigning a float over a glob';
+  $_ = *hon; $_ = \my $sthat;
+  is $_, \$sthat, 'PVLV: assigning a reference over a glob';
+
+  # This bug was found by code inspection. Could this ever happen in
+  # real life? :-)
+  # This duplicates a file handle, accessing it through a PVLV glob, the
+  # glob having been removed from the symbol table, so a stringified form
+  # of it does not work. This checks that sv_2io does not stringify a PVLV.
+  $_ = *quin;
+  open *quin, "test.pl"; # test.pl is as good a file as any
+  delete $::{quin};
+  ok eval { open my $zow, "<&", $_ }, 'PVLV: sv_2io stringifieth not'
+   or diag $@;
+
+  # Similar tests to make sure sv_2cv etc. do not stringify.
+  *$_ = sub { 1 };
+  ok eval { &$_ }, "PVLV glob can be called as a sub" or diag $@;
+  *flelp = sub { 2 };
+  $_ = 'flelp';
+  is eval { &$_ }, 2, 'PVLV holding a string can be called as a sub'
+   or diag $@;
+
+  # Coderef-to-glob assignment when the glob is no longer accessible
+  # under its name: These tests are to make sure the OPpASSIGN_CV_TO_GV
+  # optimisation takes PVLVs into account, which is why the RHSs have to be
+  # named subs.
+  use constant gheen => 'quare';
+  $_ = *ming;
+  delete $::{ming};
+  *$_ = \&gheen;
+  is eval { &$_ }, 'quare',
+   'PVLV: constant assignment when the glob is detached from the symtab'
+    or diag $@;
+  $_ = *bength;
+  delete $::{bength};
+  *gheck = sub { 'lon' };
+  *$_ = \&gheck;
+  is eval { &$_ }, 'lon',
+   'PVLV: coderef assignment when the glob is detached from the symtab'
+    or diag $@;
+
+  # open should accept a PVLV as its first argument
+  $_ = *hon;
+  ok eval { open $_,'<', \my $thlext }, 'PVLV can be the first arg to open'
+   or diag $@;
+
+  # -t should not stringify
+  $_ = *thlit; delete $::{thlit};
+  *$_ = *STDOUT{IO};
+  ok defined -t $_, 'PVLV: -t does not stringify';
+
+  # neither should -T
+  open my $quile, "<", 'test.pl';
+  $_ = *$quile;
+  ok -T $_, "PVLV: -T does not stringify";
+  
+  # Unopened file handle
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w .= shift };
+   $_ = *vor;
+   close $_;
+   like $w, qr\unopened filehandle vor\,
+    'PVLV globs get their names reported in unopened error messages';
+  }
+
+ }}->($h{k});
+}
+
 __END__
 Perl
 Rules

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 5, 2010

From @cpansprout

This turns out to be a duplicate of #36051.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 26, 2010

From @cpansprout

On Sun Sep 05 13​:45​:54 2010, sprout wrote​:

Here is a better patch that avoids a void warning.

Applied as 13be902.

Now the original script in this ticket will work again, the way it did
in 5.003. :-)

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 26, 2010

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

Loading

@p5pRT p5pRT closed this Sep 26, 2010
@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 26, 2010

From @cpansprout

On Sun Sep 26 12​:21​:02 2010, sprout wrote​:

On Sun Sep 05 13​:45​:54 2010, sprout wrote​:

Here is a better patch that avoids a void warning.

Applied as 13be902.

Now the original script in this ticket will work again, the way it did
in 5.003. :-)

I forgot to forward this to p5p.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 26, 2010

From [Unknown Contact. See original ticket]

On Sun Sep 26 12​:21​:02 2010, sprout wrote​:

On Sun Sep 05 13​:45​:54 2010, sprout wrote​:

Here is a better patch that avoids a void warning.

Applied as 13be902.

Now the original script in this ticket will work again, the way it did
in 5.003. :-)

I forgot to forward this to p5p.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 27, 2010

From @tonycoz

On Sun, Sep 26, 2010 at 12​:22​:22PM -0700, Father Chrysostomos via RT wrote​:

On Sun Sep 26 12​:21​:02 2010, sprout wrote​:

On Sun Sep 05 13​:45​:54 2010, sprout wrote​:

Here is a better patch that avoids a void warning.

Applied as 13be902.

Now the original script in this ticket will work again, the way it did
in 5.003. :-)

I forgot to forward this to p5p.

The tests for this fail for PERLIO=stdio

tony@​mars​:.../perl/t$ PERLIO=stdio ./perl harness -v op/gv.t
op/gv.t ..
1..219
ok 1
ok 2
ok 3
ok 4
<snip>
ok 215 - PVLV​: coderef assignment when the glob is detached from the symtab
ok 216 - PVLV can be the first arg to open
ok 217 - PVLV​: -t does not stringify
-T and -B not implemented on filehandles at op/gv.t line 764.
# Looks like you planned 219 tests but ran 217.
Dubious, test returned 22 (wstat 5632, 0x1600)
Failed 2/219 subtests

Test Summary Report


op/gv.t (Wstat​: 5632 Tests​: 217 Failed​: 0)
  Non-zero exit status​: 22
  Parse errors​: Bad plan. You planned 219 tests but ran 217.
Files=1, Tests=217, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.03 cusr 0.00 cs
ys = 0.05 CPU)
Result​: FAIL
tony@​mars​:.../perl/t$

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 27, 2010

From @cpansprout

On Sep 26, 2010, at 6​:33 PM, Tony Cook via RT wrote​:

On Sun, Sep 26, 2010 at 12​:22​:22PM -0700, Father Chrysostomos via RT wrote​:

On Sun Sep 26 12​:21​:02 2010, sprout wrote​:

On Sun Sep 05 13​:45​:54 2010, sprout wrote​:

Here is a better patch that avoids a void warning.

Applied as 13be902.

Now the original script in this ticket will work again, the way it did
in 5.003. :-)

I forgot to forward this to p5p.

The tests for this fail for PERLIO=stdio

tony@​mars​:.../perl/t$ PERLIO=stdio ./perl harness -v op/gv.t
op/gv.t ..
1..219
ok 1
ok 2
ok 3
ok 4
<snip>
ok 215 - PVLV​: coderef assignment when the glob is detached from the symtab
ok 216 - PVLV can be the first arg to open
ok 217 - PVLV​: -t does not stringify
-T and -B not implemented on filehandles at op/gv.t line 764.
# Looks like you planned 219 tests but ran 217.
Dubious, test returned 22 (wstat 5632, 0x1600)
Failed 2/219 subtests

Does 804401e solve the problem for you? (It doesn’t fail on Mac OS X.)

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Sep 27, 2010

From @tonycoz

On Sun, Sep 26, 2010 at 10​:19​:16PM -0700, Father Chrysostomos wrote​:

On Sep 26, 2010, at 6​:33 PM, Tony Cook via RT wrote​:

ok 216 - PVLV can be the first arg to open
ok 217 - PVLV​: -t does not stringify
-T and -B not implemented on filehandles at op/gv.t line 764.
# Looks like you planned 219 tests but ran 217.
Dubious, test returned 22 (wstat 5632, 0x1600)
Failed 2/219 subtests

Does 804401e solve the problem for you? (It doesn’t fail on Mac OS X.)

That fixed it.

Tony

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Oct 27, 2010

From @cpansprout

This turns out to be a duplicate of #36051.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Oct 26, 2012

From @cpansprout

On Tue May 31 07​:20​:09 2005, nicholas wrote​:

This is a bug report for perl from nick@​ccl4.org,
generated with the help of perlbug 1.35 running under perl v5.9.3.

-----------------------------------------------------------------
[Please enter your report here]

If you pass a hash element as an argument to a subroutine and assign a
glob
to it, you get inconsistent results.

If the element did not exist​:

$ perl5.9.3 -MDevel​::eeek -le 'sub f { $_[0] = *FOO } f($h{foo}); Dump
$h{foo}'
SV = PVNV(0x8167370) at 0x81633b0
REFCNT = 1
FLAGS = (POK,pPOK)
IV = 0
NV = 0
PV = 0x81620d0 "*main​::FOO"\0
CUR = 10
LEN = 11

If the element exists before the call​:

$ perl5.9.3 -MDevel​::Peek -le 'sub f { $_[0] = *FOO } $h{foo}=1;
f($h{foo}); Dump $h{foo}'
SV = PVGV(0x818c210) at 0x81630a0
REFCNT = 1
FLAGS = (GMG,SMG,FAKE,MULTI)
IV = 1
NV = 0
MAGIC = 0x81886c0
MG_VIRTUAL = &PL_vtbl_glob
MG_TYPE = PERL_MAGIC_glob(*)
MG_OBJ = 0x81630a0
NAME = "FOO"
NAMELEN = 3
GvSTASH = 0x81630d0 "main"
GP = 0x8174880
SV = 0x8176270
REFCNT = 2
IO = 0x0
FORM = 0x0
AV = 0x0
HV = 0x0
CV = 0x0
CVGEN = 0x0
GPFLAGS = 0x0
LINE = 1
FILE = "-e"
FLAGS = 0x2
EGV = 0x8176280 "FOO"

Presumably now that PVLVs are large enough to hold the full PVGV info,
the
LVALUE tie magic should know how to assign out a typeglob.

Nicholas Clark

I fixed that in 13be902 some time ago, but that is not the whole story.

The same thing occurs with regexps. Substitute ${qr||} for *FOO in the
assignments above, and you will see regexps stringify.

I thought perhaps the solution would be to disallow ${qr||} and make
REGEXP an opaque type, but *foo = qr// has to do something, so I think
it has to remain a scalar.

But XPVLV and struct regexp conflict.

--

Father Chrysostomos

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Oct 30, 2012

From @cpansprout

On Fri Oct 26 06​:32​:19 2012, sprout wrote​:

I fixed that in 13be902 some time ago, but that is not the whole story.

The same thing occurs with regexps. Substitute ${qr||} for *FOO in the
assignments above, and you will see regexps stringify.

I thought perhaps the solution would be to disallow ${qr||} and make
REGEXP an opaque type, but *foo = qr// has to do something, so I think
it has to remain a scalar.

But XPVLV and struct regexp conflict.

Now fixed in 8d919b0.

--

Father Chrysostomos

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Oct 30, 2012

From [Unknown Contact. See original ticket]

On Fri Oct 26 06​:32​:19 2012, sprout wrote​:

I fixed that in 13be902 some time ago, but that is not the whole story.

The same thing occurs with regexps. Substitute ${qr||} for *FOO in the
assignments above, and you will see regexps stringify.

I thought perhaps the solution would be to disallow ${qr||} and make
REGEXP an opaque type, but *foo = qr// has to do something, so I think
it has to remain a scalar.

But XPVLV and struct regexp conflict.

Now fixed in 8d919b0.

--

Father Chrysostomos

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 29, 2014

From @bulk88

I am currently rewriting Perl_gv_add_by_type but I see something strange
in the existing code.

http​://perl5.git.perl.org/perl.git/commitdiff/13be902cef8b01c085a6b8b1b59fa2754a10cdfb
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=77362

So what is the sv_u of a PVLV? Why would a LV have a GP ptr? I thought
the sv_u of a PVLV was a PV buffer. I have some old XS code to
de-magic/vivify a hash slice, since otherwise I need to croak.

  if (SvREADONLY(buffer)) {
  croak(PL_no_modify);
  }
  if(SvTYPE(buffer) == SVt_PVLV && LvTYPE(buffer) == 'y'){
  sv_setpv_mg(buffer, " ");
  if(LvTARG(buffer)) buffer = LvTARG(buffer);
  }
  if (SvMAGICAL(buffer)) {
  DumpSV(buffer);
  croak("%s​: magic scalar as buffer not supported.", cvname);
  }

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 29, 2014

From @cpansprout

On Mon Dec 29 13​:57​:37 2014, bulk88 wrote​:

I am currently rewriting Perl_gv_add_by_type but I see something
strange
in the existing code.

http​://perl5.git.perl.org/perl.git/commitdiff/13be902cef8b01c085a6b8b1b59fa2754a10cdfb
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=77362

So what is the sv_u of a PVLV? Why would a LV have a GP ptr?

If you assign a typeglob to a deferred element or to an element of a tied aggregate, then you get a PVLV that is a typeglob.

I thought
the sv_u of a PVLV was a PV buffer.

The sv_u of a PVLV may differ just as much as the sv_u of a PVMG. It can hold an SV pointer if you assigned a reference to a PVLV.

Actually, it can differ more. A PVLV can also be a REGEXP thingy (with sv_u pointing to the regexp struct) even though the internal type is SVt_PVLV, not SVt_REGEXP. This is because PVLV needs to be able to hold any type of scalar.

I have some old XS code to
de-magic/vivify a hash slice, since otherwise I need to croak.

if (SvREADONLY(buffer)) {
croak(PL_no_modify);
}
if(SvTYPE(buffer) == SVt_PVLV && LvTYPE(buffer) == 'y'){
sv_setpv_mg(buffer, " ");
if(LvTARG(buffer)) buffer = LvTARG(buffer);
}
if (SvMAGICAL(buffer)) {
DumpSV(buffer);
croak("%s​: magic scalar as buffer not supported.", cvname);
}

I am confused as to why that code would be affected by the sv_u field of a PVLV.

--

Father Chrysostomos

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 30, 2014

From @bulk88

On Mon Dec 29 14​:41​:37 2014, sprout wrote​:

On Mon Dec 29 13​:57​:37 2014, bulk88 wrote​:

I am currently rewriting Perl_gv_add_by_type but I see something
strange
in the existing code.

http​://perl5.git.perl.org/perl.git/commitdiff/13be902cef8b01c085a6b8b1b59fa2754a10cdfb
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=77362

So what is the sv_u of a PVLV? Why would a LV have a GP ptr?

If you assign a typeglob to a deferred element or to an element of a
tied aggregate, then you get a PVLV that is a typeglob.

Wouldn't that cause a "Bizzare copy of" panic later, since aggregate slices are scalars (you can only place a RV to an aggregate in a aggregate slice)?


C​:\>perl -MDevel​::Peek=Dump -E"my $s = ' '; Dump($s); $s = *ARGV​::; Dump($s); $s
='h'; Dump($s)"
SV = PV(0x369a0c) at 0x8fbebc
  REFCNT = 1
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x90667c " "\0
  CUR = 1
  LEN = 10
  COW_REFCNT = 1
SV = PVGV(0x9010a4) at 0x8fbebc
  REFCNT = 1
  FLAGS = (FAKE,MULTI)
  NAME = "ARGV​::"
  NAMELEN = 6
  GvSTASH = 0x368bbc "main"
  FLAGS = 0x2
  GP = 0x9084cc
  SV = 0x0
  REFCNT = 2
  IO = 0x0
  FORM = 0x0
  AV = 0x0
  HV = 0x8fbe8c
  CV = 0x0
  CVGEN = 0x0
  GPFLAGS = 0x0 ()
  LINE = 1
  FILE = "-e"
  EGV = 0x368d5c "ARGV​::"
SV = PVMG(0x8f453c) at 0x8fbebc
  REFCNT = 1
  FLAGS = (POK,IsCOW,pPOK)
  IV = 9463952
  NV = 0
  PV = 0x91ad74 "h"\0
  CUR = 1
  LEN = 10
  COW_REFCNT = 1

C​:\>


This is breaking the rule you can't downgrade an SV.

Also this doesnt SEGVs since sv_upgrade leaves the PVX buffer of a PV intact, sv_clear falls through from case SVt_PVGV" to the regular PV type, and there is no SEGV clearing the GP since this half GV fails isGV_with_GP(sv). I know Perl_gv_init_pvn does black magic to make sv_upgrade(sv, SVt_PVGV); safe.

void t3()
PREINIT​:
  volatile SV* sv;
  int i;
PPCODE​:
  for(i =0; i < 40000000; i++) {
  sv = newSVpvn("camel", 5);
  sv_upgrade(sv, SVt_PVGV);
  //sv_dump(GvSVn((GV*)sv)); /* crash */
  SvREFCNT_dec_NN(sv);
  }

But here I defeated all the logic and made a leak

void t4()
PREINIT​:
  volatile SV* sv;
  int i;
PPCODE​:

  for(i =0; i < 400000000; i++) {
  sv = gv_fetchpv("camelpack", GV_ADD, SVt_PVAV);
  sv_setpvn(sv, "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00", sizeof(GP));
  }

The reason a string doesn't work to make a leak is since S_gv_init_svtype checks the GP struct (which is a PV buffer with invalid pointers) for NULL pointer, and a string isn't going to be interpreted as a NULL pointers unless I did the above, also the type requested must be IO HV or AV.

A different variant, I couldn't get it to SEGV.

void t4()
PREINIT​:
  volatile SV* sv;
  int i;
PPCODE​:
  for(i =0; i < 4; i++) {
  sv = gv_fetchpv("*main​::camelpack", GV_ADD, SVt_PVAV);
  sv_setpvn(sv, "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00"
  "\x00\x00\x00\x00\x00\x00\x00\x00", sizeof(GP));
  sv_dump(sv);
  }

C​:\Documents and Settings\Owner\Desktop\cpan libs\lxs2>perl -MLocal​::XS2 -MDevel
:​:Peek=Dump -E"Local​::XS​::t4(); Dump(*camelpack)"
SV = PVGV(0x963954) at 0x8fbf5c
  REFCNT = 2
  FLAGS = (POK,pPOK)
  IV = 9688024
  NV = 1.76614436923904e-317
  PV = 0x976e7c "\377\377\377\377\377\377\377\377\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\
0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"\0
  CUR = 44
  LEN = 46
SV = PVGV(0x963954) at 0x8fbf5c
  REFCNT = 2
  FLAGS = (POK,pPOK)
  IV = 9688024
  NV = 1.76614436923904e-317
  PV = 0x976e7c "\377\377\377\377\377\377\377\377\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\
0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"\0
  CUR = 44
  LEN = 46
SV = PVGV(0x963954) at 0x8fbf5c
  REFCNT = 2
  FLAGS = (POK,pPOK)
  IV = 9688024
  NV = 1.76614436923904e-317
  PV = 0x976e7c "\377\377\377\377\377\377\377\377\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\
0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"\0
  CUR = 44
  LEN = 46
SV = PVGV(0x963954) at 0x8fbf5c
  REFCNT = 2
  FLAGS = (POK,pPOK)
  IV = 9688024
  NV = 1.76614436923904e-317
  PV = 0x976e7c "\377\377\377\377\377\377\377\377\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\
0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"\0
  CUR = 44
  LEN = 46
SV = PVGV(0x9639b4) at 0x8fb70c
  REFCNT = 1
  FLAGS = ()
  NAME = "\xff\xff\xff\xff\xff\xff\xff\xff\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
  NAMELEN = 44
  GvSTASH = 0x368bbc "main"
  FLAGS = 0x0
  GP = 0x93db94
  SV = 0x0
  REFCNT = 1
  IO = 0x0
  FORM = 0x0
  AV = 0x0
  HV = 0x0
  CV = 0x0
  CVGEN = 0x0
  GPFLAGS = 0x0 ()
  LINE = 1
  FILE = "-e"
  EGV = 0x8fb70c "\xff\xff\xff\xff\xff\xff\xff\xff\0\0\0\0\0\0\0\0\0\0\0\
0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"

C​:\Documents and Settings\Owner\Desktop\cpan libs\lxs2>

SvPV does work correctly on a GV *.

  else if (isGV_with_GP(sv)) {
  GV *const gv = MUTABLE_GV(sv);
  SV *const buffer = sv_newmortal();

  gv_efullname3(buffer, gv, "*");

  assert(SvPOK(buffer));
  if (SvUTF8(buffer))
  SvUTF8_on(sv);
  if (lp)
  *lp = SvCUR(buffer);
  return SvPVX(buffer);
  }

I thought
the sv_u of a PVLV was a PV buffer.

The sv_u of a PVLV may differ just as much as the sv_u of a PVMG. It
can hold an SV pointer if you assigned a reference to a PVLV.

Actually, it can differ more. A PVLV can also be a REGEXP thingy
(with sv_u pointing to the regexp struct) even though the internal
type is SVt_PVLV, not SVt_REGEXP. This is because PVLV needs to be
able to hold any type of scalar.

You said scalar. GV/HV/AV are aggregates. I recently encountered "$v = int(${qr||});" in the test suite so I know regexps are scalars.

I have some old XS code to
de-magic/vivify a hash slice, since otherwise I need to croak.

if (SvREADONLY(buffer)) {
croak(PL_no_modify);
}
if(SvTYPE(buffer) == SVt_PVLV && LvTYPE(buffer) == 'y'){
sv_setpv_mg(buffer, " ");
if(LvTARG(buffer)) buffer = LvTARG(buffer);
}
if (SvMAGICAL(buffer)) {
DumpSV(buffer);
croak("%s​: magic scalar as buffer not supported.", cvname);
}

I am confused as to why that code would be affected by the sv_u field
of a PVLV.

Wouldn't sv_setpv_mg(buffer, " ") leak or croak panic if its done on a GV, AV or HV, or my "LvTYPE(buffer) == 'y'" guarantees the PVLV is a scalar type? I already have 1 memleak above.

--
bulk88 ~ bulk88 at hotmail.com

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 30, 2014

From @cpansprout

On Mon Dec 29 19​:59​:35 2014, bulk88 wrote​:

On Mon Dec 29 14​:41​:37 2014, sprout wrote​:

On Mon Dec 29 13​:57​:37 2014, bulk88 wrote​:

I am currently rewriting Perl_gv_add_by_type but I see something
strange
in the existing code.

http​://perl5.git.perl.org/perl.git/commitdiff/13be902cef8b01c085a6b8b1b59fa2754a10cdfb
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=77362

So what is the sv_u of a PVLV? Why would a LV have a GP ptr?

If you assign a typeglob to a deferred element or to an element of a
tied aggregate, then you get a PVLV that is a typeglob.

Wouldn't that cause a "Bizzare copy of" panic later, since aggregate
slices are scalars (you can only place a RV to an aggregate in a
aggregate slice)?

I don’t follow.

This is what I am talking about​:

use Devel​::Peek;
sub { $_[0] = *foo; Dump $_[0] }->($h{nonexistent_elem});

-------------------------------------------------------------------
C​:\>perl -MDevel​::Peek=Dump -E"my $s = ' '; Dump($s); $s = *ARGV​::;
Dump($s); $s
='h'; Dump($s)"
SV = PV(0x369a0c) at 0x8fbebc
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0x90667c " "\0
CUR = 1
LEN = 10
COW_REFCNT = 1
SV = PVGV(0x9010a4) at 0x8fbebc
REFCNT = 1
FLAGS = (FAKE,MULTI)
NAME = "ARGV​::"
NAMELEN = 6
GvSTASH = 0x368bbc "main"
FLAGS = 0x2
GP = 0x9084cc
SV = 0x0
REFCNT = 2
IO = 0x0
FORM = 0x0
AV = 0x0
HV = 0x8fbe8c
CV = 0x0
CVGEN = 0x0
GPFLAGS = 0x0 ()
LINE = 1
FILE = "-e"
EGV = 0x368d5c "ARGV​::"
SV = PVMG(0x8f453c) at 0x8fbebc
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
IV = 9463952
NV = 0
PV = 0x91ad74 "h"\0
CUR = 1
LEN = 10
COW_REFCNT = 1

C​:\>
---------------------------------------------------------

This is breaking the rule you can't downgrade an SV.

I have heard of that rule before, but I don’t remember the source. I think it I read it in illguts. But it’s actually not true, and never was.

http​://perl5.git.perl.org/perl.git/blob/perl-5.000​:/sv.c#l3170

Also this doesnt SEGVs since sv_upgrade leaves the PVX buffer of a PV
intact, sv_clear falls through from case SVt_PVGV" to the regular PV
type, and there is no SEGV clearing the GP since this half GV fails
isGV_with_GP(sv). I know Perl_gv_init_pvn does black magic to make
sv_upgrade(sv, SVt_PVGV); safe.

void t3()
PREINIT​:
volatile SV* sv;
int i;
PPCODE​:
for(i =0; i < 40000000; i++) {
sv = newSVpvn("camel", 5);
sv_upgrade(sv, SVt_PVGV);
//sv_dump(GvSVn((GV*)sv)); /* crash */
SvREFCNT_dec_NN(sv);
}

But here I defeated all the logic and made a leak

This part of the core is a bit confusing. You see, scalars with BM magic used to be of type SVt_PVGV, but were later changed to SVt_PVMG. Some parts of the core still account for the latter, but others expect SVt_PVGV always to be a genuine GV with GP.

void t4()
PREINIT​:
volatile SV* sv;
int i;
PPCODE​:

for(i =0; i < 400000000; i++) {
sv = gv_fetchpv("camelpack", GV_ADD, SVt_PVAV);
sv_setpvn(sv, "\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00"
"\x00\x00\x00\x00\x00\x00\x00\x00", sizeof(GP));
}

Ouch. That should probably croak or fail an assertion.

I thought
the sv_u of a PVLV was a PV buffer.

The sv_u of a PVLV may differ just as much as the sv_u of a PVMG. It
can hold an SV pointer if you assigned a reference to a PVLV.

Actually, it can differ more. A PVLV can also be a REGEXP thingy
(with sv_u pointing to the regexp struct) even though the internal
type is SVt_PVLV, not SVt_REGEXP. This is because PVLV needs to be
able to hold any type of scalar.

You said scalar. GV/HV/AV are aggregates.

GV is also a type of scalar. (This goes back at least to perl 5.) You can bind the $ sigil to any typeglob.

use Devel​::Peek;
foreach (*foo) { $_ = \&bar; Dump $_ }

A typeglob created by assignment ($_ = *foo) is coercible.

Yes, this is a design flaw.

I recently encountered "$v =
int(${qr||});" in the test suite so I know regexps are scalars.

I have some old XS code to
de-magic/vivify a hash slice, since otherwise I need to croak.

if (SvREADONLY(buffer)) {
croak(PL_no_modify);
}
if(SvTYPE(buffer) == SVt_PVLV && LvTYPE(buffer) == 'y'){
sv_setpv_mg(buffer, " ");
if(LvTARG(buffer)) buffer = LvTARG(buffer);
}
if (SvMAGICAL(buffer)) {
DumpSV(buffer);
croak("%s​: magic scalar as buffer not supported.", cvname);
}

I am confused as to why that code would be affected by the sv_u field
of a PVLV.

Wouldn't sv_setpv_mg(buffer, " ") leak or croak panic if its done on a
GV, AV or HV, or my "LvTYPE(buffer) == 'y'" guarantees the PVLV is a
scalar type? I already have 1 memleak above.

That it is an SVt_PVLV guarantees it is a scalar. When a PVLV is a GV, it should always be of the coercible type.

Hmmm.

use experimental 'refaliasing';
\$​::{foo} = \substr $_, 1;
*{"foo"};

Oh no. I don’t want to think about that.

--

Father Chrysostomos

Loading

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