add test for, and update comments for, old defined($1) oddity.

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 60537ad..731dce4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -799,7 +799,8 @@ Perl_scalar(pTHX_ OP *o)
     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;
@@ -897,7 +898,8 @@ Perl_scalarvoid(pTHX_ OP *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;
@@ -1142,7 +1144,8 @@ Perl_list(pTHX_ OP *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;
@@ -1268,7 +1271,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     /* -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)
@@ -1697,7 +1700,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     dVAR;
     OP *kid;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
        return o;
 
     switch (o->op_type) {
@@ -1945,7 +1948,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     dVAR;
     I32 type;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
        return o;
 
     type = o->op_type;
@@ -2373,7 +2376,7 @@ Perl_fold_constants(pTHX_ register OP *o)
            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)) {
@@ -2459,7 +2462,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     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);
@@ -3494,8 +3497,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        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;
@@ -4073,7 +4076,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                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;
@@ -4103,11 +4106,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                        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;
@@ -5459,7 +5458,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     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) {
@@ -5544,7 +5543,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            }
        }
 
-       if (name && !PL_error_count)
+       if (name && ! (PL_parser && PL_parser->error_count))
            process_special_blocks(name, gv, cv);
     }
 
@@ -6247,7 +6246,8 @@ Perl_ck_exists(pTHX_ OP *o)
        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;
@@ -6763,7 +6763,7 @@ Perl_ck_grep(pTHX_ OP *o)
     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;
@@ -6784,7 +6784,7 @@ Perl_ck_grep(pTHX_ OP *o)
     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)
@@ -7507,26 +7507,6 @@ Perl_ck_subr(pTHX_ OP *o)
                    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");
-                       }
-                   }
-               }
            }
        }
     }
@@ -8424,7 +8404,7 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
-char*
+const char*
 Perl_custom_op_name(pTHX_ const OP* o)
 {
     dVAR;
@@ -8444,7 +8424,7 @@ Perl_custom_op_name(pTHX_ const OP* o)
     return SvPV_nolen(HeVAL(he));
 }
 
-char*
+const char*
 Perl_custom_op_desc(pTHX_ const OP* o)
 {
     dVAR;