This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make the dUNDERBAR/UNDERBAR macros work as advertised.
[perl5.git] / t / op / mydef.t
CommitLineData
59f00321
RGS
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
7cc47870 8print "1..66\n";
59f00321
RGS
9
10my $test = 0;
11sub ok ($$) {
12 my ($ok, $name) = @_;
13 ++$test;
14 print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
15}
16
17$_ = 'global';
18ok( $_ eq 'global', '$_ initial value' );
19s/oba/abo/;
20ok( $_ 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}
43ok( $_ eq 'glabol', 'global $_ restored' );
44s/abo/oba/;
45ok( $_ 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{
a4fb8298 58 my $_ = 'local';
59f00321
RGS
59 for my $_ ("foo") {
60 ok( $_ eq "foo", 'for my $_' );
61 /(.)/;
62 ok( $1 eq "f", '...m// in for my $_' );
63 ok( our $_ eq 'global', '...our $_ inside for my $_' );
64 }
a4fb8298
RGS
65 ok( $_ eq 'local', '...my $_ restored outside for my $_' );
66 ok( our $_ eq 'global', '...our $_ restored outside for my $_' );
59f00321
RGS
67}
68{
aabe9514
RGS
69 my $_ = 'local';
70 for ("implicit foo") { # implicit "my $_"
71 ok( $_ eq "implicit foo", 'for implicit my $_' );
72 /(.)/;
73 ok( $1 eq "i", '...m// in for implicity my $_' );
74 ok( our $_ eq 'global', '...our $_ inside for implicit my $_' );
75 }
76 ok( $_ eq 'local', '...my $_ restored outside for implicit my $_' );
77 ok( our $_ eq 'global', '...our $_ restored outside for implicit my $_' );
78}
79{
80 my $_ = 'local';
81 ok( $_ eq "postfix foo", 'postfix for' ) for 'postfix foo';
82 ok( $_ eq 'local', '...my $_ restored outside postfix for' );
83 ok( our $_ eq 'global', '...our $_ restored outside postfix for' );
84}
85{
59f00321
RGS
86 for our $_ ("bar") {
87 ok( $_ eq "bar", 'for our $_' );
88 /(.)/;
89 ok( $1 eq "b", '...m// in for our $_' );
90 }
91 ok( $_ eq 'global', '...our $_ restored outside for our $_' );
92}
93
94{
95 my $buf = '';
96 sub tmap1 { /(.)/; $buf .= $1 } # uses our $_
97 my $_ = 'x';
98 sub tmap2 { /(.)/; $buf .= $1 } # uses my $_
99 map {
100 tmap1();
101 tmap2();
102 ok( /^[67]\z/, 'local lexical $_ is seen in map' );
103 { ok( our $_ eq 'global', 'our $_ still visible' ); }
104 ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' );
a4fb8298 105 { my $_ ; ok( !defined, 'nested my $_ is undefined' ); }
59f00321
RGS
106 } 6, 7;
107 ok( $buf eq 'gxgx', q/...map doesn't modify outer lexical $_/ );
108 ok( $_ eq 'x', '...my $_ restored outside map' );
109 ok( our $_ eq 'global', '...our $_ restored outside map' );
a4fb8298
RGS
110 map { my $_; ok( !defined, 'redeclaring $_ in map block undefs it' ); } 1;
111}
112{ map { my $_; ok( !defined, 'declaring $_ in map block undefs it' ); } 1; }
113{
114 sub tmap3 () { return $_ };
115 my $_ = 'local';
116 sub tmap4 () { return $_ };
117 my $x = join '-', map $_.tmap3.tmap4, 1 .. 2;
118 ok( $x eq '1globallocal-2globallocal', 'map without {}' );
59f00321
RGS
119}
120{
7cc47870
RGS
121 for my $_ (1) {
122 my $x = map $_, qw(a b);
123 ok( $x == 2, 'map in scalar context' );
124 }
125}
126{
59f00321
RGS
127 my $buf = '';
128 sub tgrep1 { /(.)/; $buf .= $1 }
129 my $_ = 'y';
130 sub tgrep2 { /(.)/; $buf .= $1 }
131 grep {
132 tgrep1();
133 tgrep2();
134 ok( /^[89]\z/, 'local lexical $_ is seen in grep' );
135 { ok( our $_ eq 'global', 'our $_ still visible' ); }
136 ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' );
137 } 8, 9;
138 ok( $buf eq 'gygy', q/...grep doesn't modify outer lexical $_/ );
139 ok( $_ eq 'y', '...my $_ restored outside grep' );
140 ok( our $_ eq 'global', '...our $_ restored outside grep' );
141}
142{
a4fb8298
RGS
143 sub tgrep3 () { return $_ };
144 my $_ = 'local';
145 sub tgrep4 () { return $_ };
146 my $x = join '-', grep $_=$_.tgrep3.tgrep4, 1 .. 2;
147 ok( $x eq '1globallocal-2globallocal', 'grep without {} with side-effect' );
148 ok( $_ eq 'local', '...but without extraneous side-effects' );
149}
150{
7cc47870
RGS
151 for my $_ (1) {
152 my $x = grep $_, qw(a b);
153 ok( $x == 2, 'grep in scalar context' );
154 }
155}
156{
59f00321
RGS
157 my $s = "toto";
158 my $_ = "titi";
159 $s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/
160 or ok( 0, "\$s=$s should match!" );
161 ok( our $_ eq 'global', '...our $_ restored outside code-match' );
162}
163
164{
165 my $_ = "abc";
166 my $x = reverse;
e1f795dc 167 ok( $x eq "cba", 'reverse without arguments picks up $_' );
59f00321
RGS
168}
169
170{
171 package notmain;
172 our $_ = 'notmain';
173 ::ok( $::_ eq 'notmain', 'our $_ forced into main::' );
174 /(.*)/;
175 ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' );
176}
177
178my $file = 'dolbar1.tmp';
179END { unlink $file; }
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}