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;
}
return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
lastpmop = pmop;
pmop = pmop->op_pmnext;
}
+ }
#ifdef USE_ITHREADS
- Safefree(PmopSTASHPV(cPMOPo));
+ Safefree(PmopSTASHPV(cPMOPo));
#else
- /* NOTE: PMOP.op_pmstash is not refcounted */
+ /* NOTE: PMOP.op_pmstash is not refcounted */
#endif
- }
}
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;
}
/* 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 && (SvFLAGS(*namesvp) & SVpad_TYPED)
- && HvNAME(SvSTASH(*namesvp)))
+ if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED))
stash = SvSTASH(*namesvp);
else
stash = PL_curstash;
right->op_type == OP_SUBST ||
right->op_type == OP_TRANS)) {
right->op_flags |= OPf_STACKED;
- if (right->op_type != OP_MATCH &&
- ! (right->op_type == OP_TRANS &&
- right->op_private & OPpTRANS_IDENTICAL))
+ if ((right->op_type != OP_MATCH &&
+ ! (right->op_type == OP_TRANS &&
+ right->op_private & OPpTRANS_IDENTICAL)) ||
+ /* if SV has magic, then match on original SV, not on its copy.
+ see note in pp_helem() */
+ (right->op_type == OP_MATCH &&
+ (left->op_type == OP_AELEM ||
+ left->op_type == OP_HELEM ||
+ left->op_type == OP_AELEMFAST)))
left = mod(left, right->op_type);
if (right->op_type == OP_TRANS)
o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
pmop->op_pmpermflags |= PMf_LOCALE;
pmop->op_pmflags = pmop->op_pmpermflags;
- /* link into pm list */
+ #ifdef USE_ITHREADS
+ {
+ SV* repointer = newSViv(0);
+ av_push(PL_regex_padav,SvREFCNT_inc(repointer));
+ pmop->op_pmoffset = av_len(PL_regex_padav);
+ PL_regex_pad = AvARRAY(PL_regex_padav);
+ }
+ #endif
+
+ /* link into pm list */
if (type != OP_TRANS && PL_curstash) {
pmop->op_pmnext = HvPMROOT(PL_curstash);
HvPMROOT(PL_curstash) = pmop;
}
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;
}
op_free(o);
}
else {
+ deprecate("\"package\" with no arguments");
sv_setpv(PL_curstname,"<none>");
PL_curstash = Nullhv;
}
OP *next = 0;
OP *listop;
OP *o;
- OP *condop;
U8 loopflags = 0;
if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
return Nullop; /* listop already freed by new_logop */
}
if (listop)
- ((LISTOP*)listop)->op_last->op_next = condop =
+ ((LISTOP*)listop)->op_last->op_next =
(o == listop ? redo : LINKLIST(o));
}
else
}
#endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+ if (CvFILE(cv) && !CvXSUB(cv)) {
+ /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+ Safefree(CvFILE(cv));
+ }
+ CvFILE(cv) = 0;
+#endif
+
if (!CvXSUB(cv) && CvROOT(cv)) {
#ifdef USE_THREADS
if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
* apply to closures generated within eval"", since eval"" CVs are
* ephemeral. --GSAR */
if (!CvANON(cv) || CvCLONED(cv)
- || (CvOUTSIDE(cv) && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
{
SvREFCNT_dec(CvOUTSIDE(cv));
}
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));
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);
+#ifdef GV_UNIQUE_CHECK
+ if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
+ Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
}
#endif
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);
+#ifdef GV_UNIQUE_CHECK
+ if (exists && GvUNIQUE(gv)) {
+ Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
}
#endif
*/
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;
}
/* ... before we throw it away */
SvREFCNT_dec(PL_compcv);
+ if (PERLDB_INTER)/* Advice debugger on the new sub. */
+ ++PL_sub_generation;
}
else {
cv = PL_compcv;
}
}
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;
* lifetime of the outer CV. Avoids memory leak due to reference
* loop. --GSAR */
if (!name && CvOUTSIDE(cv)
- && !(CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
{
SvREFCNT_dec(CvOUTSIDE(cv));
}
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)
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)");
+#ifdef GV_UNIQUE_CHECK
+ if (GvUNIQUE(gv)) {
+ Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
}
#endif
GvMULTI_on(gv);
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]))
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);
{
PL_curcop = ((COP*)o);
}
- goto nothin;
+ /* XXX: We avoid setting op_seq here to prevent later calls
+ to peep() from mistakenly concluding that optimisation
+ has already occurred. This doesn't fix the real problem,
+ though (See 20010220.007). AMS 20010719 */
+ if (oldop && o->op_next) {
+ oldop->op_next = o->op_next;
+ continue;
+ }
+ break;
case OP_SCALAR:
case OP_LINESEQ:
case OP_SCOPE:
svp = cSVOPx_svp(((BINOP*)o)->op_last);
if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
key = SvPV(sv, keylen);
- if (SvUTF8(sv))
- keylen = -keylen;
- lexname = newSVpvn_share(key, keylen, 0);
+ lexname = newSVpvn_share(key,
+ SvUTF8(sv) ? -(I32)keylen : keylen,
+ 0);
SvREFCNT_dec(sv);
*svp = lexname;
}
if (!fields || !GvHV(*fields))
break;
key = SvPV(*svp, keylen);
- if (SvUTF8(*svp))
- keylen = -keylen;
- indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+ indsvp = hv_fetch(GvHV(*fields), key,
+ SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
if (!indsvp) {
Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
key_op = (SVOP*)key_op->op_sibling) {
svp = cSVOPx_svp(key_op);
key = SvPV(*svp, keylen);
- if (SvUTF8(*svp))
- keylen = -keylen;
- indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+ indsvp = hv_fetch(GvHV(*fields), key,
+ SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
if (!indsvp) {
Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
"in variable %s of type %s",