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 (file)
--- 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 (executable)
--- 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;