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