93f7a1
From 170c919fc4986a85062e9292e4cfed24771d2224 Mon Sep 17 00:00:00 2001
93f7a1
From: David Mitchell <davem@iabyn.com>
93f7a1
Date: Tue, 19 Mar 2019 10:58:46 +0000
93f7a1
Subject: [PATCH] handle scope error in qr/\(?{/
93f7a1
MIME-Version: 1.0
93f7a1
Content-Type: text/plain; charset=UTF-8
93f7a1
Content-Transfer-Encoding: 8bit
93f7a1
93f7a1
RT #133879
93f7a1
93f7a1
In this code:
93f7a1
93f7a1
    BEGIN {$^H = 0x10000 }; # HINT_NEW_RE
93f7a1
    qr/\(?{/
93f7a1
93f7a1
When the toker sees the 'qr', it looks ahead and thinks that the
93f7a1
pattern *might* contain code blocks, so creates a new anon sub to wrap
93f7a1
compilation of the pattern in (so that any code blocks get compiled as
93f7a1
part of the anon sub rather than the main body of the code).
93f7a1
93f7a1
Normally at the end of parsing the qr construct, the parser notes that
93f7a1
no code blocks were found, and throws the unneeded CV away and
93f7a1
restores the old PL_compcv (via a LEAVE_SCOPE). This false positive is
93f7a1
normal and is expected in the relevant code paths.
93f7a1
93f7a1
However, setting the HINT_NEW_RE  (which indicates that
93f7a1
overload::constant is present for qr// but with no overloaded function
93f7a1
actually present) causes an error to be raised. The parser does error
93f7a1
recovery and continues.
93f7a1
93f7a1
However, v5.25.9-148-g7c44985626 added a test to not bother compiling a
93f7a1
pattern if the parser is in an errored state, which again is fine,
93f7a1
except it turns out that if this branch is taken, it skips the 'restore
93f7a1
the old PL_compcv' code, leading to the wrong value for PL_compcv when
93f7a1
ops are freed.
93f7a1
93f7a1
The fix is simple: move the "skip if errored" test to after PL_compcv
93f7a1
has been restored.
93f7a1
93f7a1
Signed-off-by: Petr Písař <ppisar@redhat.com>
93f7a1
---
93f7a1
 op.c                  | 20 ++++++++++++++------
93f7a1
 t/re/reg_eval_scope.t | 14 +++++++++++++-
93f7a1
 2 files changed, 27 insertions(+), 7 deletions(-)
93f7a1
93f7a1
diff --git a/op.c b/op.c
93f7a1
index 1f7ae3e610..afee9fcf02 100644
93f7a1
--- a/op.c
93f7a1
+++ b/op.c
93f7a1
@@ -7082,11 +7082,6 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
93f7a1
             rx_flags |= RXf_SPLIT;
93f7a1
         }
93f7a1
 
93f7a1
-        /* Skip compiling if parser found an error for this pattern */
93f7a1
-        if (pm->op_pmflags & PMf_HAS_ERROR) {
93f7a1
-            return o;
93f7a1
-        }
93f7a1
-
93f7a1
 	if (!has_code || !eng->op_comp) {
93f7a1
 	    /* compile-time simple constant pattern */
93f7a1
 
93f7a1
@@ -7123,6 +7118,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
93f7a1
 		pm->op_pmflags &= ~PMf_HAS_CV;
93f7a1
 	    }
93f7a1
 
93f7a1
+            /* Skip compiling if parser found an error for this pattern */
93f7a1
+            if (pm->op_pmflags & PMf_HAS_ERROR) {
93f7a1
+                return o;
93f7a1
+            }
93f7a1
+
93f7a1
 	    PM_SETRE(pm,
93f7a1
 		eng->op_comp
93f7a1
 		    ? eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
93f7a1
@@ -7134,7 +7134,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
93f7a1
 	}
93f7a1
 	else {
93f7a1
 	    /* compile-time pattern that includes literal code blocks */
93f7a1
-	    REGEXP* re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
93f7a1
+
93f7a1
+	    REGEXP* re;
93f7a1
+
93f7a1
+            /* Skip compiling if parser found an error for this pattern */
93f7a1
+            if (pm->op_pmflags & PMf_HAS_ERROR) {
93f7a1
+                return o;
93f7a1
+            }
93f7a1
+
93f7a1
+	    re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
93f7a1
 			rx_flags,
93f7a1
 			(pm->op_pmflags |
93f7a1
 			    ((PL_hints & HINT_RE_EVAL) ? PMf_USE_RE_EVAL : 0))
93f7a1
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
93f7a1
index 25b90b6482..3bf937d251 100644
93f7a1
--- a/t/re/reg_eval_scope.t
93f7a1
+++ b/t/re/reg_eval_scope.t
93f7a1
@@ -12,7 +12,7 @@ BEGIN {
93f7a1
     }
93f7a1
 }
93f7a1
 
93f7a1
-plan 48;
93f7a1
+plan 49;
93f7a1
 
93f7a1
 fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
93f7a1
  my $x = 7; my $a = 4; my $b = 5;
93f7a1
@@ -371,3 +371,15 @@ SKIP: {
93f7a1
     f3();
93f7a1
     is ($s, \&f3, '__SUB__ qr multi');
93f7a1
 }
93f7a1
+
93f7a1
+# RT #133879
93f7a1
+# ensure scope is properly restored when there's an error compiling a
93f7a1
+# "looks a bit like it has (?{}) but doesn't" qr//
93f7a1
+
93f7a1
+fresh_perl_like <<'CODE',
93f7a1
+    BEGIN {$^H = 0x10000 }; # HINT_NEW_RE
93f7a1
+    qr/\(?{/
93f7a1
+CODE
93f7a1
+    qr/Constant\(qq\) unknown/,
93f7a1
+    { stderr => 1 },
93f7a1
+    'qr/\(?{';
93f7a1
-- 
93f7a1
2.20.1
93f7a1