LVALUE magic should know how to assign to globs

[p5pRT]

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

Searchable as RT36051$

[p5pRT]

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

[p5pRT]

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

[p5pRT]

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.

[p5pRT]

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

[p5pRT]

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.

[p5pRT]

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

[p5pRT]

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.

[p5pRT]

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

[p5pRT]

From @cpansprout

This turns out to be a duplicate of #36051.

[p5pRT]

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. :-)

[p5pRT]

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

[p5pRT]

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.

[p5pRT]

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.

[p5pRT]

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$