This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #90888] each(ARRAY) on scalar context should wrapped into defined()
[perl5.git] / t / op / each_array.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8 use strict;
9 use warnings;
10 no warnings 'deprecated';
11 use vars qw(@array @r $k $v $c);
12
13 plan tests => 66;
14
15 @array = qw(crunch zam bloop);
16
17 (@r) = each @array;
18 is (scalar @r, 2);
19 is ($r[0], 0);
20 is ($r[1], 'crunch');
21 ($k, $v) = each @array;
22 is ($k, 1);
23 is ($v, 'zam');
24 ($k, $v) = each @array;
25 is ($k, 2);
26 is ($v, 'bloop');
27 (@r) = each @array;
28 is (scalar @r, 0);
29
30 (@r) = each @array;
31 is (scalar @r, 2);
32 is ($r[0], 0);
33 is ($r[1], 'crunch');
34 ($k) = each @array;
35 is ($k, 1);
36 {
37     $[ = 2;
38     my ($k, $v) = each @array;
39     is ($k, 4);
40     is ($v, 'bloop');
41     (@r) = each @array;
42     is (scalar @r, 0);
43 }
44
45 my @lex_array = qw(PLOP SKLIZZORCH RATTLE PBLRBLPSFT);
46
47 (@r) = each @lex_array;
48 is (scalar @r, 2);
49 is ($r[0], 0);
50 is ($r[1], 'PLOP');
51 ($k, $v) = each @lex_array;
52 is ($k, 1);
53 is ($v, 'SKLIZZORCH');
54 ($k) = each @lex_array;
55 is ($k, 2);
56 {
57     $[ = -42;
58     my ($k, $v) = each @lex_array;
59     is ($k, -39);
60     is ($v, 'PBLRBLPSFT');
61 }
62 (@r) = each @lex_array;
63 is (scalar @r, 0);
64
65 my $ar = ['bacon'];
66
67 (@r) = each @$ar;
68 is (scalar @r, 2);
69 is ($r[0], 0);
70 is ($r[1], 'bacon');
71
72 (@r) = each @$ar;
73 is (scalar @r, 0);
74
75 is (each @$ar, 0);
76 is (scalar each @$ar, undef);
77
78 my @keys;
79 @keys = keys @array;
80 is ("@keys", "0 1 2");
81
82 @keys = keys @lex_array;
83 is ("@keys", "0 1 2 3");
84
85 {
86     $[ = 1;
87
88     @keys = keys @array;
89     is ("@keys", "1 2 3");
90
91     @keys = keys @lex_array;
92     is ("@keys", "1 2 3 4");
93 }
94
95 ($k, $v) = each @array;
96 is ($k, 0);
97 is ($v, 'crunch');
98
99 @keys = keys @array;
100 is ("@keys", "0 1 2");
101
102 ($k, $v) = each @array;
103 is ($k, 0);
104 is ($v, 'crunch');
105
106
107
108 my @values;
109 @values = values @array;
110 is ("@values", "@array");
111
112 @values = values @lex_array;
113 is ("@values", "@lex_array");
114
115 {
116     $[ = 1;
117
118     @values = values @array;
119     is ("@values", "@array");
120
121     @values = values @lex_array;
122     is ("@values", "@lex_array");
123 }
124
125 ($k, $v) = each @array;
126 is ($k, 0);
127 is ($v, 'crunch');
128
129 @values = values @array;
130 is ("@values", "@array");
131
132 ($k, $v) = each @array;
133 is ($k, 0);
134 is ($v, 'crunch');
135
136 # reset
137 $[ = 0;
138 while (each @array) { }
139
140 # each(ARRAY) in the conditional loop
141 $c = 0;
142 while (($k, $v) = each @array) {
143     is ($k, $c);
144     is ($v, $array[$k]);
145     $c++;
146 }
147
148 # each(ARRAY) on scalar context in conditional loop
149 # should guarantee to be wrapped into defined() function.
150 # first return value will be $[ --> [#90888]
151 $c = 0;
152 $k = 0;
153 $v = 0;
154 while ($k = each @array) {
155     is ($k, $v);
156     $v++;
157 }
158
159 # each(ARRAY) in the conditional loop
160 $c = 0;
161 for (; ($k, $v) = each @array ;) {
162     is ($k, $c);
163     is ($v, $array[$k]);
164     $c++;
165 }
166
167 # each(ARRAY) on scalar context in conditional loop
168 # --> [#90888]
169 $c = 0;
170 $k = 0;
171 $v = 0;
172 for (; $k = each(@array) ;) {
173     is ($k, $v);
174     $v++;
175 }