*ep = d;
return *sp;
}
-
+
/* "register" allocation */
case OP_MATCH:
case OP_QR:
clear_pmop:
+ {
+ HV *pmstash = PmopSTASH(cPMOPo);
+ if (pmstash && SvREFCNT(pmstash)) {
+ PMOP *pmop = HvPMROOT(pmstash);
+ PMOP *lastpmop = NULL;
+ while (pmop) {
+ if (cPMOPo == pmop) {
+ if (lastpmop)
+ lastpmop->op_pmnext = pmop->op_pmnext;
+ else
+ HvPMROOT(pmstash) = pmop->op_pmnext;
+ break;
+ }
+ lastpmop = pmop;
+ pmop = pmop->op_pmnext;
+ }
+#ifdef USE_ITHREADS
+ Safefree(PmopSTASHPV(cPMOPo));
+#else
+ /* NOTE: PMOP.op_pmstash is not refcounted */
+#endif
+ }
+ }
cPMOPo->op_pmreplroot = Nullop;
ReREFCNT_dec(cPMOPo->op_pmregexp);
cPMOPo->op_pmregexp = (REGEXP*)NULL;
PL_modcount++;
return o;
case OP_CONST:
- if (o->op_private & (OPpCONST_BARE) &&
+ if (o->op_private & (OPpCONST_BARE) &&
!(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
SV *sv = ((SVOP*)o)->op_sv;
GV *gv;
/* Could be a filehandle */
- if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) {
+ if ((gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO))) {
OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
op_free(o);
o = gvio;
OP* enter;
gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
- enter = newUNOP(OP_ENTERSUB,0,
- newUNOP(OP_RV2CV, 0,
+ enter = newUNOP(OP_ENTERSUB,0,
+ newUNOP(OP_RV2CV, 0,
newGVOP(OP_GV, 0, gv)
));
enter->op_private |= OPpLVAL_INTRO;
} else if (type == OP_RV2SV || /* "our" declaration */
type == OP_RV2AV ||
type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+ if (attrs) {
+ GV *gv = cGVOPx_gv(cUNOPo->op_first);
+ PL_in_my = FALSE;
+ PL_in_my_stash = Nullhv;
+ apply_attrs(GvSTASH(gv),
+ (type == OP_RV2SV ? GvSV(gv) :
+ type == OP_RV2AV ? (SV*)GvAV(gv) :
+ type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
+ attrs);
+ }
o->op_private |= OPpOUR_INTRO;
return o;
} else if (type != OP_PADSV &&
OP *
Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
{
- OP *kid;
- OP *last = 0;
-
if (!o || o->op_type != OP_LIST)
o = newLISTOP(OP_LIST, 0, o, Nullop);
else
if (complement) {
U8 tmpbuf[UTF8_MAXLEN+1];
U8** cp;
- I32* cl;
UV nextmin = 0;
New(1109, cp, tlen, U8*);
i = 0;
while (t < tend) {
cp[i++] = t;
t += UTF8SKIP(t);
- if (*t == 0xff) {
+ if (t < tend && *t == 0xff) {
t++;
t += UTF8SKIP(t);
}
qsort(cp, i, sizeof(U8*), utf8compare);
for (j = 0; j < i; j++) {
U8 *s = cp[j];
- I32 cur = j < i ? cp[j+1] - s : tend - s;
- UV val = utf8_to_uv(s, cur, &ulen, 0);
+ I32 cur = j < i - 1 ? cp[j+1] - s : tend - s;
+ /* CHECKME: Use unicode code points for ranges - needs more thought ... NI-S */
+ UV val = utf8n_to_uvuni(s, cur, &ulen, 0);
s += ulen;
diff = val - nextmin;
if (diff > 0) {
- t = uv_to_utf8(tmpbuf,nextmin);
+ t = uvuni_to_utf8(tmpbuf,nextmin);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
if (diff > 1) {
- t = uv_to_utf8(tmpbuf, val - 1);
+ t = uvuni_to_utf8(tmpbuf, val - 1);
sv_catpvn(transv, "\377", 1);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
}
}
- if (*s == 0xff)
- val = utf8_to_uv(s+1, cur - 1, &ulen, 0);
+ if (s < tend && *s == 0xff)
+ val = utf8n_to_uvuni(s+1, cur - 1, &ulen, 0);
if (val >= nextmin)
nextmin = val + 1;
}
- t = uv_to_utf8(tmpbuf,nextmin);
+ t = uvuni_to_utf8(tmpbuf,nextmin);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
- t = uv_to_utf8(tmpbuf, 0x7fffffff);
+ t = uvuni_to_utf8(tmpbuf, 0x7fffffff);
sv_catpvn(transv, "\377", 1);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
t = (U8*)SvPVX(transv);
tlen = SvCUR(transv);
tend = t + tlen;
+ Safefree(cp);
}
else if (!rlen && !del) {
r = t; rlen = tlen; rend = tend;
}
if (!squash) {
- if (t == r ||
+ if ((!rlen && !del) || t == r ||
(tlen == rlen && memEQ((char *)t, (char *)r, tlen)))
{
o->op_private |= OPpTRANS_IDENTICAL;
while (t < tend || tfirst <= tlast) {
/* see if we need more "t" chars */
if (tfirst > tlast) {
- tfirst = (I32)utf8_to_uv(t, tend - t, &ulen, 0);
+ tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
t += ulen;
if (t < tend && *t == 0xff) { /* illegal utf8 val indicates range */
t++;
- tlast = (I32)utf8_to_uv(t, tend - t, &ulen, 0);
+ tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
t += ulen;
}
else
/* now see if we need more "r" chars */
if (rfirst > rlast) {
if (r < rend) {
- rfirst = (I32)utf8_to_uv(r, rend - r, &ulen, 0);
+ rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
r += ulen;
if (r < rend && *r == 0xff) { /* illegal utf8 val indicates range */
r++;
- rlast = (I32)utf8_to_uv(r, rend - r, &ulen, 0);
+ rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
r += ulen;
}
else
else
bits = 8;
+ Safefree(cPVOPo->op_pv);
cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
SvREFCNT_dec(listsv);
if (transv)
}
}
}
+ if (!del) {
+ if (!rlen) {
+ j = rlen;
+ if (!squash)
+ o->op_private |= OPpTRANS_IDENTICAL;
+ }
+ else if (j >= rlen)
+ j = rlen - 1;
+ else
+ cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
+ tbl[0x100] = rlen - j;
+ for (i=0; i < rlen - j; i++)
+ tbl[0x101+i] = r[j+i];
+ }
}
else {
if (!rlen && !del) {
if (type != OP_TRANS && PL_curstash) {
pmop->op_pmnext = HvPMROOT(PL_curstash);
HvPMROOT(PL_curstash) = pmop;
+ PmopSTASH_set(pmop,PL_curstash);
}
return (OP*)pmop;
SAVEVPTR(PL_curpad);
PL_curpad = 0;
- if (!CvCLONED(cv))
- op_free(CvROOT(cv));
+ op_free(CvROOT(cv));
CvROOT(cv) = Nullop;
LEAVE;
}
SvPOK_off((SV*)cv); /* forget prototype */
- CvFLAGS(cv) = 0;
- SvREFCNT_dec(CvGV(cv));
CvGV(cv) = Nullgv;
- SvREFCNT_dec(CvOUTSIDE(cv));
+ /* Since closure prototypes have the same lifetime as the containing
+ * CV, they don't hold a refcount on the outside CV. This avoids
+ * the refcount loop between the outer CV (which keeps a refcount to
+ * the closure prototype in the pad entry for pp_anoncode()) and the
+ * closure prototype, and the ensuing memory leak. --GSAR */
+ if (!CvANON(cv) || CvCLONED(cv))
+ SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = Nullcv;
if (CvCONST(cv)) {
SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
}
CvPADLIST(cv) = Nullav;
}
+ CvFLAGS(cv) = 0;
}
+#ifdef DEBUG_CLOSURES
STATIC void
S_cv_dump(pTHX_ CV *cv)
{
}
#endif /* DEBUGGING */
}
+#endif /* DEBUG_CLOSURES */
STATIC CV *
S_cv_clone2(pTHX_ CV *proto, CV *outside)
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
CvFILE(cv) = CvFILE(proto);
- CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
+ CvGV(cv) = CvGV(proto);
CvSTASH(cv) = CvSTASH(proto);
- CvROOT(cv) = CvROOT(proto);
+ CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
CvSTART(cv) = CvSTART(proto);
if (outside)
CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
cv = (!name || GvCVGEN(gv)) ? Nullcv : GvCV(gv);
+#ifdef GV_SHARED_CHECK
+ if (cv && GvSHARED(gv) && SvREADONLY(cv)) {
+ Perl_croak(aTHX_ "Can't define subroutine %s (GV is shared)", name);
+ }
+#endif
+
if (!block || !ps || *ps || attrs)
const_sv = Nullsv;
else
if (cv) {
bool exists = CvROOT(cv) || CvXSUB(cv);
+
+#ifdef GV_SHARED_CHECK
+ if (exists && GvSHARED(gv)) {
+ Perl_croak(aTHX_ "Can't redefine shared subroutine %s", name);
+ }
+#endif
+
/* if the subroutine doesn't exist and wasn't pre-declared
* with a prototype, assume it will be AUTOLOADed,
* skipping the prototype check
CvOUTSIDE(PL_compcv) = 0;
CvPADLIST(cv) = CvPADLIST(PL_compcv);
CvPADLIST(PL_compcv) = 0;
- if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
- CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+ /* inner references to PL_compcv must be fixed up ... */
+ {
+ AV *padlist = CvPADLIST(cv);
+ AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV *comppad = (AV*)AvARRAY(padlist)[1];
+ SV **namepad = AvARRAY(comppad_name);
+ SV **curpad = AvARRAY(comppad);
+ for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ SV *namesv = namepad[ix];
+ if (namesv && namesv != &PL_sv_undef
+ && *SvPVX(namesv) == '&')
+ {
+ CV *innercv = (CV*)curpad[ix];
+ if (CvOUTSIDE(innercv) == PL_compcv) {
+ CvOUTSIDE(innercv) = cv;
+ if (!CvANON(innercv) || CvCLONED(innercv)) {
+ (void)SvREFCNT_inc(cv);
+ SvREFCNT_dec(PL_compcv);
+ }
+ }
+ }
+ }
+ }
+ /* ... before we throw it away */
SvREFCNT_dec(PL_compcv);
}
else {
PL_sub_generation++;
}
}
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
CvFILE(cv) = CopFILE(PL_curcop);
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
}
}
+ /* If a potential closure prototype, don't keep a refcount on outer CV.
+ * This is okay as the lifetime of the prototype is tied to the
+ * lifetime of the outer CV. Avoids memory leak due to reference
+ * loop. --GSAR */
+ if (!name)
+ SvREFCNT_dec(CvOUTSIDE(cv));
+
if (name || aname) {
char *s;
char *tname = (name ? name : aname);
PL_sub_generation++;
}
}
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
#ifdef USE_THREADS
New(666, CvMUTEXP(cv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(cv));
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
+#ifdef GV_SHARED_CHECK
+ if (GvSHARED(gv)) {
+ Perl_croak(aTHX_ "Bad symbol for form (GV is shared)");
+ }
+#endif
GvMULTI_on(gv);
if ((cv = GvFORM(gv))) {
if (ckWARN(WARN_REDEFINE)) {
}
cv = PL_compcv;
GvFORM(gv) = cv;
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
CvFILE(cv) = CopFILE(PL_curcop);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
case OP_MATCH:
case OP_SUBST:
o->op_seq = PL_op_seqmax++;
- while (cPMOP->op_pmreplstart &&
+ while (cPMOP->op_pmreplstart &&
cPMOP->op_pmreplstart->op_type == OP_NULL)
cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
peep(cPMOP->op_pmreplstart);
const_sv_xsub(pTHXo_ CV* cv)
{
dXSARGS;
+ if (items != 0) {
+#if 0
+ Perl_croak(aTHX_ "usage: %s::%s()",
+ HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
+#endif
+ }
EXTEND(sp, 1);
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
projects / p5sagit/p5-mst-13.2.git / blobdiff