gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
sv_setpv(GvSV(gv), name);
if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
if (perldb)
hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
return gv;
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
if (multi)
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
}
static void
if (GvCVGEN(topgv) >= sub_generation)
return topgv; /* valid cached inheritance */
if (!GvCVGEN(topgv)) { /* not an inheritance cache */
- if (CvROOT(cv) || CvXSUB(cv))
- return topgv; /* real definition */
- /* a simple undef -- save the slot for possible re-use */
+ return topgv;
}
else {
/* stale cached entry, just junk it */
if (*nsplit == ':')
--nsplit;
*nsplit = '\0';
- stash = gv_stashpv(origname,TRUE);
- *nsplit = ch;
+ if (strEQ(origname,"SUPER")) {
+ /* Degenerate case ->SUPER::method should really lookup in original stash */
+ SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
+ sv_catpvn(tmpstr, "::SUPER", 7);
+ stash = gv_stashpv(SvPV(tmpstr,na),TRUE);
+ *nsplit = ch;
+ DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) );
+ } else {
+ stash = gv_stashpv(origname,TRUE);
+ *nsplit = ch;
+ }
}
gv = gv_fetchmeth(stash, name, nend - name, 0);
+
+ if (!gv) {
+ /* Failed obvious case - look for SUPER as last element of stash's name */
+ char *packname = HvNAME(stash);
+ STRLEN len = strlen(packname);
+ if (len >= 7 && strEQ(packname+len-7,"::SUPER")) {
+ /* Now look for @.*::SUPER::ISA */
+ GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
+ if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) {
+ /* No @ISA in package ending in ::SUPER - drop suffix
+ and see if there is an @ISA there
+ */
+ HV *basestash;
+ char ch = packname[len-7];
+ AV *av;
+ packname[len-7] = '\0';
+ basestash = gv_stashpv(packname, TRUE);
+ packname[len-7] = ch;
+ gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE);
+ if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+ /* Okay found @ISA after dropping the SUPER, alias it */
+ SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+ sv_catpvn(tmpstr, "::ISA", 5);
+ gv = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
+ if (gv) {
+ GvAV(gv) = (AV*)SvREFCNT_inc(av);
+ /* ... and re-try lookup */
+ gv = gv_fetchmeth(stash, name, nend - name, 0);
+ } else {
+ croak("Cannot create %s::ISA",HvNAME(stash));
+ }
+ }
+ }
+ }
+ }
+
if (!gv) {
CV* cv;
sv_catpvn(tmpstr,"::", 2);
sv_catpvn(tmpstr, name, nend - name);
sv_setsv(GvSV(CvGV(cv)), tmpstr);
+ if (tainting)
+ sv_unmagic(GvSV(CvGV(cv)), 't');
}
}
}
char tmpbuf[1234];
HV *stash;
GV *tmpgv;
- sprintf(tmpbuf,"%.*s::",1200,name);
+ /* Use strncpy to avoid bug in VMS sprintf */
+ /* sprintf(tmpbuf,"%.*s::",1200,name); */
+ strncpy(tmpbuf, name, 1200);
+ tmpbuf[1200] = '\0'; /* just in case . . . */
+ strcat(tmpbuf, "::");
tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
if (!tmpgv)
return 0;
bool global = FALSE;
char *tmpbuf;
+ if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+ name++;
+
for (namend = name; *namend; namend++) {
if ((*namend == '\'' && namend[1]) ||
(*namend == ':' && namend[1] == ':'))
gv = *gvp;
if (SvTYPE(gv) == SVt_PVGV)
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
else if (!add)
return Nullgv;
else
if (add && (hints & HINT_STRICT_VARS) &&
sv_type != SVt_PVCV &&
sv_type != SVt_PVGV &&
- sv_type != SVt_PVIO)
+ sv_type != SVt_PVFM &&
+ sv_type != SVt_PVIO &&
+ !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
{
+ gvp = (GV**)hv_fetch(stash,name,len,0);
+ if (!gvp ||
+ *gvp == (GV*)&sv_undef ||
+ SvTYPE(*gvp) != SVt_PVGV)
+ {
+ stash = 0;
+ }
+ else if (sv_type == SVt_PV && !GvIMPORTED_SV(*gvp) ||
+ sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
+ sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
+ {
+ warn("Variable \"%c%s\" is not imported",
+ sv_type == SVt_PVAV ? '@' :
+ sv_type == SVt_PVHV ? '%' : '$',
+ name);
+ if (GvCV(*gvp))
+ warn("(Did you mean &%s instead?)\n", name);
stash = 0;
+ }
}
}
else
gv = *gvp;
if (SvTYPE(gv) == SVt_PVGV) {
if (add) {
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
gv_init_sv(gv, sv_type);
}
return gv;
case 'a':
case 'b':
if (len == 1)
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
break;
case 'E':
if (strnEQ(name, "EXPORT", 6))
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
break;
case 'I':
if (strEQ(name, "ISA")) {
AV* av = GvAVn(gv);
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
{
case 'O':
if (strEQ(name, "OVERLOAD")) {
HV* hv = GvHVn(gv);
- SvMULTI_on(gv);
+ GvMULTI_on(gv);
sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
}
break;
if (strEQ(name, "SIG")) {
HV *hv;
siggv = gv;
- SvMULTI_on(siggv);
+ GvMULTI_on(siggv);
hv = GvHVn(siggv);
hv_magic(hv, siggv, 'S');
case '|':
case '\001':
case '\004':
+ case '\005':
case '\006':
case '\010':
+ case '\017':
case '\t':
case '\020':
case '\024':
sv_upgrade((SV *)io,SVt_PVIO);
SvREFCNT(io) = 1;
SvOBJECT_on(io);
- iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO);
+ iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVHV);
SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
return io;
}
}
else if (isALPHA(*entry->hent_key)) {
gv = (GV*)entry->hent_val;
- if (SvMULTI(gv))
+ if (GvMULTI(gv))
continue;
curcop->cop_line = GvLINE(gv);
filegv = GvFILEGV(gv);
curcop->cop_filegv = filegv;
- if (filegv && SvMULTI(filegv)) /* Filename began with slash */
+ if (filegv && GvMULTI(filegv)) /* Filename began with slash */
continue;
warn("Identifier \"%s::%s\" used only once: possible typo",
HvNAME(stash), GvNAME(gv));
gp_free(gv)
GV* gv;
{
- IO *io;
- CV *cv;
GP* gp;
+ CV* cv;
if (!gv || !(gp = GvGP(gv)))
return;
SvREFCNT_dec(gp->gp_sv);
SvREFCNT_dec(gp->gp_av);
SvREFCNT_dec(gp->gp_hv);
- if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) {
- do_close(gv,FALSE);
- SvREFCNT_dec(io);
- }
+ SvREFCNT_dec(gp->gp_io);
if ((cv = gp->gp_cv) && !GvCVGEN(gv))
SvREFCNT_dec(cv);
SvREFCNT_dec(gp->gp_form);
}
if (cv) filled=1;
else {
- die("Method for operation %s not found in package %.200s during blessing\n",
+ die("Method for operation %s not found in package %.256s during blessing\n",
cp,HvNAME(stash));
return FALSE;
}
* argument found */
lr=1;
} else if (((ocvp && oamtp->fallback > AMGfallNEVER
- && (cvp=ocvp) && (lr=-1))
+ && (cvp=ocvp) && (lr = -1))
|| (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
&& !(flags & AMGf_unary)) {
/* We look for substitution for
} else if (cvp && (cv=cvp[nomethod_amg])) {
notfound = 1; lr = 1;
} else {
- char tmpstr[512];
if (off==-1) off=method;
- sprintf(tmpstr,"Operation `%s': no method found,\n\tleft argument %s%.200s,\n\tright argument %s%.200s",
- ((char**)AMG_names)[off],
+ sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
+ ((char**)AMG_names)[method + assignshift],
SvAMAGIC(left)?
"in overloaded package ":
"has no overloaded magic",
HvNAME(SvSTASH(SvRV(right))):
"");
if (amtp && amtp->fallback >= AMGfallYES) {
- DEBUG_o( deb(tmpstr) );
+ DEBUG_o( deb(buf) );
} else {
- die(tmpstr);
+ die(buf);
}
return NULL;
}
}
}
if (!notfound) {
- DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.200s%s\n",
+ DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
((char**)AMG_names)[off],
method+assignshift==off? "" :
" (initially `",
* to dublicate the contents, probably calling user-supplied
* version of copy operator
*/
- if ((method+assignshift==off
+ if ((method + assignshift==off
&& (assign || method==inc_amg || method==dec_amg))
|| inc_dec_ass) RvDEEPCP(left);
}
PUSHs(lr>0? left: right);
PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
if (notfound) {
- PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[off],0)) );
+ PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[method + assignshift],0)) );
}
PUSHs((SV*)cv);
PUTBACK;
if (op = pp_entersub())
- run();
+ runops();
LEAVE;
SPAGAIN;
projects / p5sagit/p5-mst-13.2.git / blobdiff