From: Tassilo von Parseval Date: Tue, 17 Feb 2004 17:32:16 +0000 (+0100) Subject: Re: [PATCH] GLOB to LVALUE assignment fix X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ce457a6488a69b8fafc38a9468220b68d66eddb;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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