{
dTHR;
register GP *gp;
+ bool doproto = SvTYPE(gv) > SVt_NULL;
+ char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
sv_upgrade((SV*)gv, SVt_PVGV);
- if (SvLEN(gv))
- Safefree(SvPVX(gv));
+ if (SvLEN(gv)) {
+ if (proto) {
+ SvPVX(gv) = NULL;
+ SvLEN(gv) = 0;
+ SvPOK_off(gv);
+ } else
+ Safefree(SvPVX(gv));
+ }
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
GvLINE(gv) = curcop->cop_line;
GvFILEGV(gv) = curcop->cop_filegv;
+ GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
sv_magic((SV*)gv, (SV*)gv, '*', name, len);
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAMELEN(gv) = len;
if (multi)
GvMULTI_on(gv);
+ if (doproto) { /* Replicate part of newSUB here. */
+ SvIOK_off(gv);
+ ENTER;
+ start_subparse(0,0); /* Create CV in compcv. */
+ GvCV(gv) = compcv;
+ LEAVE;
+
+ sub_generation++;
+ CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+ CvFILEGV(GvCV(gv)) = curcop->cop_filegv;
+ CvSTASH(GvCV(gv)) = curstash;
+#ifdef USE_THREADS
+ CvOWNER(GvCV(gv)) = 0;
+ if (!CvMUTEXP(GvCV(gv)))
+ New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+#endif /* USE_THREADS */
+ if (proto) {
+ sv_setpv((SV*)GvCV(gv), proto);
+ Safefree(proto);
+ }
+ }
}
-static void
+STATIC void
gv_init_sv(GV *gv, I32 sv_type)
{
switch (sv_type) {
if (!stash)
return 0;
if ((level > 100) || (level < -100))
- croak("Recursive inheritance detected");
+ croak("Recursive inheritance detected while looking for method '%s' in package '%s'",
+ name, HvNAME(stash));
DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
gv_init(topgv, stash, name, len, TRUE);
if (cv = GvCV(topgv)) {
/* If genuine method or valid cache entry, use it */
- if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
+ if (!GvCVGEN(topgv) || GvCVGEN(topgv) == sub_generation)
return topgv;
/* Stale cached entry: junk it */
SvREFCNT_dec(cv);
GvCV(topgv) = cv = Nullcv;
GvCVGEN(topgv) = 0;
}
+ else if (GvCVGEN(topgv) == sub_generation)
+ return 0; /* cache indicates sub doesn't exist */
}
gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
}
return gv;
}
+ else if (topgv && GvREFCNT(topgv) == 1) {
+ /* cache the fact that the method is not defined */
+ GvCVGEN(topgv) = sub_generation;
+ }
}
}
len = namend - name;
if (len > 0) {
+ char smallbuf[256];
char *tmpbuf;
- char autobuf[64];
- if (len < sizeof(autobuf) - 2)
- tmpbuf = autobuf;
+ if (len + 3 < sizeof smallbuf)
+ tmpbuf = smallbuf;
else
New(601, tmpbuf, len+3, char);
Copy(name, tmpbuf, len, char);
gv = gvp ? *gvp : Nullgv;
if (gv && gv != (GV*)&sv_undef) {
if (SvTYPE(gv) != SVt_PVGV)
- gv_init(gv, stash, tmpbuf, len, (add & 2));
+ gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
else
GvMULTI_on(gv);
}
- if (tmpbuf != autobuf)
+ if (tmpbuf != smallbuf)
Safefree(tmpbuf);
if (!gv || gv == (GV*)&sv_undef)
return Nullgv;
/* By this point we should have a stash and a name */
if (!stash) {
- if (add) {
- warn("Global symbol \"%s\" requires explicit package name", name);
- ++error_count;
- stash = curstash ? curstash : defstash; /* avoid core dumps */
- add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
- : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
- : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
- : 0);
- }
- else
+ if (!add)
return Nullgv;
+ if (add & ~GV_ADDMULTI) {
+ char sv_type_char = ((sv_type == SVt_PV) ? '$'
+ : (sv_type == SVt_PVAV) ? '@'
+ : (sv_type == SVt_PVHV) ? '%'
+ : 0);
+ if (sv_type_char)
+ warn("Global symbol \"%c%s\" requires explicit package name",
+ sv_type_char, name);
+ else
+ warn("Global symbol \"%s\" requires explicit package name",
+ name);
+ }
+ ++error_count;
+ stash = curstash ? curstash : defstash; /* avoid core dumps */
+ add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
+ : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
+ : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
+ : 0);
}
if (!SvREFCNT(stash)) /* symbol table under destruction */
gv_init_sv(gv, sv_type);
}
return gv;
+ } else if (add & GV_NOINIT) {
+ return gv;
}
/* Adding a new symbol */
- if (add & 4)
+ if (add & GV_ADDWARN)
warn("Had to create %s unexpectedly", nambeg);
- gv_init(gv, stash, name, len, add & 2);
+ gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
GvFLAGS(gv) |= add_gvflags;
GvMULTI_on(gv);
sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
/* NOTE: No support for tied ISA */
- if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILLp(av) == -1)
+ if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
+ && AvFILLp(av) == -1)
{
char *pname;
av_push(av, newSVpv(pname = "NDBM_File",0));
psig_ptr[i] = 0;
psig_name[i] = 0;
}
- /* initialize signal stack */
- signalstack = newAV();
- AvREAL_off(signalstack);
- av_extend(signalstack, 30);
- av_fill(signalstack, 0);
}
break;
#endif
goto magicalize;
+ case '!':
+ if (len > 1)
+ break;
+ if (sv_type > SVt_PV && curcop != &compiling) {
+ HV* stash = gv_stashpvn("Errno",5,FALSE);
+ if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+ dSP;
+ PUTBACK;
+ perl_require_pv("Errno.pm");
+ SPAGAIN;
+ stash = gv_stashpvn("Errno",5,FALSE);
+ if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
+ croak("Can't use %%! because Errno.pm is not available");
+ }
+ }
+ goto magicalize;
case '#':
case '*':
if (dowarn && len == 1 && sv_type == SVt_PV)
warn("Use of $%s is deprecated", name);
/* FALL THROUGH */
case '[':
- case '!':
case '^':
case '~':
case '=':
}
else if (isALPHA(*HeKEY(entry))) {
gv = (GV*)HeVAL(entry);
- if (GvMULTI(gv))
+ if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
continue;
curcop->cop_line = GvLINE(gv);
filegv = GvFILEGV(gv);
return FALSE;
}
-/* During call to this subroutine stack can be reallocated. It is
- * advised to call SPAGAIN macro in your code after call */
-
SV*
amagic_call(SV *left, SV *right, int method, int flags)
{
break;
case copy_amg:
{
- SV* ref=SvRV(left);
- if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) {
+ /*
+ * SV* ref causes confusion with the interpreter variable of
+ * the same name
+ */
+ SV* tmpRef=SvRV(left);
+ if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
/*
* Just to be extra cautious. Maybe in some
* additional cases sv_setsv is safe, too.
*/
- SV* newref = newSVsv(ref);
+ SV* newref = newSVsv(tmpRef);
SvOBJECT_on(newref);
- SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+ SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
return newref;
}
}
myop.op_next = Nullop;
myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
+ PUSHSTACKi(PERLSI_OVERLOAD);
ENTER;
SAVEOP();
op = (OP *) &myop;
PUTBACK;
pp_pushmark(ARGS);
- EXTEND(sp, notfound + 5);
+ EXTEND(SP, notfound + 5);
PUSHs(lr>0? right: left);
PUSHs(lr>0? left: right);
PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no ));
PUTBACK;
if (op = pp_entersub(ARGS))
- runops();
+ CALLRUNOPS();
LEAVE;
SPAGAIN;
res=POPs;
- PUTBACK;
+ POPSTACK;
CATCH_SET(oldcatch);
if (postpr) {
https://perl5.git.perl.org / perl5.git / blobdiff