+/* universal.c
+ *
+ * Copyright (c) 1997-2002, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "The roots of those mountains must be roots indeed; there must be
+ * great secrets buried there which have not been discovered since the
+ * beginning." --Gandalf, relating Gollum's story
+ */
+
#include "EXTERN.h"
#define PERL_IN_UNIVERSAL_C
#include "perl.h"
*/
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;
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;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Can't locate package %s for @%s::ISA",
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;
}
}
/*
+=head1 SV Manipulation Functions
+
=for apidoc sv_derived_from
Returns a boolean indicating whether the SV is derived from the specified
{
char *type;
HV *stash;
+ HV *name_stash;
stash = Nullhv;
type = Nullch;
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 ;
}
STRLEN len;
SV *req = ST(1);
- if (undef)
- Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed",
- HvNAME(pkg), HvNAME(pkg));
-
+ if (undef) {
+ if (pkg)
+ Perl_croak(aTHX_
+ "%s does not define $%s::VERSION--version check failed",
+ HvNAME(pkg), HvNAME(pkg));
+ else {
+ char *str = SvPVx(ST(0), len);
+
+ Perl_croak(aTHX_
+ "%s defines neither package nor VERSION--version check failed", str);
+ }
+ }
if (!SvNIOK(sv) && SvPOK(sv)) {
char *str = SvPVx(sv,len);
while (len) {
XSRETURN(1);
}
-