develooper Front page | perl.perl5.changes | Postings from March 2019

[perl.git] branch blead updated. v5.29.8-135-g44b0aff01b

From:
Dave Mitchell
Date:
March 19, 2019 11:42
Subject:
[perl.git] branch blead updated. v5.29.8-135-g44b0aff01b
Message ID:
E1h6D8D-0002f5-Cy@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/44b0aff01ba282b14dc62a1137996136282bc17a?hp=2fe8bdbd8f254afbafdd3be0139e6df0e570b622>

- Log -----------------------------------------------------------------
commit 44b0aff01ba282b14dc62a1137996136282bc17a
Author: David Mitchell <davem@iabyn.com>
Date:   Tue Mar 19 11:15:21 2019 +0000

    op_free() remove redundant !kid test
    
    and replace with an assert.
    
    If an op has the OPf_KIDS flag, then cUNOPo->op_first must be non-null.
    So testing for !kid doesn't do much, especially as on the previous line
    we dereference it anyway.

commit 170c919fc4986a85062e9292e4cfed24771d2224
Author: David Mitchell <davem@iabyn.com>
Date:   Tue Mar 19 10:58:46 2019 +0000

    handle scope error in qr/\(?{/
    
    RT #133879
    
    In this code:
    
        BEGIN {$^H = 0x10000 }; # HINT_NEW_RE
        qr/\(?{/
    
    When the toker sees the 'qr', it looks ahead and thinks that the
    pattern *might* contain code blocks, so creates a new anon sub to wrap
    compilation of the pattern in (so that any code blocks get compiled as
    part of the anon sub rather than the main body of the code).
    
    Normally at the end of parsing the qr construct, the parser notes that
    no code blocks were found, and throws the unneeded CV away and
    restores the old PL_compcv (via a LEAVE_SCOPE). This false positive is
    normal and is expected in the relevant code paths.
    
    However, setting the HINT_NEW_RE  (which indicates that
    overload::constant is present for qr// but with no overloaded function
    actually present) causes an error to be raised. The parser does error
    recovery and continues.
    
    However, v5.25.9-148-g7c44985626 added a test to not bother compiling a
    pattern if the parser is in an errored state, which again is fine,
    except it turns out that if this branch is taken, it skips the 'restore
    the old PL_compcv' code, leading to the wrong value for PL_compcv when
    ops are freed.
    
    The fix is simple: move the "skip if errored" test to after PL_compcv
    has been restored.

-----------------------------------------------------------------------

Summary of changes:
 op.c                  | 23 ++++++++++++++++-------
 t/re/reg_eval_scope.t | 14 +++++++++++++-
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/op.c b/op.c
index 1f7ae3e610..95a3061202 100644
--- 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. */
@@ -7082,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 */
 
@@ -7123,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,
@@ -7134,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))
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index 25b90b6482..3bf937d251 100644
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-plan 48;
+plan 49;
 
 fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  my $x = 7; my $a = 4; my $b = 5;
@@ -371,3 +371,15 @@ SKIP: {
     f3();
     is ($s, \&f3, '__SUB__ qr multi');
 }
+
+# RT #133879
+# ensure scope is properly restored when there's an error compiling a
+# "looks a bit like it has (?{}) but doesn't" qr//
+
+fresh_perl_like <<'CODE',
+    BEGIN {$^H = 0x10000 }; # HINT_NEW_RE
+    qr/\(?{/
+CODE
+    qr/Constant\(qq\) unknown/,
+    { stderr => 1 },
+    'qr/\(?{';

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About