This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hideous to-do tests for (?{}) scoping issues
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Dec 2010 02:11:24 +0000 (18:11 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Dec 2010 02:12:19 +0000 (18:12 -0800)
MANIFEST
t/re/reg_eval_scope.t [new file with mode: 0644]

index ed16802..1a9de2d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4824,6 +4824,7 @@ t/re/qr.t                 See if qr works
 t/re/reg_60508.t               See if bug #60508 is fixed
 t/re/reg_email.t               See if regex recursion works by parsing email addresses
 t/re/reg_email_thr.t           See if regex recursion works by parsing email addresses in another thread
+t/re/reg_eval_scope.t          Test scoping issues with (?{ }) and (??{ })
 t/re/reg_eval.t                        Test again regexp state corruption in (?{ }) and (??{ })
 t/re/regexp_noamp.t            See if regular expressions work with optimizations
 t/re/regexp_notrie.t           See if regular expressions work without trie optimisation
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
new file mode 100644 (file)
index 0000000..84ee1ae
--- /dev/null
@@ -0,0 +1,112 @@
+#!perl
+
+# Test scoping issues with embedded code in regexps.
+
+BEGIN { chdir 't'; @INC = qw "lib ../lib"; require './test.pl' }
+
+plan 12;
+
+# Functions for turning to-do-ness on and off (as there are so many
+# to-do tests) 
+sub on { $::TODO = "(?{}) implementation is screwy" }
+sub off { undef $::TODO }
+
+on;
+
+fresh_perl_is <<'CODE', '7817', {}, '(?{}) has its own lexical scope';
+ my $x = 7; print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })a/;
+ print $x
+CODE
+
+fresh_perl_is <<'CODE',
+ for my $x("a".."c") {
+  $y = 1;
+  print scalar
+   "abcabc" =~
+       /
+        (
+         a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
+         b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
+         c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
+        ){2}
+       /x;
+  print "$x ";
+ }
+CODE
+ '1a82a93a104a85a96a101a 1b82b93b104b85b96b101b 1c82c93c104c85c96c101c ',
+  {},
+ 'multiple (?{})s in loop with lexicals';
+
+fresh_perl_is <<'CODE', '7817', {}, 'run-time re-eval has its own scope';
+ my $x = 7; print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })a/;
+ print $x
+CODE
+
+fresh_perl_is <<'CODE', '1782793710478579671017', {},
+ use re "eval";
+ my $x = 7; $y = 1;
+ print scalar
+  "abcabc"
+    =~ ${\'(?x)
+        (
+         a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
+         b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
+         c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
+        ){2}
+       '};
+ print $x
+CODE
+ 'multiple (?{})s in "foo" =~ $string';
+
+fresh_perl_is <<'CODE', '1782793710478579671017', {},
+ use re "eval";
+ my $x = 7; $y = 1;
+ print scalar
+  "abcabc" =~
+      /${\'
+        (
+         a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
+         b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
+         c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
+        ){2}
+      '}/x;
+ print $x
+CODE
+ 'multiple (?{})s in "foo" =~ /$string/x';
+
+fresh_perl_is <<'CODE', '123123', {},
+  for my $x(1..3) {
+   push @regexps = qr/(?{ print $x })a/;
+  }
+ "a" =~ $_ for @regexps;
+ "ba" =~ /b$_/ for @regexps;
+CODE
+ 'qr/(?{})/ is a closure';
+
+off;
+
+"a" =~ do { package foo; qr/(?{ $::pack = __PACKAGE__ })a/ };
+is $pack, 'foo', 'qr// inherits package';
+"a" =~ do { use re "/x"; qr/(?{ $::re = qr-- })a/ };
+is $re, '(?^x:)', 'qr// inherits pragmata';
+
+on;
+
+"ba" =~ /b${\do { package baz; qr|(?{ $::pack = __PACKAGE__ })a| }}/;
+is $pack, 'baz', '/text$qr/ inherits package';
+"ba" =~ m+b${\do { use re "/i"; qr|(?{ $::re = qr-- })a| }}+;
+is $re, '(?^i:)', '/text$qr/ inherits pragmata';
+
+off;
+{
+  use re 'eval';
+  package bar;
+  "ba" =~ /${\'(?{ $::pack = __PACKAGE__ })a'}/;
+}
+is $pack, 'bar', '/$text/ containing (?{}) inherits package';
+on;
+{
+  use re 'eval', "/m";
+  "ba" =~ /${\'(?{ $::re = qr -- })a'}/;
+}
+is $re, '(?^m:)', '/$text/ containing (?{}) inherits pragmata';