dVAR;
OPCODE type;
- if (!o || o->op_static)
+ if (!o)
return;
if (o->op_latefreed) {
if (o->op_latefree)
OP *kid;
/* assumes no premature commitment */
- if (!o || PL_error_count || (o->op_flags & OPf_WANT)
+ if (!o || (PL_parser && PL_parser->error_count)
+ || (o->op_flags & OPf_WANT)
|| o->op_type == OP_RETURN)
{
return o;
/* assumes no premature commitment */
want = o->op_flags & OPf_WANT;
- if ((want && want != OPf_WANT_SCALAR) || PL_error_count
+ if ((want && want != OPf_WANT_SCALAR)
+ || (PL_parser && PL_parser->error_count)
|| o->op_type == OP_RETURN)
{
return o;
OP *kid;
/* assumes no premature commitment */
- if (!o || (o->op_flags & OPf_WANT) || PL_error_count
+ if (!o || (o->op_flags & OPf_WANT)
+ || (PL_parser && PL_parser->error_count)
|| o->op_type == OP_RETURN)
{
return o;
/* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
int localize = -1;
- if (!o || PL_error_count)
+ if (!o || (PL_parser && PL_parser->error_count))
return o;
if ((o->op_private & OPpTARGET_MY)
dVAR;
OP *kid;
- if (!o || PL_error_count)
+ if (!o || (PL_parser && PL_parser->error_count))
return o;
switch (o->op_type) {
dVAR;
I32 type;
- if (!o || PL_error_count)
+ if (!o || (PL_parser && PL_parser->error_count))
return o;
type = o->op_type;
goto nope;
}
- if (PL_error_count)
+ if (PL_parser && PL_parser->error_count)
goto nope; /* Don't try to run w/ errors */
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
const I32 oldtmps_floor = PL_tmps_floor;
list(o);
- if (PL_error_count)
+ if (PL_parser && PL_parser->error_count)
return o; /* Don't attempt to run with errors */
PL_op = curop = LINKLIST(o);
pm = (PMOP*)o;
if (expr->op_type == OP_CONST) {
- STRLEN plen;
SV * const pat = ((SVOP*)expr)->op_sv;
- const char *p = SvPV_const(pat, plen);
U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
- if ((o->op_flags & OPf_SPECIAL) && (plen == 1 && *p == ' ')) {
- U32 was_readonly = SvREADONLY(pat);
-
- if (was_readonly) {
- if (SvFAKE(pat)) {
- sv_force_normal_flags(pat, 0);
- assert(!SvREADONLY(pat));
- was_readonly = 0;
- } else {
- SvREADONLY_off(pat);
- }
- }
- sv_setpvn(pat, "\\s+", 3);
+ if (o->op_flags & OPf_SPECIAL)
+ pm_flags |= RXf_SPLIT;
- SvFLAGS(pat) |= was_readonly;
-
- p = SvPV_const(pat, plen);
- pm_flags |= RXf_SKIPWHITE;
- }
- if (DO_UTF8(pat))
+ if (DO_UTF8(pat))
pm_flags |= RXf_UTF8;
+
PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
#ifdef PERL_MAD
OP *curop;
if (pm->op_pmflags & PMf_EVAL) {
curop = NULL;
- if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
- CopLINE_set(PL_curcop, (line_t)PL_multi_end);
+ if (CopLINE(PL_curcop) < (line_t)PL_parser->multi_end)
+ CopLINE_set(PL_curcop, (line_t)PL_parser->multi_end);
}
else if (repl->op_type == OP_CONST)
curop = repl;
PL_modcount = 0;
/* Grandfathering $[ assignment here. Bletch.*/
/* Only simple assignments like C<< ($[) = 1 >> are allowed */
- PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
+ PL_eval_start = (left->op_type == OP_CONST) ? right : NULL;
left = mod(left, OP_AASSIGN);
if (PL_eval_start)
PL_eval_start = 0;
o->op_private |= OPpASSIGN_COMMON;
}
- if (right && right->op_type == OP_SPLIT) {
+ if (right && right->op_type == OP_SPLIT && !PL_madskills) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
PMOP * const pm = (PMOP*)tmpop;
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
tmpop->op_sibling = NULL; /* don't free split */
right->op_next = tmpop->op_next; /* fix starting loc */
-#ifdef PERL_MAD
- op_getmad(o,right,'R'); /* blow off assign */
-#else
op_free(o); /* blow off assign */
-#endif
right->op_flags &= ~OPf_WANT;
/* "I don't know and I don't care." */
return right;
/* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
if (first->op_type == OP_NOT
&& (first->op_flags & OPf_SPECIAL)
- && (first->op_flags & OPf_KIDS)) {
+ && (first->op_flags & OPf_KIDS)
+ && !PL_madskills) {
if (type == OP_AND || type == OP_OR) {
if (type == OP_AND)
type = OP_OR;
if (o->op_next)
first->op_next = o->op_next;
cUNOPo->op_first = NULL;
-#ifdef PERL_MAD
- op_getmad(o,first,'O');
-#else
op_free(o);
-#endif
}
}
if (first->op_type == OP_CONST) {
Perl_cv_undef(pTHX_ CV *cv)
{
dVAR;
+
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
+ PTR2UV(cv), PTR2UV(PL_comppad))
+ );
+
#ifdef USE_ITHREADS
if (CvFILE(cv) && !CvISXSUB(cv)) {
/* for XSUBs CvFILE point directly to static memory; __FILE__ */
dVAR;
SV *sv = NULL;
+ if (PL_madskills)
+ return NULL;
+
if (!o)
return NULL;
if (ps)
sv_setpvn((SV*)cv, ps, ps_len);
- if (PL_error_count) {
+ if (PL_parser && PL_parser->error_count) {
op_free(block);
block = NULL;
if (name) {
}
}
- if (name && !PL_error_count)
+ if (name && ! (PL_parser && PL_parser->error_count))
process_special_blocks(name, gv, cv);
}
OP * const kid = cUNOPo->op_first;
if (kid->op_type == OP_ENTERSUB) {
(void) ref(kid, o->op_type);
- if (kid->op_type != OP_RV2CV && !PL_error_count)
+ if (kid->op_type != OP_RV2CV
+ && !(PL_parser && PL_parser->error_count))
Perl_croak(aTHX_ "%s argument is not a subroutine name",
OP_DESC(o));
o->op_private |= OPpEXISTS_SUB;
PADOFFSET offset;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
- /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
+ /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
if (o->op_flags & OPf_STACKED) {
OP* k;
else
scalar(kid);
o = ck_fun(o);
- if (PL_error_count)
+ if (PL_parser && PL_parser->error_count)
return o;
kid = cLISTOPo->op_first->op_sibling;
if (kid->op_type != OP_NULL)
proto = SvPV((SV*)cv, len);
proto_end = proto + len;
}
- if (CvASSERTION(cv)) {
- U32 asserthints = 0;
- HV *const hinthv = GvHV(PL_hintgv);
- if (hinthv) {
- SV **svp = hv_fetchs(hinthv, "assertions", FALSE);
- if (svp && *svp)
- asserthints = SvUV(*svp);
- }
- if (asserthints & HINT_ASSERTING) {
- if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
- o->op_private |= OPpENTERSUB_DB;
- }
- else {
- delete_op = 1;
- if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
- Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
- "Impossible to activate assertion call");
- }
- }
- }
}
}
}
LEAVE;
}
-char*
+const char*
Perl_custom_op_name(pTHX_ const OP* o)
{
dVAR;
return SvPV_nolen(HeVAL(he));
}
-char*
+const char*
Perl_custom_op_desc(pTHX_ const OP* o)
{
dVAR;