Re: [PATCH] GLOB to LVALUE assignment fix

Message-Id:  <20040217163216.GA6805@ethan>

Make PVLV a superset of PVGV, so that $lvalue = *FOO works

p4raw-id: //depot/perl@22315

diff --git a/dump.c b/dump.c
index 5f56689..17e132b 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1034,7 +1034,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (HvHASKFLAGS(sv))    sv_catpv(d, "HASKFLAGS,");
        if (HvREHASH(sv))       sv_catpv(d, "REHASH,");
        break;
-    case SVt_PVGV:
+    case SVt_PVGV: case SVt_PVLV:
        if (GvINTRO(sv))        sv_catpv(d, "INTRO,");
        if (GvMULTI(sv))        sv_catpv(d, "MULTI,");
        if (GvUNIQUE(sv))       sv_catpv(d, "UNIQUE,");
@@ -1170,7 +1170,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        SvREFCNT_dec(d);
        return;
     }
-    if (type <= SVt_PVLV) {
+    if (type <= SVt_PVLV && type != SVt_PVGV) {
        if (SvPVX(sv)) {
            Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
            if (SvOOK(sv))
@@ -1192,15 +1192,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            do_hv_dump(level, file, "  STASH", SvSTASH(sv));
     }
     switch (type) {
-    case SVt_PVLV:
-       Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
-       Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
-       Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
-       Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
-       if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
-           do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
-                   dumpops, pvlim);
-       break;
     case SVt_PVAV:
        Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv)));
        if (AvARRAY(sv) != AvALLOC(sv)) {
@@ -1357,7 +1348,16 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
            do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
        break;
-    case SVt_PVGV:
+    case SVt_PVGV: case SVt_PVLV:
+    if (type == SVt_PVLV) {
+        Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
+        Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
+        Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv));
+        Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv)));
+        if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T')
+            do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
+                dumpops, pvlim);
+    }
        Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
        Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
        do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));

diff --git a/ext/B/B.pm b/ext/B/B.pm
index c4d0d45..5659da3 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -36,7 +36,7 @@ use strict;
 @B::PVIV::ISA = qw(B::PV B::IV);
 @B::PVNV::ISA = qw(B::PV B::NV);
 @B::PVMG::ISA = 'B::PVNV';
-@B::PVLV::ISA = 'B::PVMG';
+@B::PVLV::ISA = 'B::GV';
 @B::BM::ISA = 'B::PVMG';
 @B::AV::ISA = 'B::PVMG';
 @B::GV::ISA = 'B::PVMG';
@@ -547,11 +547,11 @@ inheritance hierarchy mimics the underlying C "inheritance":
                            |
                         B::PVMG
                            |
-         +------+-----+----+------+-----+-----+
-         |      |     |    |      |     |     |
-      B::PVLV B::BM B::AV B::GV B::HV B::CV B::IO
-                                        |
-                                        |
+                +-----+----+------+-----+-----+
+                |     |    |      |     |     |
+              B::BM B::AV B::GV B::HV B::CV B::IO
+                           |            |
+                        B::PVLV         |
                                       B::FM
 
 

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 3aac784..f428fbd 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -29,11 +29,11 @@ static char *svclassnames[] = {
     "B::PVNV",
     "B::PVMG",
     "B::BM",
+    "B::GV",
     "B::PVLV",
     "B::AV",
     "B::HV",
     "B::CV",
-    "B::GV",
     "B::FM",
     "B::IO",
 };

diff --git a/pp.c b/pp.c
index f06e71f..3426ca2 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -830,7 +830,7 @@ PP(pp_undef)
 PP(pp_predec)
 {
     dSP;
-    if (SvTYPE(TOPs) > SVt_PVLV)
+    if (SvTYPE(TOPs) == SVt_PVGV || SvTYPE(TOPs) > SVt_PVLV)
        DIE(aTHX_ PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
@@ -847,7 +847,7 @@ PP(pp_predec)
 PP(pp_postinc)
 {
     dSP; dTARGET;
-    if (SvTYPE(TOPs) > SVt_PVLV)
+    if (SvTYPE(TOPs) == SVt_PVGV || SvTYPE(TOPs) > SVt_PVLV)
        DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
@@ -869,7 +869,7 @@ PP(pp_postinc)
 PP(pp_postdec)
 {
     dSP; dTARGET;
-    if (SvTYPE(TOPs) > SVt_PVLV)
+    if (SvTYPE(TOPs) == SVt_PVGV || SvTYPE(TOPs) > SVt_PVLV)
        DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)

diff --git a/pp_hot.c b/pp_hot.c
index ccfbf41..48ac968 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -295,7 +295,7 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
-    if (SvTYPE(TOPs) > SVt_PVLV)
+    if (SvTYPE(TOPs) == SVt_PVGV || SvTYPE(TOPs) > SVt_PVLV)
        DIE(aTHX_ PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
@@ -1980,8 +1980,8 @@ PP(pp_subst)
        !is_cow &&
 #endif
        (SvREADONLY(TARG)
-       || (SvTYPE(TARG) > SVt_PVLV
-           && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
+       || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+            && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
        DIE(aTHX_ PL_no_modify);
     PUTBACK;
 

diff --git a/sv.c b/sv.c
index 98f19c5..3d8ad42 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1455,6 +1455,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        LvTARGLEN(sv)   = 0;
        LvTARG(sv)      = 0;
        LvTYPE(sv)      = 0;
+    GvGP(sv)    = 0;
+    GvNAME(sv)  = 0;
+    GvNAMELEN(sv)   = 0;
+    GvSTASH(sv) = 0;
+    GvFLAGS(sv) = 0;
        break;
     case SVt_PVAV:
        SvANY(sv) = new_XPVAV();
@@ -3783,7 +3788,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            if (dtype != SVt_PVGV) {
                char *name = GvNAME(sstr);
                STRLEN len = GvNAMELEN(sstr);
-               sv_upgrade(dstr, SVt_PVGV);
+        if (dtype != SVt_PVLV)  /* don't upgrade SVt_PVLV: it can hold a glob */
+            sv_upgrade(dstr, SVt_PVGV);
                sv_magic(dstr, dstr, PERL_MAGIC_glob, Nullch, 0);
                GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
                GvNAME(dstr) = savepvn(name, len);

diff --git a/sv.h b/sv.h
index c694dab..1dbf6ea 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -53,11 +53,11 @@ typedef enum {
        SVt_PVNV,       /* 6 */
        SVt_PVMG,       /* 7 */
        SVt_PVBM,       /* 8 */
-       SVt_PVLV,       /* 9 */
-       SVt_PVAV,       /* 10 */
-       SVt_PVHV,       /* 11 */
-       SVt_PVCV,       /* 12 */
-       SVt_PVGV,       /* 13 */
+       SVt_PVGV,       /* 9 */
+       SVt_PVLV,       /* 10 */
+       SVt_PVAV,       /* 11 */
+       SVt_PVHV,       /* 12 */
+       SVt_PVCV,       /* 13 */
        SVt_PVFM,       /* 14 */
        SVt_PVIO        /* 15 */
 } svtype;
@@ -272,6 +272,13 @@ struct xpvlv {
     MAGIC*     xmg_magic;      /* linked list of magicalness */
     HV*                xmg_stash;      /* class package */
 
+    /* a full glob fits into this */
+    GP*                xgv_gp;
+    char*      xgv_name;
+    STRLEN     xgv_namelen;
+    HV*                xgv_stash;
+    U8         xgv_flags;
+
     STRLEN     xlv_targoff;
     STRLEN     xlv_targlen;
     SV*                xlv_targ;

diff --git a/t/op/gv.t b/t/op/gv.t
index 9b347d3..5b1237a 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use warnings;
 
-print "1..48\n";
+print "1..52\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -217,6 +217,33 @@ print $j[0] == 1 ? "ok 43\n" : "not ok 43\n";
     print $x;
 }
 
+{
+    # 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);
+    print $v eq '*main::DATA' ? "ok 49\n" : "not ok 49\n# $e";
+    my $x = <$v>;
+    print $x || "not ok 50\n";
+}
+
+{   
+    # GLOB assignment to tied element
+    local $SIG{__DIE__} = sub { $e = $_[0] };
+    sub T::TIEARRAY { bless [] => "T" }
+    sub T::STORE    { $_[0]->[ $_[1] ] = $_[2] }
+    sub T::FETCH    { $_[0]->[ $_[1] ] }
+    tie my @ary => "T";
+    $ary[0] = *DATA;
+    print $ary[0] eq '*main::DATA' ? "ok 51\n" : "not ok 51\n# $e";
+    my $x = readline $ary[0];
+    print $x || "not ok 52\n";
+}
+
 __END__
 ok 44
 ok 48
+ok 50
+ok 52