xref: /openbsd/gnu/usr.bin/perl/t/re/qr.t (revision 8932bfb7) 
1#!./perl -w
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9plan tests => 5;
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 my $_($'){
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", '/$qr/ with my $_ aliased to a match var';
54}
55for($'){
56 my $output = '';
57 my $rx = qr/o/;
58 my $a = "ooaoaoao";
59
60 my $foo = 0;
61 $foo += () = ($a =~ /$rx/g);
62 $output .= "$foo\n"; # correct
63
64 $foo = 0;
65 for ($foo += ($a =~ /o/); $' && /o/ && ($foo++) ; ) { ; }
66 $output .= "1: $foo\n"; # No error
67
68 $foo = 0;
69 for ($foo += ($a =~ /$rx/); $' && /$rx/ && ($foo++) ; ) { ; }
70 $output .= "2: $foo\n"; # initialization warning, incorrect results
71
72 is $output, "5\n1: 5\n2: 5\n", q|/$qr/ with $'_ aliased to a match var|;
73}
74
75# Make sure /$qr/ calls get-magic on its LHS (bug ~~~~~).
76{
77 my $scratch;
78 sub qrBug::TIESCALAR{bless[], 'qrBug'}
79 sub qrBug::FETCH { $scratch .= "[fetching]"; 'glat' }
80 tie my $flile, "qrBug";
81 $flile =~ qr/(?:)/;
82 is $scratch, "[fetching]", '/$qr/ with magical LHS';
83}
84