1#!./perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9plan tests => 4; 10 11my $rx = qr//; 12 13is(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} 36for($'){ 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} 65