gmtime/localtime are busted around 2**48
[perl.git] / t / re / qr.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 plan tests => 5;
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 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 }
55 for($'){
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 }