summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2007-03-02 14:42:27 +0000
committerNicholas Clark <nick@ccl4.org>2007-03-02 14:42:27 +0000
commit9e0d86f862e086b0fde6b64ca39c85508bf50910 (patch)
treebdbcc13f4e388616629b43018a0c457c375f8cf5
parent06be3b4087230d77129ccda5ba56e0397c241c48 (diff)
downloadperl-9e0d86f862e086b0fde6b64ca39c85508bf50910.tar.gz
More assertion failures, found by auditing the code.
p4raw-id: //depot/perl@30443
-rw-r--r--gv.c2
-rwxr-xr-xt/op/gv.t24
-rw-r--r--toke.c4
-rw-r--r--universal.c4
4 files changed, 28 insertions, 6 deletions
diff --git a/gv.c b/gv.c
index aac25b6cce..d56e8d0691 100644
--- 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);
diff --git a/t/op/gv.t b/t/op/gv.t
index 4475912f53..d736138b62 100755
--- 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 24accc6d32..2498de29b4 100644
--- 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;
diff --git a/universal.c b/universal.c
index d07ff2fd11..f06596517a 100644
--- a/universal.c
+++ b/universal.c
@@ -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);