if (*name != '$')
yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
name, PL_in_my == KEY_our ? "our" : "my"));
- SvOBJECT_on(sv);
+ SvFLAGS(sv) |= SVpad_TYPED;
(void)SvUPGRADE(sv, SVt_PVMG);
SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
- PL_sv_objcount++;
}
if (PL_in_my == KEY_our) {
(void)SvUPGRADE(sv, SVt_PVGV);
(void)SvUPGRADE(namesv, SVt_PVGV);
GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
}
- if (SvOBJECT(proto_namesv)) { /* A typed var */
- SvOBJECT_on(namesv);
+ if (SvFLAGS(proto_namesv) & SVpad_TYPED) { /* A typed lexical */
+ SvFLAGS(namesv) |= SVpad_TYPED;
(void)SvUPGRADE(namesv, SVt_PVMG);
SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
- PL_sv_objcount++;
}
return newoff;
}
switch (CxTYPE(cx)) {
default:
if (i == 0 && saweval) {
- seq = cxstack[saweval].blk_oldcop->cop_seq;
return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
- if (CxREALEVAL(cx))
+ if (CxREALEVAL(cx)) {
+ PADOFFSET off;
saweval = i;
+ seq = cxstack[i].blk_oldcop->cop_seq;
+ startcv = cxstack[i].blk_eval.cv;
+ if (startcv && CvOUTSIDE(startcv)) {
+ off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
+ i-1, saweval, 0);
+ if (off) /* continue looking if not found here */
+ return off;
+ }
+ }
break;
case OP_DOFILE:
case OP_REQUIRE:
saweval = i; /* so we know where we were called from */
continue;
}
- seq = cxstack[saweval].blk_oldcop->cop_seq;
return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
/* check for C<my Dog $spot> when deciding package */
namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
- if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
+ if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED)
+ && HvNAME(SvSTASH(*namesvp)))
stash = SvSTASH(*namesvp);
else
stash = PL_curstash;
case OP_SLE:
case OP_SGE:
case OP_SCMP:
-
- if (o->op_private & OPpLOCALE)
+ /* XXX what about the numeric ops? */
+ if (PL_hints & HINT_LOCALE)
goto nope;
}
U32 max = 0;
I32 bits;
I32 havefinal = 0;
- U32 final;
+ U32 final = 0;
I32 from_utf = o->op_private & OPpTRANS_FROM_UTF;
I32 to_utf = o->op_private & OPpTRANS_TO_UTF;
U8* tsave = NULL;
* 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))
+ * closure prototype, and the ensuing memory leak. This does not
+ * apply to closures generated within eval"", since eval"" CVs are
+ * ephemeral. --GSAR */
+ if (!CvANON(cv) || CvCLONED(cv)
+ || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ {
SvREFCNT_dec(CvOUTSIDE(cv));
+ }
CvOUTSIDE(cv) = Nullcv;
if (CvCONST(cv)) {
SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
}
}
- /* If a potential closure prototype, don't keep a refcount on outer CV.
+ /* If a potential closure prototype, don't keep a refcount on
+ * outer CV, unless the latter happens to be a passing eval"".
* 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)
+ if (!name && CvOUTSIDE(cv)
+ && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ {
SvREFCNT_dec(CvOUTSIDE(cv));
+ }
if (name || aname) {
char *s;
else
o = newUNOP(type, 0, newDEFSVOP());
}
-#ifdef USE_LOCALE
- if (type == OP_FTTEXT || type == OP_FTBINARY) {
- o->op_private = 0;
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
- }
-#endif
return o;
}
if (!kid)
append_elem(o->op_type, o, newDEFSVOP());
- o = listkids(o);
-
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
-}
-
-OP *
-Perl_ck_fun_locale(pTHX_ OP *o)
-{
- o = ck_fun(o);
-
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
+ return listkids(o);
}
OP *
}
OP *
-Perl_ck_scmp(pTHX_ OP *o)
-{
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
-}
-
-OP *
Perl_ck_match(pTHX_ OP *o)
{
o->op_private |= OPpRUNTIME;
Perl_ck_sort(pTHX_ OP *o)
{
OP *firstkid;
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
simplify_sort(o);
firstkid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (o->op_flags & OPf_STACKED) { /* may have been cleared */
- OP *k;
+ OP *k = NULL;
OP *kid = cUNOPx(firstkid)->op_first; /* get past null */
if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
break;
lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
- if (!SvOBJECT(lexname))
+ if (!(SvFLAGS(lexname) & SVpad_TYPED))
break;
fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
if (!fields || !GvHV(*fields))
if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
break;
lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
- if (!SvOBJECT(lexname))
+ if (!(SvFLAGS(lexname) & SVpad_TYPED))
break;
fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
if (!fields || !GvHV(*fields))
projects / p5sagit/p5-mst-13.2.git / blobdiff