This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/mydef.t to test.pl, strict and warnings.
[perl5.git] / t / op / mydef.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10 no warnings 'misc';
11
12 $_ = 'global';
13 is($_, 'global', '$_ initial value');
14 s/oba/abo/;
15 is($_, '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 }
38 is($_, 'glabol', 'global $_ restored');
39 s/abo/oba/;
40 is($_, '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
177 my $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
218 done_testing();