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