t/re/qr.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8
   9 plan tests => 4;
  10
  11 my $rx = qr//;
  12
  13 is(ref $rx, "Regexp", "qr// blessed into 'Regexp' by default");
  14
  15
  16 # Make sure /$qr/ doesn’t clobber match vars before the match (bug 70764).
  17 {
  18  my $output = '';
  19  my $rx = qr/o/;
  20  my $a = "ooaoaoao";
  21
  22  my $foo = 0;
  23  $foo += () = ($a =~ /$rx/g);
  24  $output .= "$foo\n"; # correct
  25
  26  $foo = 0;
  27  for ($foo += ($a =~ /o/); $' && ($' =~ /o/) && ($foo++) ; ) { ; }
  28  $output .= "1: $foo\n"; # No error
  29
  30  $foo = 0;
  31  for ($foo += ($a =~ /$rx/); $' && ($' =~ /$rx/) && ($foo++) ; ) { ; }
  32  $output .= "2: $foo\n"; # initialization warning, incorrect results
  33
  34  is $output, "5\n1: 5\n2: 5\n", '$a_match_var =~ /$qr/';
  35 }
  36 for($'){
  37  my $output = '';
  38  my $rx = qr/o/;
  39  my $a = "ooaoaoao";
  40
  41  my $foo = 0;
  42  $foo += () = ($a =~ /$rx/g);
  43  $output .= "$foo\n"; # correct
  44
  45  $foo = 0;
  46  for ($foo += ($a =~ /o/); $' && /o/ && ($foo++) ; ) { ; }
  47  $output .= "1: $foo\n"; # No error
  48
  49  $foo = 0;
  50  for ($foo += ($a =~ /$rx/); $' && /$rx/ && ($foo++) ; ) { ; }
  51  $output .= "2: $foo\n"; # initialization warning, incorrect results
  52
  53  is $output, "5\n1: 5\n2: 5\n", q|/$qr/ with $'_ aliased to a match var|;
  54 }
  55
  56 # Make sure /$qr/ calls get-magic on its LHS (bug 71470).
  57 {
  58  my $scratch;
  59  sub qrBug::TIESCALAR{bless[], 'qrBug'}
  60  sub qrBug::FETCH { $scratch .= "[fetching]"; 'glat' }
  61  tie my $flile, "qrBug";
  62  $flile =~ qr/(?:)/;
  63  is $scratch, "[fetching]", '/$qr/ with magical LHS';
  64 }