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:
cv = cx->blk_sub.cv;
if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */
saweval = i; /* so we know where we were called from */
+ seq = cxstack[i].blk_oldcop->cop_seq;
continue;
}
- seq = cxstack[saweval].blk_oldcop->cop_seq;
return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
break;
case ';':
sv_setpv(sv, "\034");
- sv_magic(sv, 0, 0, name, 1);
+ sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
break;
case '&':
case '`':
/* case '!': */
default:
- sv_magic(sv, 0, 0, name, 1);
+ sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
}
DEBUG_S(PerlIO_printf(Perl_error_log,
"find_threadsv: new SV %p for $%s%c\n",
#endif
}
-STATIC void
-S_op_clear(pTHX_ OP *o)
+void
+Perl_op_clear(pTHX_ OP *o)
{
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
}
}
cPMOPo->op_pmreplroot = Nullop;
- ReREFCNT_dec(cPMOPo->op_pmregexp);
- cPMOPo->op_pmregexp = (REGEXP*)NULL;
+ ReREFCNT_dec(PM_GETRE(cPMOPo));
+ PM_SETRE(cPMOPo, (REGEXP*)NULL);
break;
}
SvREFCNT_dec(cop->cop_io);
}
-STATIC void
-S_null(pTHX_ OP *o)
+void
+Perl_op_null(pTHX_ OP *o)
{
if (o->op_type == OP_NULL)
return;
}
}
}
- null(o); /* don't execute or even remember it */
+ op_null(o); /* don't execute or even remember it */
break;
case OP_POSTINC:
o->op_type = OP_RV2CV; /* entersub => rv2cv */
o->op_ppaddr = PL_ppaddr[OP_RV2CV];
assert(cUNOPo->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
+ op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
}
else { /* lvalue subroutine call */
o->op_type = OP_RV2CV; /* entersub => rv2cv */
o->op_ppaddr = PL_ppaddr[OP_RV2CV];
assert(cUNOPo->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
+ op_null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
o->op_flags |= OPf_SPECIAL;
}
break;
/* fake up C<use attributes $pkg,$rv,@attrs> */
ENTER; /* need to protect against side-effects of 'use' */
SAVEINT(PL_expect);
- if (stash && HvNAME(stash))
+ if (stash)
stashsv = newSVpv(HvNAME(stash), 0);
else
stashsv = &PL_sv_no;
/* 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))
stash = SvSTASH(*namesvp);
else
stash = PL_curstash;
o->op_ppaddr = PL_ppaddr[OP_SCOPE];
kid = ((LISTOP*)o)->op_first;
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
- null(kid);
+ op_null(kid);
}
else
o = newLISTOP(OP_SCOPE, 0, o, Nullop);
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;
}
o->op_flags &= ~OPf_WANT;
if (!(PL_opargs[type] & OA_MARK))
- null(cLISTOPo->op_first);
+ op_null(cLISTOPo->op_first);
o->op_type = type;
o->op_ppaddr = PL_ppaddr[type];
{
if (!o || o->op_type != OP_LIST)
o = newLISTOP(OP_LIST, 0, o, Nullop);
- null(o);
+ op_null(o);
return o;
}
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;
}
if ((PL_hints & HINT_UTF8) || DO_UTF8(pat))
pm->op_pmdynflags |= PMdf_UTF8;
- pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
- if (strEQ("\\s+", pm->op_pmregexp->precomp))
+ PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+ if (strEQ("\\s+", PM_GETRE(pm)->precomp))
pm->op_pmflags |= PMf_WHITE;
op_free(expr);
}
}
if (curop == repl
&& !(repl_has_vars
- && (!pm->op_pmregexp
- || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
+ && (!PM_GETRE(pm)
+ || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
pm->op_pmflags |= PMf_CONST; /* const for long enough */
pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
prepend_elem(o->op_type, scalar(repl), o);
}
else {
- if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+ if (curop == repl && !PM_GETRE(pm)) { /* Has variables. */
pm->op_pmflags |= PMf_MAYBE_CONST;
pm->op_pmpermflags |= PMf_MAYBE_CONST;
}
Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
{
OP *pack;
- OP *rqop;
OP *imop;
OP *veop;
- GV *gv;
if (id->op_type != OP_CONST)
Perl_croak(aTHX_ "Module name must be constant");
newSVOP(OP_METHOD_NAMED, 0, meth)));
}
- /* Fake up a require, handle override, if any */
- gv = gv_fetchpv("require", FALSE, SVt_PVCV);
- if (!(gv && GvIMPORTED_CV(gv)))
- gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
-
- if (gv && GvIMPORTED_CV(gv)) {
- rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST, id,
- scalar(newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0,
- gv))))));
- }
- else {
- rqop = newUNOP(OP_REQUIRE, 0, id);
- }
-
/* Fake up the BEGIN {}, which does its thing immediately. */
newATTRSUB(floor,
newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
Nullop,
append_elem(OP_LINESEQ,
append_elem(OP_LINESEQ,
- newSTATEOP(0, Nullch, rqop),
+ newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)),
newSTATEOP(0, Nullch, veop)),
newSTATEOP(0, Nullch, imop) ));
op_free(expr);
expr = (OP*)(listop);
- null(expr);
+ op_null(expr);
iterflags |= OPf_STACKED;
}
else {
}
#endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+ if (CvFILE(cv) && !CvXSUB(cv)) {
+ Safefree(CvFILE(cv));
+ CvFILE(cv) = 0;
+ }
+#endif
+
if (!CvXSUB(cv) && CvROOT(cv)) {
#ifdef USE_THREADS
if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
* 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);
}
CvPADLIST(cv) = Nullav;
}
+ if (CvXSUB(cv)) {
+ CvXSUB(cv) = 0;
+ }
CvFLAGS(cv) = 0;
}
MUTEX_INIT(CvMUTEXP(cv));
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+ CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
+ : savepv(CvFILE(proto));
+#else
CvFILE(cv) = CvFILE(proto);
+#endif
CvGV(cv) = CvGV(proto);
CvSTASH(cv) = CvSTASH(proto);
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
*/
if (cv && !block) {
rcv = (SV*)cv;
- if (CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))))
+ if (CvGV(cv) && GvSTASH(CvGV(cv)))
stash = GvSTASH(CvGV(cv));
- else if (CvSTASH(cv) && HvNAME(CvSTASH(cv)))
+ else if (CvSTASH(cv))
stash = CvSTASH(cv);
else
stash = PL_curstash;
else {
/* possibly about to re-define existing subr -- ignore old cv */
rcv = (SV*)PL_compcv;
- if (name && GvSTASH(gv) && HvNAME(GvSTASH(gv)))
+ if (name && GvSTASH(gv))
stash = GvSTASH(gv);
else
stash = PL_curstash;
}
}
CvGV(cv) = gv;
- CvFILE(cv) = CopFILE(PL_curcop);
+ CvFILE_set_from_cop(cv, PL_curcop);
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
}
}
- /* 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 if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
/* already defined (or promised) */
if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
- && HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
cv = PL_compcv;
GvFORM(gv) = cv;
CvGV(cv) = gv;
- CvFILE(cv) = CopFILE(PL_curcop);
+ CvFILE_set_from_cop(cv, PL_curcop);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
o->op_ppaddr = PL_ppaddr[OP_PADAV];
return o;
}
+ else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ WARN_DEPRECATED,
+ "Using an array as a reference is deprecated");
+ }
return newUNOP(OP_RV2AV, 0, scalar(o));
}
o->op_ppaddr = PL_ppaddr[OP_PADHV];
return o;
}
+ else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ WARN_DEPRECATED,
+ "Using a hash as a reference is deprecated");
+ }
return newUNOP(OP_RV2HV, 0, scalar(o));
}
Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
PL_op_desc[o->op_type]);
}
- null(kid);
+ op_null(kid);
}
return o;
}
if (!kid) {
o->op_flags &= ~OPf_KIDS;
- null(o);
+ op_null(o);
}
else if (kid->op_type == OP_LINESEQ) {
LOGOP *enter;
o = ck_fun(o);
kid = cUNOPo->op_first->op_sibling;
if (kid->op_type == OP_RV2GV)
- null(kid);
+ op_null(kid);
}
else
o = listkids(o);
else if (kid->op_type != OP_HELEM)
Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
PL_op_desc[o->op_type]);
- null(kid);
+ op_null(kid);
}
return o;
}
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;
OP *
Perl_ck_require(pTHX_ OP *o)
{
+ GV* gv;
+
if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
SVOP *kid = (SVOP*)cUNOPo->op_first;
sv_catpvn(kid->op_sv, ".pm", 3);
}
}
+
+ /* handle override, if any */
+ gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ OP *kid = cUNOPo->op_first;
+ cUNOPo->op_first = 0;
+ op_free(o);
+ return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, kid,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+
return ck_fun(o);
}
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) {
}
else if (kid->op_type == OP_LEAVE) {
if (o->op_type == OP_SORT) {
- null(kid); /* wipe out leave */
+ op_null(kid); /* wipe out leave */
kid->op_next = kid;
for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
o->op_flags |= OPf_SPECIAL;
}
else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
- null(firstkid);
+ op_null(firstkid);
firstkid = firstkid->op_sibling;
}
OP *kid = cLISTOPo->op_first->op_sibling;
if (kid && kid->op_type == OP_MATCH) {
char *pmstr = "STRING";
- if (kPMOP->op_pmregexp)
- pmstr = kPMOP->op_pmregexp->precomp;
+ if (PM_GETRE(kPMOP))
+ pmstr = PM_GETRE(kPMOP)->precomp;
Perl_warner(aTHX_ WARN_SYNTAX,
"/%s/ should probably be written as \"%s\"",
pmstr, pmstr);
if (cvop->op_type == OP_RV2CV) {
SVOP* tmpop;
o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
- null(cvop); /* disable rv2cv */
+ op_null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
GV *gv = cGVOPx_gv(tmpop);
o->op_private |= OPpTARGET_MY;
}
}
- null(o->op_next);
+ op_null(o->op_next);
}
ignore_optimization:
o->op_seq = PL_op_seqmax++;
case OP_GV:
if (o->op_next->op_type == OP_RV2SV) {
if (!(o->op_next->op_private & OPpDEREF)) {
- null(o->op_next);
+ op_null(o->op_next);
o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
| OPpOUR_INTRO);
o->op_next = o->op_next->op_next;
i >= 0)
{
GV *gv;
- null(o->op_next);
- null(pop->op_next);
- null(pop);
+ op_null(o->op_next);
+ op_null(pop->op_next);
+ op_null(pop);
o->op_flags |= pop->op_next->op_flags & OPf_MOD;
o->op_next = pop->op_next->op_next;
o->op_type = OP_AELEMFAST;
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