Commit | Line | Data |
---|---|---|
0f427851 | 1 | #!./perl |
59f00321 RGS |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
1c25d394 | 6 | require './test.pl'; |
59f00321 RGS |
7 | } |
8 | ||
133706a6 | 9 | print "1..70\n"; |
59f00321 RGS |
10 | |
11 | my $test = 0; | |
1c25d394 | 12 | sub ok ($@) { |
59f00321 RGS |
13 | my ($ok, $name) = @_; |
14 | ++$test; | |
15 | print $ok ? "ok $test - $name\n" : "not ok $test - $name\n"; | |
16 | } | |
17 | ||
18 | $_ = 'global'; | |
19 | ok( $_ eq 'global', '$_ initial value' ); | |
20 | s/oba/abo/; | |
21 | ok( $_ eq 'glabol', 's/// on global $_' ); | |
22 | ||
23 | { | |
24 | my $_ = 'local'; | |
25 | ok( $_ eq 'local', 'my $_ initial value' ); | |
26 | s/oca/aco/; | |
27 | ok( $_ eq 'lacol', 's/// on my $_' ); | |
28 | /(..)/; | |
29 | ok( $1 eq 'la', '// on my $_' ); | |
30 | ok( tr/c/d/ == 1, 'tr/// on my $_ counts correctly' ); | |
31 | ok( $_ eq 'ladol', 'tr/// on my $_' ); | |
32 | { | |
33 | my $_ = 'nested'; | |
34 | ok( $_ eq 'nested', 'my $_ nested' ); | |
35 | chop; | |
36 | ok( $_ eq 'neste', 'chop on my $_' ); | |
37 | } | |
38 | { | |
39 | our $_; | |
40 | ok( $_ eq 'glabol', 'gains access to our global $_' ); | |
41 | } | |
42 | ok( $_ eq 'ladol', 'my $_ restored' ); | |
43 | } | |
44 | ok( $_ eq 'glabol', 'global $_ restored' ); | |
45 | s/abo/oba/; | |
46 | ok( $_ eq 'global', 's/// on global $_ again' ); | |
47 | { | |
48 | my $_ = 11; | |
49 | our $_ = 22; | |
50 | ok( $_ eq 22, 'our $_ is seen explicitly' ); | |
51 | chop; | |
52 | ok( $_ eq 2, '...default chop chops our $_' ); | |
53 | /(.)/; | |
54 | ok( $1 eq 2, '...default match sees our $_' ); | |
55 | } | |
56 | ||
57 | $_ = "global"; | |
58 | { | |
a4fb8298 | 59 | my $_ = 'local'; |
59f00321 RGS |
60 | for my $_ ("foo") { |
61 | ok( $_ eq "foo", 'for my $_' ); | |
62 | /(.)/; | |
63 | ok( $1 eq "f", '...m// in for my $_' ); | |
64 | ok( our $_ eq 'global', '...our $_ inside for my $_' ); | |
65 | } | |
a4fb8298 RGS |
66 | ok( $_ eq 'local', '...my $_ restored outside for my $_' ); |
67 | ok( our $_ eq 'global', '...our $_ restored outside for my $_' ); | |
59f00321 RGS |
68 | } |
69 | { | |
aabe9514 RGS |
70 | my $_ = 'local'; |
71 | for ("implicit foo") { # implicit "my $_" | |
72 | ok( $_ eq "implicit foo", 'for implicit my $_' ); | |
73 | /(.)/; | |
74 | ok( $1 eq "i", '...m// in for implicity my $_' ); | |
75 | ok( our $_ eq 'global', '...our $_ inside for implicit my $_' ); | |
76 | } | |
77 | ok( $_ eq 'local', '...my $_ restored outside for implicit my $_' ); | |
78 | ok( our $_ eq 'global', '...our $_ restored outside for implicit my $_' ); | |
79 | } | |
80 | { | |
81 | my $_ = 'local'; | |
82 | ok( $_ eq "postfix foo", 'postfix for' ) for 'postfix foo'; | |
83 | ok( $_ eq 'local', '...my $_ restored outside postfix for' ); | |
84 | ok( our $_ eq 'global', '...our $_ restored outside postfix for' ); | |
85 | } | |
86 | { | |
59f00321 RGS |
87 | for our $_ ("bar") { |
88 | ok( $_ eq "bar", 'for our $_' ); | |
89 | /(.)/; | |
90 | ok( $1 eq "b", '...m// in for our $_' ); | |
91 | } | |
92 | ok( $_ eq 'global', '...our $_ restored outside for our $_' ); | |
93 | } | |
94 | ||
95 | { | |
96 | my $buf = ''; | |
97 | sub tmap1 { /(.)/; $buf .= $1 } # uses our $_ | |
98 | my $_ = 'x'; | |
99 | sub tmap2 { /(.)/; $buf .= $1 } # uses my $_ | |
100 | map { | |
101 | tmap1(); | |
102 | tmap2(); | |
103 | ok( /^[67]\z/, 'local lexical $_ is seen in map' ); | |
104 | { ok( our $_ eq 'global', 'our $_ still visible' ); } | |
105 | ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' ); | |
a4fb8298 | 106 | { my $_ ; ok( !defined, 'nested my $_ is undefined' ); } |
59f00321 RGS |
107 | } 6, 7; |
108 | ok( $buf eq 'gxgx', q/...map doesn't modify outer lexical $_/ ); | |
109 | ok( $_ eq 'x', '...my $_ restored outside map' ); | |
110 | ok( our $_ eq 'global', '...our $_ restored outside map' ); | |
a4fb8298 RGS |
111 | map { my $_; ok( !defined, 'redeclaring $_ in map block undefs it' ); } 1; |
112 | } | |
113 | { map { my $_; ok( !defined, 'declaring $_ in map block undefs it' ); } 1; } | |
114 | { | |
115 | sub tmap3 () { return $_ }; | |
116 | my $_ = 'local'; | |
117 | sub tmap4 () { return $_ }; | |
118 | my $x = join '-', map $_.tmap3.tmap4, 1 .. 2; | |
119 | ok( $x eq '1globallocal-2globallocal', 'map without {}' ); | |
59f00321 RGS |
120 | } |
121 | { | |
7cc47870 RGS |
122 | for my $_ (1) { |
123 | my $x = map $_, qw(a b); | |
124 | ok( $x == 2, 'map in scalar context' ); | |
125 | } | |
126 | } | |
127 | { | |
59f00321 RGS |
128 | my $buf = ''; |
129 | sub tgrep1 { /(.)/; $buf .= $1 } | |
130 | my $_ = 'y'; | |
131 | sub tgrep2 { /(.)/; $buf .= $1 } | |
132 | grep { | |
133 | tgrep1(); | |
134 | tgrep2(); | |
135 | ok( /^[89]\z/, 'local lexical $_ is seen in grep' ); | |
136 | { ok( our $_ eq 'global', 'our $_ still visible' ); } | |
137 | ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' ); | |
138 | } 8, 9; | |
139 | ok( $buf eq 'gygy', q/...grep doesn't modify outer lexical $_/ ); | |
140 | ok( $_ eq 'y', '...my $_ restored outside grep' ); | |
141 | ok( our $_ eq 'global', '...our $_ restored outside grep' ); | |
142 | } | |
143 | { | |
a4fb8298 RGS |
144 | sub tgrep3 () { return $_ }; |
145 | my $_ = 'local'; | |
146 | sub tgrep4 () { return $_ }; | |
147 | my $x = join '-', grep $_=$_.tgrep3.tgrep4, 1 .. 2; | |
148 | ok( $x eq '1globallocal-2globallocal', 'grep without {} with side-effect' ); | |
149 | ok( $_ eq 'local', '...but without extraneous side-effects' ); | |
150 | } | |
151 | { | |
7cc47870 RGS |
152 | for my $_ (1) { |
153 | my $x = grep $_, qw(a b); | |
154 | ok( $x == 2, 'grep in scalar context' ); | |
155 | } | |
156 | } | |
157 | { | |
59f00321 RGS |
158 | my $s = "toto"; |
159 | my $_ = "titi"; | |
160 | $s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/ | |
161 | or ok( 0, "\$s=$s should match!" ); | |
162 | ok( our $_ eq 'global', '...our $_ restored outside code-match' ); | |
163 | } | |
164 | ||
165 | { | |
166 | my $_ = "abc"; | |
167 | my $x = reverse; | |
e1f795dc | 168 | ok( $x eq "cba", 'reverse without arguments picks up $_' ); |
59f00321 RGS |
169 | } |
170 | ||
171 | { | |
172 | package notmain; | |
173 | our $_ = 'notmain'; | |
174 | ::ok( $::_ eq 'notmain', 'our $_ forced into main::' ); | |
175 | /(.*)/; | |
176 | ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' ); | |
177 | } | |
178 | ||
1c25d394 | 179 | my $file = tempfile(); |
59f00321 RGS |
180 | { |
181 | open my $_, '>', $file or die "Can't open $file: $!"; | |
182 | print $_ "hello\n"; | |
183 | close $_; | |
184 | ok( -s $file, 'writing to filehandle $_ works' ); | |
185 | } | |
186 | { | |
187 | open my $_, $file or die "Can't open $file: $!"; | |
188 | my $x = <$_>; | |
189 | ok( $x eq "hello\n", 'reading from <$_> works' ); | |
190 | close $_; | |
191 | } | |
133706a6 RGS |
192 | |
193 | { | |
194 | $fqdb::_ = 'fqdb'; | |
195 | ok( $fqdb::_ eq 'fqdb', 'fully qualified $_ is not in main' ); | |
196 | ok( eval q/$fqdb::_/ eq 'fqdb', 'fully qualified, evaled $_ is not in main' ); | |
197 | package fqdb; | |
198 | ::ok( $_ ne 'fqdb', 'unqualified $_ is in main' ); | |
199 | ::ok( q/$_/ ne 'fqdb', 'unqualified, evaled $_ is in main' ); | |
200 | } |