nop = (OP*)rexi->data->data[n];
}
+ /* normally if we're about to execute code from the same
+ * CV that we used previously, we just use the existing
+ * CX stack entry. However, its possible that in the
+ * meantime we may have backtracked, popped from the save
+ * stack, and undone the SAVECOMPPAD(s) associated with
+ * PUSH_MULTICALL; in which case PL_comppad no longer
+ * points to newcv's pad. */
+ if (newcv != last_pushed_cv || PL_comppad != last_pad)
+ {
+ I32 depth = (newcv == caller_cv) ? 0 : 1;
+ if (last_pushed_cv) {
+ CHANGE_MULTICALL_WITHDEPTH(newcv, depth);
+ }
+ else {
+ PUSH_MULTICALL_WITHDEPTH(newcv, depth);
+ }
+ last_pushed_cv = newcv;
+ }
+ last_pad = PL_comppad;
+
/* the initial nextstate you would normally execute
* at the start of an eval (which would cause error
* messages to come from the eval), may be optimised
DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
" re EVAL PL_op=0x%"UVxf"\n", PTR2UV(nop)) );
- /* normally if we're about to execute code from the same
- * CV that we used previously, we just use the existing
- * CX stack entry. However, its possible that in the
- * meantime we may have backtracked, popped from the save
- * stack, and undone the SAVECOMPPAD(s) associated with
- * PUSH_MULTICALL; in which case PL_comppad no longer
- * points to newcv's pad. */
- if (newcv != last_pushed_cv || PL_comppad != last_pad)
- {
- I32 depth = (newcv == caller_cv) ? 0 : 1;
- if (last_pushed_cv) {
- CHANGE_MULTICALL_WITHDEPTH(newcv, depth);
- }
- else {
- PUSH_MULTICALL_WITHDEPTH(newcv, depth);
- }
- last_pushed_cv = newcv;
- }
- last_pad = PL_comppad;
-
rex->offs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
if (sv_yes_mark) {
skip_all_if_miniperl("no dynamic loading on miniperl, no re");
}
-plan 30;
+plan 34;
fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
my $x = 7; my $a = 4; my $b = 5;
("a" x 40_000) =~ /^$qr(ab*)+/; my $line = __LINE__;
like($w, qr/recursion limit.* line $line\b/, "warning on right line");
}
+
+# on immediate exit from pattern with code blocks, make sure PL_curcop is
+# restored
+
+{
+ use re 'eval';
+
+ my $c = '(?{"1"})';
+ my $w = '';
+ my $l;
+
+ local $SIG{__WARN__} = sub { $w .= "@_" };
+ $l = __LINE__; "1" =~ /^1$c/x and warn "foo";
+ like($w, qr/foo.+line $l/, 'curcop 1');
+
+ $w = '';
+ $l = __LINE__; "4" =~ /^1$c/x or warn "foo";
+ like($w, qr/foo.+line $l/, 'curcop 2');
+
+ $c = '(??{"1"})';
+ $l = __LINE__; "1" =~ /^$c/x and warn "foo";
+ like($w, qr/foo.+line $l/, 'curcop 3');
+
+ $w = '';
+ $l = __LINE__; "4" =~ /^$c/x or warn "foo";
+ like($w, qr/foo.+line $l/, 'curcop 4');
+}