This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More assertion failures, found by auditing the code.
authorNicholas Clark <nick@ccl4.org>
Fri, 2 Mar 2007 14:42:27 +0000 (14:42 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 2 Mar 2007 14:42:27 +0000 (14:42 +0000)
p4raw-id: //depot/perl@30443

gv.c
t/op/gv.t
toke.c
universal.c

diff --git a/gv.c b/gv.c
index aac25b6..d56e8d0 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -380,7 +380,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            packlen -= 7;
            basestash = gv_stashpvn(hvname, packlen, GV_ADD);
            gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE);
-           if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
+           if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (av = GvAV(gv))) {
                gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
                if (!gvp || !(gv = *gvp))
                    Perl_croak(aTHX_ "Cannot create %s::ISA", hvname);
index 4475912..d736138 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 155 );
+plan( tests => 159 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -458,6 +458,28 @@ foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
     *slosh::{HASH}->{ISA}=[];
     slosh->import;
     pass("gv_fetchmeth coped with the unexpected");
+
+    # An audit found these:
+    {
+       package slosh;
+       sub rip {
+           my $s = shift;
+           $s->SUPER::rip;
+       }
+    }
+    eval {slosh->rip;};
+    like ($@, qr/^Can't locate object method "rip"/, "Even with SUPER");
+
+    is(slosh->isa('swoosh'), '');
+
+    $CORE::GLOBAL::{"lock"}=[];
+    eval "no warnings; lock";
+    like($@, qr/^Not enough arguments for lock/,
+       "Can't trip up general keyword overloading");
+
+    $CORE::GLOBAL::{"readline"}=[];
+    eval "no warnings; <STDOUT>";
+    is($@, '', "Can't trip up readline overloading");
 }
 __END__
 Perl
diff --git a/toke.c b/toke.c
index 24accc6..2498de2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5166,7 +5166,7 @@ Perl_yylex(pTHX)
                }
                if (!ogv &&
                    (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
-                   (gv = *gvp) != (GV*)&PL_sv_undef &&
+                   (gv = *gvp) && isGV_with_GP(gv) &&
                    GvCVu(gv) && GvIMPORTED_CV(gv))
                {
                    ogv = gv;
@@ -11378,7 +11378,7 @@ S_scan_inputsymbol(pTHX_ char *start)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
                ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
-               && (gv_readline = *gvp) != (GV*)&PL_sv_undef
+                && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
            readline_overriden = TRUE;
 
index d07ff2f..f065965 100644 (file)
@@ -62,7 +62,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, const HV* const name_stash,
 
     gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", FALSE);
 
-    if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
+    if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (subgen = GvSV(gv))
        && (hv = GvHV(gv)))
     {
        if (SvIV(subgen) == (IV)PL_sub_generation) {
@@ -87,7 +87,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, const HV* const name_stash,
 
     gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
 
-    if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
+    if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (av = GvAV(gv))) {
        if (!hv || !subgen) {
            gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", TRUE);