diff options
| author | Michael G. Schwern <schwern@pobox.com> | 2002-01-21 10:16:42 -0500 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-01-23 14:17:52 +0000 |
| commit | 301daebccb7cf8ef4420fe0ae3cdddd299f11568 (patch) | |
| tree | 6925d913db3736972e5e2609e0ce031fa8012baa | |
| parent | d9984052ba632ec50d14b1afa97960143b6781f2 (diff) | |
| download | perl-301daebccb7cf8ef4420fe0ae3cdddd299f11568.tar.gz | |
Re: bless() bug ? Why fails reblessing of 'main::Object' to 'Object' ?
Message-ID: <20020121201642.GA6659@blackrider>
p4raw-id: //depot/perl@14385
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rwxr-xr-x | t/op/universal.t | 4 | ||||
| -rw-r--r-- | universal.c | 18 |
5 files changed, 19 insertions, 9 deletions
@@ -1287,7 +1287,7 @@ s |I32 |cr_textfilter |int idx|SV *sv|int maxlen #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) -s |SV*|isa_lookup |HV *stash|const char *name|int len|int level +s |SV*|isa_lookup |HV *stash|const char *name|HV *name_stash|int len|int level #endif #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) @@ -2735,7 +2735,7 @@ # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) -#define isa_lookup(a,b,c,d) S_isa_lookup(aTHX_ a,b,c,d) +#define isa_lookup(a,b,c,d,e) S_isa_lookup(aTHX_ a,b,c,d,e) #endif #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) #define stdize_locale(a) S_stdize_locale(aTHX_ a) @@ -1312,7 +1312,7 @@ STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen); #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) -STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level); +STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, HV *name_stash, int len, int level); #endif #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) diff --git a/t/op/universal.t b/t/op/universal.t index 00e99fc4e1..2e31d78b19 100755 --- a/t/op/universal.t +++ b/t/op/universal.t @@ -9,7 +9,7 @@ BEGIN { $| = 1; } -print "1..91\n"; +print "1..93\n"; $a = {}; bless $a, "Bob"; @@ -57,8 +57,10 @@ package main; $a = new Alice; test $a->isa("Alice"); +test $a->isa("main::Alice"); # check that alternate class names work test $a->isa("Bob"); +test $a->isa("main::Bob"); test $a->isa("Female"); diff --git a/universal.c b/universal.c index 8fc7d699a8..53b9e9fb70 100644 --- a/universal.c +++ b/universal.c @@ -8,7 +8,8 @@ */ STATIC SV * -S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level) +S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, + int len, int level) { AV* av; GV* gv; @@ -16,8 +17,10 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level) HV* hv = Nullhv; SV* subgen = Nullsv; - if (!stash) - return &PL_sv_undef; + /* A stash/class can go by many names (ie. User == main::User), so + we compare the stash itself just in case */ + if (name_stash && (stash == name_stash)) + return &PL_sv_yes; if (strEQ(HvNAME(stash), name)) return &PL_sv_yes; @@ -80,7 +83,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level) SvPVX(sv), HvNAME(stash)); continue; } - if (&PL_sv_yes == isa_lookup(basestash, name, len, level + 1)) { + if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, + len, level + 1)) { (void)hv_store(hv,name,len,&PL_sv_yes,0); return &PL_sv_yes; } @@ -109,6 +113,7 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *name) { char *type; HV *stash; + HV *name_stash; stash = Nullhv; type = Nullch; @@ -126,8 +131,11 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *name) stash = gv_stashsv(sv, FALSE); } + name_stash = gv_stashpv(name, FALSE); + return (type && strEQ(type,name)) || - (stash && isa_lookup(stash, name, strlen(name), 0) == &PL_sv_yes) + (stash && isa_lookup(stash, name, name_stash, strlen(name), 0) + == &PL_sv_yes) ? TRUE : FALSE ; } |