make reg_eval_scope.t TODOs consistently fail
authorDavid Mitchell <davem@iabyn.com>
Mon, 24 Jan 2011 22:10:20 +0000 (22:10 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 24 Jan 2011 22:10:20 +0000 (22:10 +0000)
Some of the TODO tests in reg_eval_scope.t spuriously passed under
non-threaded builds. Make the tests harder so they always fail.

Since one of the key bugs in (?{..}) is the trashing of the parent pad,
add some extra lexical vars to the parent scope and check they're still
there at the end.

t/re/reg_eval_scope.t

index bd9ef84..3fd1bad 100644 (file)
@@ -13,9 +13,10 @@ 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
+fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
+ my $x = 7; my $a = 4; my $b = 5;
+ print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })a/;
+ print $x,$a,$b;
 CODE
 
 fresh_perl_is <<'CODE',
@@ -37,14 +38,18 @@ CODE
   {},
  '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
+fresh_perl_is <<'CODE', '781745', {}, 'run-time re-eval has its own scope';
+ use re qw(eval);
+ my $x = 7;  my $a = 4; my $b = 5;
+ my $rest = 'a';
+ print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })$rest/;
+ print $x,$a,$b;
 CODE
 
-fresh_perl_is <<'CODE', '1782793710478579671017', {},
+fresh_perl_is <<'CODE', '178279371047857967101745', {},
  use re "eval";
  my $x = 7; $y = 1;
+ my $a = 4; my $b = 5;
  print scalar
   "abcabc"
     =~ ${\'(?x)
@@ -54,13 +59,14 @@ fresh_perl_is <<'CODE', '1782793710478579671017', {},
          c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
         ){2}
        '};
- print $x
+ print $x,$a,$b
 CODE
  'multiple (?{})s in "foo" =~ $string';
 
-fresh_perl_is <<'CODE', '1782793710478579671017', {},
+fresh_perl_is <<'CODE', '178279371047857967101745', {},
  use re "eval";
  my $x = 7; $y = 1;
+ my $a = 4; my $b = 5;
  print scalar
   "abcabc" =~
       /${\'
@@ -70,7 +76,7 @@ fresh_perl_is <<'CODE', '1782793710478579671017', {},
          c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
         ){2}
       '}/x;
- print $x
+ print $x,$a,$b
 CODE
  'multiple (?{})s in "foo" =~ /$string/x';
 
@@ -112,18 +118,18 @@ is $re, '(?^m:)', '/$text/ containing (?{}) inherits pragmata';
 
 on;
 
-fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{die})';
- eval { "a" =~ /(?{die})a/ }; print "ok"
+fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{die})';
+ eval { my $a=4; my $b=5; "a" =~ /(?{die})a/ }; print $a,$b"
 CODE
-fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{last})';
- { "a" =~ /(?{last})a/ }; print "ok"
+fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{last})';
+ {  my $a=4; my $b=5; "a" =~ /(?{last})a/ }; print $a,$b
 CODE
-fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{next})';
- { "a" =~ /(?{last})a/ }; print "ok"
+fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{next})';
+ {  my $a=4; my $b=5; "a" =~ /(?{last})a/ }; print $a,$b
 CODE
-fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{return})';
- print sub { "a" =~ /(?{return "ok"})a/ }->();
+fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{return})';
+ print sub {  my $a=4; my $b=5; "a" =~ /(?{return $a.$b})a/ }->();
 CODE
-fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{goto})';
- "a" =~ /(?{goto _})a/; die; _: print "ok"
+fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{goto})';
+  my $a=4; my $b=5; "a" =~ /(?{goto _})a/; die; _: print $a,$b
 CODE