fix leak in package name lookup

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 31491fb..95a3061 100644 (file)
--- a/op.c
+++ b/op.c
@@ -884,9 +884,10 @@ Perl_op_free(pTHX_ OP *o)
 
         if (o->op_flags & OPf_KIDS) {
             OP *kid, *nextkid;
+            assert(cUNOPo->op_first); /* OPf_KIDS implies op_first non-null */
             for (kid = cUNOPo->op_first; kid; kid = nextkid) {
                 nextkid = OpSIBLING(kid); /* Get before next freeing kid */
-                if (!kid || kid->op_type == OP_FREED)
+                if (kid->op_type == OP_FREED)
                     /* During the forced freeing of ops after
                        compilation failure, kidops may be freed before
                        their parents. */
@@ -3102,13 +3103,8 @@ S_maybe_multiconcat(pTHX_ OP *o)
         
         /* see if any strings would grow if converted to utf8 */
         if (!utf8) {
-            char *p    = (char*)argp->p;
-            STRLEN len = argp->len;
-            while (len--) {
-                U8 c = *p++;
-                if (!UTF8_IS_INVARIANT(c))
-                    variant++;
-            }
+            variant += variant_under_utf8_count((U8 *) argp->p,
+                                                (U8 *) argp->p + argp->len);
         }
     }
 
@@ -5415,7 +5411,10 @@ Perl_newPROG(pTHX_ OP *o)
         start = LINKLIST(PL_main_root);
        PL_main_root->op_next = 0;
         S_process_optree(aTHX_ NULL, PL_main_root, start);
-       cv_forget_slab(PL_compcv);
+        if (!PL_parser->error_count)
+            /* on error, leave CV slabbed so that ops left lying around
+             * will eb cleaned up. Else unslab */
+            cv_forget_slab(PL_compcv);
        PL_compcv = 0;
 
        /* Register with debugger */
@@ -7084,11 +7083,6 @@ 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 */
 
@@ -7125,6 +7119,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
                pm->op_pmflags &= ~PMf_HAS_CV;
            }
 
+            /* Skip compiling if parser found an error for this pattern */
+            if (pm->op_pmflags & PMf_HAS_ERROR) {
+                return o;
+            }
+
            PM_SETRE(pm,
                eng->op_comp
                    ? eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
@@ -7136,7 +7135,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
        }
        else {
            /* compile-time pattern that includes literal code blocks */
-           REGEXP* re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
+
+           REGEXP* re;
+
+            /* Skip compiling if parser found an error for this pattern */
+            if (pm->op_pmflags & PMf_HAS_ERROR) {
+                return o;
+            }
+
+           re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
                        rx_flags,
                        (pm->op_pmflags |
                            ((PL_hints & HINT_RE_EVAL) ? PMf_USE_RE_EVAL : 0))
@@ -14713,8 +14720,8 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                                                             pass);
                         }
 
-#ifdef USE_ITHREADS
                         if (pass) {
+#ifdef USE_ITHREADS
                             /* Relocate sv to the pad for thread safety */
                             op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
                             arg->pad_offset = o->op_targ;