t/re/reg_eval_scope.t

   1 #!perl
   2
   3 # Test scoping issues with embedded code in regexps.
   4
   5 BEGIN { chdir 't'; @INC = qw "lib ../lib"; require './test.pl' }
   6
   7 plan 17;
   8
   9 # Functions for turning to-do-ness on and off (as there are so many
  10 # to-do tests)
  11 sub on { $::TODO = "(?{}) implementation is screwy" }
  12 sub off { undef $::TODO }
  13
  14 on;
  15
  16 fresh_perl_is <<'CODE', '7817', {}, '(?{}) has its own lexical scope';
  17  my $x = 7; print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })a/;
  18  print $x
  19 CODE
  20
  21 fresh_perl_is <<'CODE',
  22  for my $x("a".."c") {
  23   $y = 1;
  24   print scalar
  25    "abcabc" =~
  26        /
  27         (
  28          a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
  29          b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
  30          c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
  31         ){2}
  32        /x;
  33   print "$x ";
  34  }
  35 CODE
  36  '1a82a93a104a85a96a101a 1b82b93b104b85b96b101b 1c82c93c104c85c96c101c ',
  37   {},
  38  'multiple (?{})s in loop with lexicals';
  39
  40 fresh_perl_is <<'CODE', '7817', {}, 'run-time re-eval has its own scope';
  41  my $x = 7; print "a" =~ /(?{ print $x; my $x = 8; print $x; my $y })a/;
  42  print $x
  43 CODE
  44
  45 fresh_perl_is <<'CODE', '1782793710478579671017', {},
  46  use re "eval";
  47  my $x = 7; $y = 1;
  48  print scalar
  49   "abcabc"
  50     =~ ${\'(?x)
  51         (
  52          a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
  53          b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
  54          c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
  55         ){2}
  56        '};
  57  print $x
  58 CODE
  59  'multiple (?{})s in "foo" =~ $string';
  60
  61 fresh_perl_is <<'CODE', '1782793710478579671017', {},
  62  use re "eval";
  63  my $x = 7; $y = 1;
  64  print scalar
  65   "abcabc" =~
  66       /${\'
  67         (
  68          a (?{ print $y; local $y = $y+1; print $x; my $x = 8; print $x })
  69          b (?{ print $y; local $y = $y+1; print $x; my $x = 9; print $x })
  70          c (?{ print $y; local $y = $y+1; print $x; my $x = 10; print $x })
  71         ){2}
  72       '}/x;
  73  print $x
  74 CODE
  75  'multiple (?{})s in "foo" =~ /$string/x';
  76
  77 fresh_perl_is <<'CODE', '123123', {},
  78   for my $x(1..3) {
  79    push @regexps = qr/(?{ print $x })a/;
  80   }
  81  "a" =~ $_ for @regexps;
  82  "ba" =~ /b$_/ for @regexps;
  83 CODE
  84  'qr/(?{})/ is a closure';
  85
  86 off;
  87
  88 "a" =~ do { package foo; qr/(?{ $::pack = __PACKAGE__ })a/ };
  89 is $pack, 'foo', 'qr// inherits package';
  90 "a" =~ do { use re "/x"; qr/(?{ $::re = qr-- })a/ };
  91 is $re, '(?^x:)', 'qr// inherits pragmata';
  92
  93 on;
  94
  95 "ba" =~ /b${\do { package baz; qr|(?{ $::pack = __PACKAGE__ })a| }}/;
  96 is $pack, 'baz', '/text$qr/ inherits package';
  97 "ba" =~ m+b${\do { use re "/i"; qr|(?{ $::re = qr-- })a| }}+;
  98 is $re, '(?^i:)', '/text$qr/ inherits pragmata';
  99
 100 off;
 101 {
 102   use re 'eval';
 103   package bar;
 104   "ba" =~ /${\'(?{ $::pack = __PACKAGE__ })a'}/;
 105 }
 106 is $pack, 'bar', '/$text/ containing (?{}) inherits package';
 107 {
 108   use re 'eval', "/m";
 109   "ba" =~ /${\'(?{ $::re = qr -- })a'}/;
 110 }
 111 is $re, '(?^m:)', '/$text/ containing (?{}) inherits pragmata';
 112
 113 on;
 114
 115 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{die})';
 116  eval { "a" =~ /(?{die})a/ }; print "ok"
 117 CODE
 118 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{last})';
 119  { "a" =~ /(?{last})a/ }; print "ok"
 120 CODE
 121 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{next})';
 122  { "a" =~ /(?{last})a/ }; print "ok"
 123 CODE
 124 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{return})';
 125  print sub { "a" =~ /(?{return "ok"})a/ }->();
 126 CODE
 127 fresh_perl_is <<'CODE', 'ok', { stderr => 1 }, '(?{goto})';
 128  "a" =~ /(?{goto _})a/; die; _: print "ok"
 129 CODE