Blame src/sdf.c

Packit fa4fcc
/* Extracted from perl-5.004/universal.c, contributed by Graham Barr */
Packit fa4fcc
Packit fa4fcc
static SV *
Packit fa4fcc
isa_lookup(stash, name, len, level)
Packit fa4fcc
HV *stash;
Packit fa4fcc
char *name;
Packit fa4fcc
int len;
Packit fa4fcc
int level;
Packit fa4fcc
{
Packit fa4fcc
    AV* av;
Packit fa4fcc
    GV* gv;
Packit fa4fcc
    GV** gvp;
Packit fa4fcc
    HV* hv = Nullhv;
Packit fa4fcc
Packit fa4fcc
    if (!stash)
Packit fa4fcc
	return &sv_undef;
Packit fa4fcc
Packit fa4fcc
    if(strEQ(HvNAME(stash), name))
Packit fa4fcc
	return &sv_yes;
Packit fa4fcc
Packit fa4fcc
    if (level > 100)
Packit fa4fcc
	croak("Recursive inheritance detected");
Packit fa4fcc
Packit fa4fcc
    gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
Packit fa4fcc
Packit fa4fcc
    if (gvp && (gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv))) {
Packit fa4fcc
	SV* sv;
Packit fa4fcc
	SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
Packit fa4fcc
	if (svp && (sv = *svp) != (SV*)&sv_undef)
Packit fa4fcc
	    return sv;
Packit fa4fcc
    }
Packit fa4fcc
Packit fa4fcc
    gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
Packit fa4fcc
    
Packit fa4fcc
    if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
Packit fa4fcc
	if(!hv) {
Packit fa4fcc
	    gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
Packit fa4fcc
Packit fa4fcc
	    gv = *gvp;
Packit fa4fcc
Packit fa4fcc
	    if (SvTYPE(gv) != SVt_PVGV)
Packit fa4fcc
		gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
Packit fa4fcc
Packit fa4fcc
	    hv = GvHVn(gv);
Packit fa4fcc
	}
Packit fa4fcc
	if(hv) {
Packit fa4fcc
	    SV** svp = AvARRAY(av);
Packit fa4fcc
	    I32 items = AvFILL(av) + 1;
Packit fa4fcc
	    while (items--) {
Packit fa4fcc
		SV* sv = *svp++;
Packit fa4fcc
		HV* basestash = gv_stashsv(sv, FALSE);
Packit fa4fcc
		if (!basestash) {
Packit fa4fcc
		    if (dowarn)
Packit fa4fcc
			warn("Can't locate package %s for @%s::ISA",
Packit fa4fcc
			    SvPVX(sv), HvNAME(stash));
Packit fa4fcc
		    continue;
Packit fa4fcc
		}
Packit fa4fcc
		if(&sv_yes == isa_lookup(basestash, name, len, level + 1)) {
Packit fa4fcc
		    (void)hv_store(hv,name,len,&sv_yes,0);
Packit fa4fcc
		    return &sv_yes;
Packit fa4fcc
		}
Packit fa4fcc
	    }
Packit fa4fcc
	    (void)hv_store(hv,name,len,&sv_no,0);
Packit fa4fcc
	}
Packit fa4fcc
    }
Packit fa4fcc
Packit fa4fcc
    return &sv_no;
Packit fa4fcc
}
Packit fa4fcc
Packit fa4fcc
static bool
Packit fa4fcc
sv_derived_from(sv, name)
Packit fa4fcc
SV * sv ;
Packit fa4fcc
char * name ;
Packit fa4fcc
{
Packit fa4fcc
    SV *rv;
Packit fa4fcc
    char *type;
Packit fa4fcc
    HV *stash;
Packit fa4fcc
  
Packit fa4fcc
    stash = Nullhv;
Packit fa4fcc
    type = Nullch;
Packit fa4fcc
 
Packit fa4fcc
    if (SvGMAGICAL(sv))
Packit fa4fcc
        mg_get(sv) ;
Packit fa4fcc
Packit fa4fcc
    if (SvROK(sv)) {
Packit fa4fcc
        sv = SvRV(sv);
Packit fa4fcc
        type = sv_reftype(sv,0);
Packit fa4fcc
        if(SvOBJECT(sv))
Packit fa4fcc
            stash = SvSTASH(sv);
Packit fa4fcc
    }
Packit fa4fcc
    else {
Packit fa4fcc
        stash = gv_stashsv(sv, FALSE);
Packit fa4fcc
    }
Packit fa4fcc
 
Packit fa4fcc
    return (type && strEQ(type,name)) ||
Packit fa4fcc
            (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
Packit fa4fcc
        ? TRUE
Packit fa4fcc
        : FALSE ;
Packit fa4fcc
 
Packit fa4fcc
}