#include "perl.h"
#include "keywords.h"
+#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
+
/* #define PL_OP_SLAB_ALLOC */
#ifdef PL_OP_SLAB_ALLOC
if (!(PL_in_my == KEY_our ||
isALPHA(name[1]) ||
- (PL_hints & HINT_UTF8 && UTF8_IS_START(name[1])) ||
+ (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
(name[1] == '_' && (int)strlen(name) > 2)))
{
if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
#endif
}
cPMOPo->op_pmreplroot = Nullop;
- ReREFCNT_dec(PM_GETRE(cPMOPo));
- PM_SETRE(cPMOPo, (REGEXP*)NULL);
+ /* we use the "SAFE" version of the PM_ macros here
+ * since sv_clean_all might release some PMOPs
+ * after PL_regex_padav has been cleared
+ * and the clearing of PL_regex_padav needs to
+ * happen before sv_clean_all
+ */
+ ReREFCNT_dec(PM_GETRE_SAFE(cPMOPo));
+ PM_SETRE_SAFE(cPMOPo, (REGEXP*)NULL);
break;
}
PL_eval_root->op_private |= OPpREFCOUNTED;
OpREFCNT_set(PL_eval_root, 1);
PL_eval_root->op_next = 0;
- peep(PL_eval_start);
+ CALL_PEEP(PL_eval_start);
}
else {
if (!o)
PL_main_root->op_private |= OPpREFCOUNTED;
OpREFCNT_set(PL_main_root, 1);
PL_main_root->op_next = 0;
- peep(PL_main_start);
+ CALL_PEEP(PL_main_start);
PL_compcv = 0;
/* Register with debugger */
if (o->op_flags & OPf_PARENS)
list(o);
else {
- if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
- char *s;
- for (s = PL_bufptr; *s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ",*s)); s++) ;
+ if (ckWARN(WARN_PARENTHESIS)
+ && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
+ {
+ char *s = PL_bufptr;
+
+ while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s)))
+ s++;
+
if (*s == ';' || *s == '=')
Perl_warner(aTHX_ WARN_PARENTHESIS,
"Parentheses missing around \"%s\" list",
PL_op = curop = LINKLIST(o);
o->op_next = 0;
- peep(curop);
+ CALL_PEEP(curop);
pp_pushmark();
CALLRUNOPS(aTHX);
PL_op = curop;
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;
p = SvPV(pat, plen);
pm->op_pmflags |= PMf_SKIPWHITE;
}
- if ((PL_hints & HINT_UTF8) || DO_UTF8(pat))
- pm->op_pmdynflags |= PMdf_UTF8;
PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
if (strEQ("\\s+", PM_GETRE(pm)->precomp))
pm->op_pmflags |= PMf_WHITE;
op_free(expr);
}
else {
- if (PL_hints & HINT_UTF8)
- pm->op_pmdynflags |= PMdf_UTF8;
if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
expr = newUNOP((!(PL_hints & HINT_RE_EVAL)
? OP_REGCRESET
op_free(o);
}
else {
+ deprecate("\"package\" with no arguments");
sv_setpv(PL_curstname,"<none>");
PL_curstash = Nullhv;
}
OP *pack;
OP *imop;
OP *veop;
+ char *packname = Nullch;
+ STRLEN packlen = 0;
+ SV *packsv;
if (id->op_type != OP_CONST)
Perl_croak(aTHX_ "Module name must be constant");
newSVOP(OP_METHOD_NAMED, 0, meth)));
}
+ if (ckWARN(WARN_MISC) &&
+ imop && (imop != arg) && /* no warning on use 5.0; or explicit () */
+ SvPOK(packsv = ((SVOP*)id)->op_sv))
+ {
+ /* BEGIN will free the ops, so we need to make a copy */
+ packlen = SvCUR(packsv);
+ packname = savepvn(SvPVX(packsv), packlen);
+ }
+
/* Fake up the BEGIN {}, which does its thing immediately. */
newATTRSUB(floor,
newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
newSTATEOP(0, Nullch, veop)),
newSTATEOP(0, Nullch, imop) ));
+ if (packname) {
+ if (ckWARN(WARN_MISC) && !gv_stashpvn(packname, packlen, FALSE)) {
+ Perl_warner(aTHX_ WARN_MISC,
+ "Package `%s' not found "
+ "(did you use the incorrect case?)", packname);
+ }
+ safefree(packname);
+ }
+
PL_hints |= HINT_BLOCK_SCOPE;
PL_copline = NOLINE;
PL_expect = XSTATE;
#ifdef USE_ITHREADS
if (CvFILE(cv) && !CvXSUB(cv)) {
+ /* for XSUBs CvFILE point directly to static memory; __FILE__ */
Safefree(CvFILE(cv));
- CvFILE(cv) = 0;
}
+ CvFILE(cv) = 0;
#endif
if (!CvXSUB(cv) && CvROOT(cv)) {
SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
CvCONST_off(cv);
}
- CvDEFSTASH(cv) = Nullhv;
if (CvPADLIST(cv)) {
/* may be during global destruction */
if (SvREFCNT(CvPADLIST(cv))) {
CvGV(cv) = CvGV(proto);
CvSTASH(cv) = CvSTASH(proto);
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
- CvDEFSTASH(cv) = CvDEFSTASH(proto);
CvSTART(cv) = CvSTART(proto);
if (outside)
CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
}
cv_undef(cv);
CvFLAGS(cv) = CvFLAGS(PL_compcv);
- CvDEFSTASH(cv) = CvDEFSTASH(PL_compcv);
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
CvOUTSIDE(PL_compcv) = 0;
CvPADLIST(cv) = CvPADLIST(PL_compcv);
}
/* ... 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;
OpREFCNT_set(CvROOT(cv), 1);
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
- peep(CvSTART(cv));
+ CALL_PEEP(CvSTART(cv));
/* now that optimizer has done its work, adjust pad values */
if (CvCLONE(cv)) {
CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be
an external constant string */
CvXSUB(cv) = subaddr;
- CvDEFSTASH(cv) = PL_defstash;
if (name) {
char *s = strrchr(name,':');
OpREFCNT_set(CvROOT(cv), 1);
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
- peep(CvSTART(cv));
+ CALL_PEEP(CvSTART(cv));
op_free(o);
PL_copline = NOLINE;
LEAVE_SCOPE(floor);
}
OP *
-Perl_ck_octmode(pTHX_ OP *o)
-{
- OP *p;
-
- if ((ckWARN(WARN_OCTMODE)
- /* Add WARN_MKDIR instead of getting rid of WARN_{CHMOD,UMASK}.
- Backwards compatibility and consistency are terrible things.
- AMS 20010705 */
- || (o->op_type == OP_CHMOD && ckWARN(WARN_CHMOD))
- || (o->op_type == OP_UMASK && ckWARN(WARN_UMASK))
- || (o->op_type == OP_MKDIR && ckWARN(WARN_MKDIR)))
- && o->op_flags & OPf_KIDS)
- {
- if (o->op_type == OP_MKDIR)
- p = cLISTOPo->op_last; /* mkdir $foo, 0777 */
- else if (o->op_type == OP_CHMOD)
- p = cLISTOPo->op_first->op_sibling; /* chmod 0777, $foo */
- else
- p = cUNOPo->op_first; /* umask 0222 */
-
- if (p->op_type == OP_CONST && !(p->op_private & OPpCONST_OCTAL)) {
- int mode = SvIV(cSVOPx_sv(p));
-
- Perl_warner(aTHX_ WARN_OCTMODE,
- "Non-octal literal mode (%d) specified", mode);
- Perl_warner(aTHX_ WARN_OCTMODE,
- "\t(Did you mean 0%d instead?)\n", mode);
- }
- }
- return ck_fun(o);
-}
-
-OP *
Perl_ck_open(pTHX_ OP *o)
{
HV *table = GvHV(PL_hintgv);
kid->op_next = 0; /* just disconnect the leave */
k = kLISTOP->op_first;
}
- peep(k);
+ CALL_PEEP(k);
kid = firstkid;
if (o->op_type == OP_SORT) {
{
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:
SvPV_nolen(sv));
}
}
+ else if (o->op_next->op_type == OP_READLINE
+ && o->op_next->op_next->op_type == OP_CONCAT
+ && (o->op_next->op_next->op_flags & OPf_STACKED))
+ {
+ /* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010811 */
+ o->op_next->op_type = OP_RCATLINE;
+ o->op_next->op_flags |= OPf_STACKED;
+ op_null(o->op_next->op_next);
+ }
o->op_seq = PL_op_seqmax++;
break;
o->op_seq = PL_op_seqmax++;
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
- peep(cLOGOP->op_other);
+ peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
break;
case OP_ENTERLOOP:
projects / p5sagit/p5-mst-13.2.git / blobdiff