APItest/t/utf8_warn_base.pl: Remove most tests

[perl5.git] / op.c

diff --git a/op.c b/op.c
index def6aca..c6b5ec7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -487,13 +487,13 @@ void
 Perl_opslab_force_free(pTHX_ OPSLAB *slab)
 {
     OPSLAB *slab2;
-    OPSLOT *slot;
 #ifdef DEBUGGING
     size_t savestack_count = 0;
 #endif
     PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE;
     slab2 = slab;
     do {
+        OPSLOT *slot;
        for (slot = slab2->opslab_first;
             slot->opslot_next;
             slot = slot->opslot_next) {
@@ -1865,7 +1865,6 @@ Perl_scalarvoid(pTHX_ OP *arg)
     dVAR;
     OP *kid;
     SV* sv;
-    U8 want;
     SSize_t defer_stack_alloc = 0;
     SSize_t defer_ix = -1;
     OP **defer_stack = NULL;
@@ -1874,6 +1873,7 @@ Perl_scalarvoid(pTHX_ OP *arg)
     PERL_ARGS_ASSERT_SCALARVOID;
 
     do {
+        U8 want;
         SV *useless_sv = NULL;
         const char* useless = NULL;
 
@@ -3826,9 +3826,9 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
            PL_parser->in_my = FALSE;
            PL_parser->in_my_stash = NULL;
            apply_attrs(GvSTASH(gv),
-                       (type == OP_RV2SV ? GvSV(gv) :
-                        type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) :
-                        type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) : MUTABLE_SV(gv)),
+                       (type == OP_RV2SV ? GvSVn(gv) :
+                        type == OP_RV2AV ? MUTABLE_SV(GvAVn(gv)) :
+                        type == OP_RV2HV ? MUTABLE_SV(GvHVn(gv)) : MUTABLE_SV(gv)),
                        attrs);
        }
        o->op_private |= OPpOUR_INTRO;
@@ -4642,7 +4642,7 @@ S_gen_constant_list(pTHX_ OP *o)
     old_next = o->op_next;
     o->op_next = 0;
     op_was_null = o->op_type == OP_NULL;
-    if (op_was_null)
+    if (op_was_null) /* b3698342565fb462291fba4b432cfcd05b6eb4e1 */
        o->op_type = OP_CUSTOM;
     CALL_PEEP(curop);
     if (op_was_null)
@@ -4669,6 +4669,9 @@ S_gen_constant_list(pTHX_ OP *o)
 
     switch (ret) {
     case 0:
+#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+        PL_curstackinfo->si_stack_hwm = 0; /* stop valgrind complaining */
+#endif
        Perl_pp_pushmark(aTHX);
        CALLRUNOPS(aTHX);
        PL_op = curop;
@@ -5843,6 +5846,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
             rx_flags |= RXf_SPLIT;
         }
 
+        /* Skip compiling if parser found an error for this pattern */
+        if (pm->op_pmflags & PMf_HAS_ERROR) {
+            return o;
+        }
+
        if (!has_code || !eng->op_comp) {
            /* compile-time simple constant pattern */
 
@@ -9768,11 +9776,11 @@ Perl_ck_delete(pTHX_ OP *o)
        case OP_HELEM:
            break;
        case OP_KVASLICE:
-           Perl_croak(aTHX_ "delete argument is index/value array slice,"
-                            " use array slice");
+            o->op_flags |= OPf_SPECIAL;
+            /* FALLTHROUGH */
        case OP_KVHSLICE:
-           Perl_croak(aTHX_ "delete argument is key/value hash slice, use"
-                            " hash slice");
+            o->op_private |= OPpKVSLICE;
+            break;
        default:
            Perl_croak(aTHX_ "delete argument is not a HASH or ARRAY "
                             "element or slice");
@@ -10558,10 +10566,10 @@ Perl_ck_smartmatch(pTHX_ OP *o)
         op_sibling_splice(o, NULL, 0, first);
        
        /* Implicitly take a reference to a regular expression */
-       if (first->op_type == OP_MATCH) {
+       if (first->op_type == OP_MATCH && !(first->op_flags & OPf_STACKED)) {
             OpTYPE_set(first, OP_QR);
        }
-       if (second->op_type == OP_MATCH) {
+       if (second->op_type == OP_MATCH && !(second->op_flags & OPf_STACKED)) {
             OpTYPE_set(second, OP_QR);
         }
     }
@@ -10890,7 +10898,6 @@ Perl_ck_require(pTHX_ OP *o)
 
     if (o->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
        SVOP * const kid = (SVOP*)cUNOPo->op_first;
-       HEK *hek;
        U32 hash;
        char *s;
        STRLEN len;
@@ -10900,6 +10907,7 @@ Perl_ck_require(pTHX_ OP *o)
          if (kid->op_private & OPpCONST_BARE) {
             dVAR;
            const char *end;
+            HEK *hek;
 
            if (was_readonly) {
                    SvREADONLY_off(sv);
@@ -10942,6 +10950,7 @@ Perl_ck_require(pTHX_ OP *o)
            }
            else {
                 dVAR;
+                HEK *hek;
                if (was_readonly) SvREADONLY_off(sv);
                PERL_HASH(hash, s, len);
                hek = share_hek(s,
@@ -10982,7 +10991,7 @@ Perl_ck_return(pTHX_ OP *o)
     PERL_ARGS_ASSERT_CK_RETURN;
 
     kid = OpSIBLING(cLISTOPo->op_first);
-    if (CvLVALUE(PL_compcv)) {
+    if (PL_compcv && CvLVALUE(PL_compcv)) {
        for (; kid; kid = OpSIBLING(kid))
            op_lvalue(kid, OP_LEAVESUBLV);
     }
@@ -13079,9 +13088,9 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                 case OP_GV:
                     /* it may be a package var index */
 
-                    ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_SPECIAL)));
+                    ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_PARENS|OPf_SPECIAL)));
                     ASSUME(!(o->op_private & ~(OPpEARLY_CV)));
-                    if (  (o->op_flags &~ OPf_SPECIAL) != OPf_WANT_SCALAR
+                    if (  (o->op_flags & ~(OPf_PARENS|OPf_SPECIAL)) != OPf_WANT_SCALAR
                         || o->op_private != 0
                     )
                         break;
@@ -13188,7 +13197,13 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                  * block of code would need rethinking.
                  */
                 if (is_deref && (o->op_private & OPpLVAL_INTRO)) {
-                    assert(o->op_next->op_type == OP_LEAVE);
+#ifdef DEBUGGING
+                    OP *n = o->op_next;
+                    while (n && (  n->op_type == OP_NULL
+                                || n->op_type == OP_LIST))
+                        n = n->op_next;
+                    assert(n && n->op_type == OP_LEAVE);
+#endif
                     o->op_private &= ~OPpDEREF;
                     is_deref = FALSE;
                 }
@@ -13480,7 +13495,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
  */
 
 static void
-S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag)
+S_check_for_bool_cxt(OP*o, U8 bool_flag, U8 maybe_flag)
 {
     OP *lop;
 
@@ -14277,7 +14292,7 @@ Perl_rpeep(pTHX_ OP *o)
        case OP_PADHV:
             /* see if %h is used in boolean context */
             if ((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR)
-                S_check_for_bool_cxt(aTHX_ o, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL);
+                S_check_for_bool_cxt(o, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL);
             if (o->op_type != OP_PADHV)
                 break;
             /* FALLTHROUGH */
@@ -14772,6 +14787,12 @@ Perl_rpeep(pTHX_ OP *o)
            break;
         }
 
+        case OP_REF:
+            /* see if ref() is used in boolean context */
+            if ((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR)
+                S_check_for_bool_cxt(o, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL);
+            break;
+
        case OP_CUSTOM: {
            Perl_cpeep_t cpeep = 
                XopENTRYCUSTOM(o, xop_peep);