Commit | Line | Data |
59f00321 |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
8 | print "1..48\n"; |
9 | |
10 | my $test = 0; |
11 | sub ok ($$) { |
12 | my ($ok, $name) = @_; |
13 | ++$test; |
14 | print $ok ? "ok $test - $name\n" : "not ok $test - $name\n"; |
15 | } |
16 | |
17 | $_ = 'global'; |
18 | ok( $_ eq 'global', '$_ initial value' ); |
19 | s/oba/abo/; |
20 | ok( $_ eq 'glabol', 's/// on global $_' ); |
21 | |
22 | { |
23 | my $_ = 'local'; |
24 | ok( $_ eq 'local', 'my $_ initial value' ); |
25 | s/oca/aco/; |
26 | ok( $_ eq 'lacol', 's/// on my $_' ); |
27 | /(..)/; |
28 | ok( $1 eq 'la', '// on my $_' ); |
29 | ok( tr/c/d/ == 1, 'tr/// on my $_ counts correctly' ); |
30 | ok( $_ eq 'ladol', 'tr/// on my $_' ); |
31 | { |
32 | my $_ = 'nested'; |
33 | ok( $_ eq 'nested', 'my $_ nested' ); |
34 | chop; |
35 | ok( $_ eq 'neste', 'chop on my $_' ); |
36 | } |
37 | { |
38 | our $_; |
39 | ok( $_ eq 'glabol', 'gains access to our global $_' ); |
40 | } |
41 | ok( $_ eq 'ladol', 'my $_ restored' ); |
42 | } |
43 | ok( $_ eq 'glabol', 'global $_ restored' ); |
44 | s/abo/oba/; |
45 | ok( $_ eq 'global', 's/// on global $_ again' ); |
46 | { |
47 | my $_ = 11; |
48 | our $_ = 22; |
49 | ok( $_ eq 22, 'our $_ is seen explicitly' ); |
50 | chop; |
51 | ok( $_ eq 2, '...default chop chops our $_' ); |
52 | /(.)/; |
53 | ok( $1 eq 2, '...default match sees our $_' ); |
54 | } |
55 | |
56 | $_ = "global"; |
57 | { |
58 | for my $_ ("foo") { |
59 | ok( $_ eq "foo", 'for my $_' ); |
60 | /(.)/; |
61 | ok( $1 eq "f", '...m// in for my $_' ); |
62 | ok( our $_ eq 'global', '...our $_ inside for my $_' ); |
63 | } |
64 | ok( $_ eq 'global', '...$_ restored outside for my $_' ); |
65 | } |
66 | { |
67 | for our $_ ("bar") { |
68 | ok( $_ eq "bar", 'for our $_' ); |
69 | /(.)/; |
70 | ok( $1 eq "b", '...m// in for our $_' ); |
71 | } |
72 | ok( $_ eq 'global', '...our $_ restored outside for our $_' ); |
73 | } |
74 | |
75 | { |
76 | my $buf = ''; |
77 | sub tmap1 { /(.)/; $buf .= $1 } # uses our $_ |
78 | my $_ = 'x'; |
79 | sub tmap2 { /(.)/; $buf .= $1 } # uses my $_ |
80 | map { |
81 | tmap1(); |
82 | tmap2(); |
83 | ok( /^[67]\z/, 'local lexical $_ is seen in map' ); |
84 | { ok( our $_ eq 'global', 'our $_ still visible' ); } |
85 | ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' ); |
86 | } 6, 7; |
87 | ok( $buf eq 'gxgx', q/...map doesn't modify outer lexical $_/ ); |
88 | ok( $_ eq 'x', '...my $_ restored outside map' ); |
89 | ok( our $_ eq 'global', '...our $_ restored outside map' ); |
90 | } |
91 | { |
92 | my $buf = ''; |
93 | sub tgrep1 { /(.)/; $buf .= $1 } |
94 | my $_ = 'y'; |
95 | sub tgrep2 { /(.)/; $buf .= $1 } |
96 | grep { |
97 | tgrep1(); |
98 | tgrep2(); |
99 | ok( /^[89]\z/, 'local lexical $_ is seen in grep' ); |
100 | { ok( our $_ eq 'global', 'our $_ still visible' ); } |
101 | ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' ); |
102 | } 8, 9; |
103 | ok( $buf eq 'gygy', q/...grep doesn't modify outer lexical $_/ ); |
104 | ok( $_ eq 'y', '...my $_ restored outside grep' ); |
105 | ok( our $_ eq 'global', '...our $_ restored outside grep' ); |
106 | } |
107 | { |
108 | my $s = "toto"; |
109 | my $_ = "titi"; |
110 | $s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/ |
111 | or ok( 0, "\$s=$s should match!" ); |
112 | ok( our $_ eq 'global', '...our $_ restored outside code-match' ); |
113 | } |
114 | |
115 | { |
116 | my $_ = "abc"; |
117 | my $x = reverse; |
118 | ok( $x eq "cba", 'reverse without arguments picks up $_ # TODO' ); |
119 | } |
120 | |
121 | { |
122 | package notmain; |
123 | our $_ = 'notmain'; |
124 | ::ok( $::_ eq 'notmain', 'our $_ forced into main::' ); |
125 | /(.*)/; |
126 | ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' ); |
127 | } |
128 | |
129 | my $file = 'dolbar1.tmp'; |
130 | END { unlink $file; } |
131 | { |
132 | open my $_, '>', $file or die "Can't open $file: $!"; |
133 | print $_ "hello\n"; |
134 | close $_; |
135 | ok( -s $file, 'writing to filehandle $_ works' ); |
136 | } |
137 | { |
138 | open my $_, $file or die "Can't open $file: $!"; |
139 | my $x = <$_>; |
140 | ok( $x eq "hello\n", 'reading from <$_> works' ); |
141 | close $_; |
142 | } |