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