xref: /openbsd-src/gnu/usr.bin/perl/t/re/qr.t (revision 91f110e064cd7c194e59e019b83bb7496c1c84d4) 
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}
36no warnings 'experimental::lexical_topic';
37for my $_($'){
38 my $output = '';
39 my $rx = qr/o/;
40 my $a = "ooaoaoao";
41
42 my $foo = 0;
43 $foo += () = ($a =~ /$rx/g);
44 $output .= "$foo\n"; # correct
45
46 $foo = 0;
47 for ($foo += ($a =~ /o/); $' && /o/ && ($foo++) ; ) { ; }
48 $output .= "1: $foo\n"; # No error
49
50 $foo = 0;
51 for ($foo += ($a =~ /$rx/); $' && /$rx/ && ($foo++) ; ) { ; }
52 $output .= "2: $foo\n"; # initialization warning, incorrect results
53
54 is $output, "5\n1: 5\n2: 5\n", '/$qr/ with my $_ aliased to a match var';
55}
56for($'){
57 my $output = '';
58 my $rx = qr/o/;
59 my $a = "ooaoaoao";
60
61 my $foo = 0;
62 $foo += () = ($a =~ /$rx/g);
63 $output .= "$foo\n"; # correct
64
65 $foo = 0;
66 for ($foo += ($a =~ /o/); $' && /o/ && ($foo++) ; ) { ; }
67 $output .= "1: $foo\n"; # No error
68
69 $foo = 0;
70 for ($foo += ($a =~ /$rx/); $' && /$rx/ && ($foo++) ; ) { ; }
71 $output .= "2: $foo\n"; # initialization warning, incorrect results
72
73 is $output, "5\n1: 5\n2: 5\n", q|/$qr/ with $'_ aliased to a match var|;
74}
75
76# Make sure /$qr/ calls get-magic on its LHS (bug 71470).
77{
78 my $scratch;
79 sub qrBug::TIESCALAR{bless[], 'qrBug'}
80 sub qrBug::FETCH { $scratch .= "[fetching]"; 'glat' }
81 tie my $flile, "qrBug";
82 $flile =~ qr/(?:)/;
83 is $scratch, "[fetching]", '/$qr/ with magical LHS';
84}
85