From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 20 Nov 2000 22:23:21 +0000 (+0000)
Subject: lexicals not recognized in a run-time (?{})
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=160cb4296c4a58b0681dec6838a7a7ad23e4b244;p=p5sagit%2Fp5-mst-13.2.git

lexicals not recognized in a run-time (?{})
Date: Mon, 20 Nov 2000 17:06:10 -0500
To: Mailing list Perl5 <perl5-porters@perl.org>
Message-ID: <20001120170609.A11780@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@7784
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 86dd843..2b217dd 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2765,7 +2765,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     PL_op = &dummy;
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;			/* Avoid uninit warning. */
-    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHBLOCK(cx, CXt_EVAL|(PL_curcop == &PL_compiling ? 0 : CXp_REAL), SP);
     PUSHEVAL(cx, 0, Nullgv);
     rop = doeval(G_SCALAR, startop);
     POPBLOCK(cx,PL_curpm);
diff --git a/t/op/pat.t b/t/op/pat.t
index 18f79c8..8c3638c 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..224\n";
+print "1..230\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -545,6 +545,22 @@ $test++;
   print "ok $test\n";
   $test++;
 
+  local $lex_a = 2;
+  my $lex_a = 43;
+  my $lex_b = 17;
+  my $lex_c = 27;
+  my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
+  print "not " unless $lex_res eq '1';
+  print "ok $test\n";
+  $test++;
+  print "not " unless $lex_a eq '44';
+  print "ok $test\n";
+  $test++;
+  print "not " unless $lex_c eq '43';
+  print "ok $test\n";
+  $test++;
+
+
   no re "eval"; 
   $match = eval { /$a$c$a/ };
   print "not " 
@@ -554,6 +570,23 @@ $test++;
 }
 
 {
+  local $lex_a = 2;
+  my $lex_a = 43;
+  my $lex_b = 17;
+  my $lex_c = 27;
+  my $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
+  print "not " unless $lex_res eq '1';
+  print "ok $test\n";
+  $test++;
+  print "not " unless $lex_a eq '44';
+  print "ok $test\n";
+  $test++;
+  print "not " unless $lex_c eq '43';
+  print "ok $test\n";
+  $test++;
+}
+
+{
   package aa;
   $c = 2;
   $::c = 3;