Change 23625 by [EMAIL PROTECTED] on 2004/12/07 23:09:13
Integrate:
[ 19505]
Subject: Re: Bug stomping fun. [PATCH: bug #1016]
From: Alex Vandiver <[EMAIL PROTECTED]>
Date: 02 May 2003 06:45:05 -0400
Message-Id: <[EMAIL PROTECTED]>
(plus perldiag nit)
[ 23528]
Fix for bug: [perl #32562] __PACKAGE__ symbol has wrong value
after eval or require
Affected files ...
... //depot/maint-5.8/perl/dump.c#29 integrate
... //depot/maint-5.8/perl/gv.c#21 integrate
... //depot/maint-5.8/perl/hv.c#42 integrate
... //depot/maint-5.8/perl/pod/perldiag.pod#65 integrate
... //depot/maint-5.8/perl/pp.c#46 integrate
... //depot/maint-5.8/perl/pp_hot.c#53 integrate
... //depot/maint-5.8/perl/sv.c#118 integrate
... //depot/maint-5.8/perl/t/comp/package.t#2 integrate
... //depot/maint-5.8/perl/toke.c#50 integrate
Differences ...
==== //depot/maint-5.8/perl/dump.c#29 (text) ====
Index: perl/dump.c
--- perl/dump.c#28~23308~ Fri Sep 10 00:28:09 2004
+++ perl/dump.c Tue Dec 7 15:09:13 2004
@@ -966,7 +966,7 @@
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
PerlIO_printf(file, "\t\"");
- if (GvSTASH(sv))
+ if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
PerlIO_printf(file, "%s\"\n", GvNAME(sv));
}
==== //depot/maint-5.8/perl/gv.c#21 (text) ====
Index: perl/gv.c
--- perl/gv.c#20~23313~ Fri Sep 10 02:56:57 2004
+++ perl/gv.c Tue Dec 7 15:09:13 2004
@@ -210,6 +210,10 @@
return 0;
}
+ if (!HvNAME(stash))
+ Perl_croak(aTHX_
+ "Can't use anonymous symbol table for method lookup");
+
if ((level > 100) || (level < -100))
Perl_croak(aTHX_ "Recursive inheritance detected while looking for
method '%s' in package '%s'",
name, HvNAME(stash));
@@ -1091,14 +1095,20 @@
void
Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
{
+ char *name;
HV *hv = GvSTASH(gv);
if (!hv) {
SvOK_off(sv);
return;
}
sv_setpv(sv, prefix ? prefix : "");
- if (keepmain || strNE(HvNAME(hv), "main")) {
- sv_catpv(sv,HvNAME(hv));
+
+ if (!HvNAME(hv))
+ name = "__ANON__";
+ else
+ name = HvNAME(hv);
+ if (keepmain || strNE(name, "main")) {
+ sv_catpv(sv,name);
sv_catpvn(sv,"::", 2);
}
sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
@@ -1427,7 +1437,7 @@
AMT *amtp;
CV *ret;
- if (!stash)
+ if (!stash || !HvNAME(stash))
return Nullcv;
mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
if (!mg) {
==== //depot/maint-5.8/perl/hv.c#42 (text) ====
Index: perl/hv.c
--- perl/hv.c#41~23511~ Wed Nov 17 05:45:34 2004
+++ perl/hv.c Tue Dec 7 15:09:13 2004
@@ -640,6 +640,8 @@
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
}
for (; entry; ++n_links, entry = HeNEXT(entry)) {
+ if (!HeKEY_hek(entry))
+ continue;
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != (I32)klen)
==== //depot/maint-5.8/perl/pod/perldiag.pod#65 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#64~23512~ Wed Nov 17 06:50:18 2004
+++ perl/pod/perldiag.pod Tue Dec 7 15:09:13 2004
@@ -1063,7 +1063,7 @@
=item Can't use anonymous symbol table for method lookup
-(P) The internal routine that does method lookup was handed a symbol
+(F) The internal routine that does method lookup was handed a symbol
table that doesn't have a name. Symbol tables can become anonymous
for example by undefining stashes: C<undef %Some::Package::>.
==== //depot/maint-5.8/perl/pp.c#46 (text) ====
Index: perl/pp.c
--- perl/pp.c#45~23386~ Tue Oct 19 09:56:17 2004
+++ perl/pp.c Tue Dec 7 15:09:13 2004
@@ -602,7 +602,10 @@
break;
case 'P':
if (strEQ(elem, "PACKAGE"))
- sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
+ if (HvNAME(GvSTASH(gv)))
+ sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
+ else
+ sv = newSVpv("__ANON__",0);
break;
case 'S':
if (strEQ(elem, "SCALAR"))
==== //depot/maint-5.8/perl/pp_hot.c#53 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#52~23313~ Fri Sep 10 02:56:57 2004
+++ perl/pp_hot.c Tue Dec 7 15:09:13 2004
@@ -3243,7 +3243,11 @@
/* the method name is unqualified or starts with SUPER:: */
packname = sep ? CopSTASHPV(PL_curcop) :
stash ? HvNAME(stash) : packname;
- packlen = strlen(packname);
+ if (!packname)
+ Perl_croak(aTHX_
+ "Can't use anonymous symbol table for method
lookup");
+ else
+ packlen = strlen(packname);
}
else {
/* the method name is qualified */
==== //depot/maint-5.8/perl/sv.c#118 (text) ====
Index: perl/sv.c
--- perl/sv.c#117~23582~ Wed Dec 1 05:28:06 2004
+++ perl/sv.c Tue Dec 7 15:09:13 2004
@@ -3126,15 +3126,11 @@
default: s = "UNKNOWN"; break;
}
tsv = NEWSV(0,0);
- if (SvOBJECT(sv)) {
- HV *svs = SvSTASH(sv);
- Perl_sv_setpvf(
- aTHX_ tsv, "%s=%s",
- /* [20011101.072] This bandaid for C<package;>
- should eventually be removed. AMS 20011103 */
- (svs ? HvNAME(svs) : "<none>"), s
- );
- }
+ if (SvOBJECT(sv))
+ if (HvNAME(SvSTASH(sv)))
+ Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)),
s);
+ else
+ Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
else
sv_setpv(tsv, s);
Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
@@ -7617,10 +7613,10 @@
Perl_sv_reftype(pTHX_ SV *sv, int ob)
{
if (ob && SvOBJECT(sv)) {
- HV *svs = SvSTASH(sv);
- /* [20011101.072] This bandaid for C<package;> should eventually
- be removed. AMS 20011103 */
- return (svs ? HvNAME(svs) : "<none>");
+ if (HvNAME(SvSTASH(sv)))
+ return HvNAME(SvSTASH(sv));
+ else
+ return "__ANON__";
}
else {
switch (SvTYPE(sv)) {
@@ -7700,6 +7696,8 @@
return 0;
sv = (SV*)SvRV(sv);
if (!SvOBJECT(sv))
+ return 0;
+ if (!HvNAME(SvSTASH(sv)))
return 0;
return strEQ(HvNAME(SvSTASH(sv)), name);
==== //depot/maint-5.8/perl/t/comp/package.t#2 (xtext) ====
Index: perl/t/comp/package.t
--- perl/t/comp/package.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/comp/package.t Tue Dec 7 15:09:13 2004
@@ -1,12 +1,14 @@
#!./perl
-print "1..8\n";
+print "1..14\n";
$blurfl = 123;
$foo = 3;
package xyz;
+sub new {bless [];}
+
$bar = 4;
{
@@ -24,9 +26,9 @@
$ABC = join(':', sort(keys %ABC::));
if ('a' lt 'A') {
- print $xyz eq 'bar:main:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+ print $xyz eq 'bar:main:new:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
} else {
- print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+ print $xyz eq 'ABC:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
}
print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
@@ -51,3 +53,21 @@
}
print((foo(1))[0] eq 'PQR' ? "ok 8\n" : "not ok 8\n");
+
+my $Q = xyz->new();
+undef %xyz::;
+eval { $a = *xyz::new{PACKAGE}; };
+print $a eq "__ANON__" ? "ok 9\n" : "not ok 9\n";
+
+eval { $Q->param; };
+print $@ =~ /^Can't use anonymous symbol table for method lookup/ ?
+ "ok 10\n" : "not ok 10\n";
+
+print "$Q" =~ /^__ANON__=/ ? "ok 11\n" : "not ok 11\n";
+
+print ref $Q eq "__ANON__" ? "ok 12\n" : "not ok 12\n";
+
+package bug32562;
+
+print __PACKAGE__ eq 'bug32562' ? "ok 13\n" : "not ok 13\n";
+print eval '__PACKAGE__' eq 'bug32562' ? "ok 14\n" : "not ok 14\n";
==== //depot/maint-5.8/perl/toke.c#50 (text) ====
Index: perl/toke.c
--- perl/toke.c#49~23400~ Thu Oct 21 04:43:53 2004
+++ perl/toke.c Tue Dec 7 15:09:13 2004
@@ -4133,7 +4133,7 @@
case KEY___PACKAGE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
- ? newSVsv(PL_curstname)
+ ? newSVpv(HvNAME(PL_curstash), 0)
: &PL_sv_undef));
TERM(THING);
End of Patch.
