*nsplit = '\0';
if (strEQ(origname,"SUPER")) {
/* Degenerate case ->SUPER::method should really lookup in original stash */
- SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+ SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
sv_catpvn(tmpstr, "::SUPER", 7);
stash = gv_stashpv(SvPV(tmpstr,na),TRUE);
*nsplit = ch;
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] == ':'))
sv_type != SVt_PVCV &&
sv_type != SVt_PVGV &&
sv_type != SVt_PVFM &&
- sv_type != SVt_PVIO)
+ sv_type != SVt_PVIO &&
+ !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
{
gvp = (GV**)hv_fetch(stash,name,len,0);
if (!gvp ||
stash = 0;
else if (sv_type == SVt_PVAV && !GvAV(*gvp) ||
sv_type == SVt_PVHV && !GvHV(*gvp) ||
- sv_type == SVt_PV &&
- (!GvSV(*gvp) ||
- (!SvTYPE(GvSV(*gvp)) &&
- SvREFCNT(GvSV(*gvp)) == 1) ))
+ sv_type == SVt_PV && !GvSV(*gvp) )
{
warn("Variable \"%c%s\" is not exported",
sv_type == SVt_PVAV ? '@' :
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;
}
} 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;