Devel::PPPort: Fix D_PPP_FIX_UTF8_ERRSV macro
[perl.git] / t / op / each_array.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8 use strict;
9 use warnings;
10 our (@array, @r, $k, $v, $c);
11
12 plan tests => 65;
13
14 @array = qw(crunch zam bloop);
15
16 (@r) = each @array;
17 is (scalar @r, 2, "'each' on array returns index and value of next element");
18 is ($r[0], 0, "got expected index");
19 is ($r[1], 'crunch', "got expected value");
20 ($k, $v) = each @array;
21 is ($k, 1, "got expected index of next element");
22 is ($v, 'zam', "got expected value of next element");
23 ($k, $v) = each @array;
24 is ($k, 2, "got expected index of remaining element");
25 is ($v, 'bloop', "got expected value of remaining element");
26 (@r) = each @array;
27 is (scalar @r, 0,
28     "no elements remaining to be iterated over in original array");
29
30 (@r) = each @array;
31 is (scalar @r, 2, "start second iteration over original array");
32 is ($r[0], 0, "got expected index");
33 is ($r[1], 'crunch', "got expected value");
34 ($k) = each @array;
35 is ($k, 1, "got index when only index was assigned to variable");
36
37 my @lex_array = qw(PLOP SKLIZZORCH RATTLE);
38
39 (@r) = each @lex_array;
40 is (scalar @r, 2, "'each' on array returns index and value of next element");
41 is ($r[0], 0, "got expected index");
42 is ($r[1], 'PLOP', "got expected value");
43 ($k, $v) = each @lex_array;
44 is ($k, 1, "got expected index of next element");
45 is ($v, 'SKLIZZORCH', "got expected value of next element");
46 ($k) = each @lex_array;
47 is ($k, 2, "got expected index of remaining element");
48 (@r) = each @lex_array;
49 is (scalar @r, 0,
50     "no elements remaining to be iterated over in original array");
51
52 my $ar = ['bacon'];
53
54 (@r) = each @$ar;
55 is (scalar @r, 2,
56     "'each' on array inside reference returns index and value of next element");
57 is ($r[0], 0, "got expected index");
58 is ($r[1], 'bacon', "got expected value of array element inside reference");
59
60 (@r) = each @$ar;
61 is (scalar @r, 0,
62     "no elements remaining to be iterated over in array inside reference");
63
64 is (each @$ar, 0, "scalar context 'each' on array returns expected index");
65 is (scalar each @$ar, undef,
66     "no elements remaining to be iterated over; array reference case");
67
68 my @keys;
69 @keys = keys @array;
70 is ("@keys", "0 1 2",
71     "'keys' on array in list context returns list of indices");
72
73 @keys = keys @lex_array;
74 is ("@keys", "0 1 2",
75     "'keys' on another array in list context returns list of indices");
76
77 ($k, $v) = each @array;
78 is ($k, 0, "got expected index");
79 is ($v, 'crunch', "got expected value");
80
81 @keys = keys @array;
82 is ("@keys", "0 1 2",
83     "'keys' on array in list context returns list of indices");
84
85 ($k, $v) = each @array;
86 is ($k, 0, "following 'keys', got expected index");
87 is ($v, 'crunch', "following 'keys', got expected value");
88
89
90
91 my @values;
92 @values = values @array;
93 is ("@values", "@array",
94     "'values' on array returns list of values");
95
96 @values = values @lex_array;
97 is ("@values", "@lex_array",
98     "'values' on another array returns list of values");
99
100 ($k, $v) = each @array;
101 is ($k, 0, "following 'values', got expected index");
102 is ($v, 'crunch', "following 'values', got expected index");
103
104 @values = values @array;
105 is ("@values", "@array",
106     "following 'values' and 'each', 'values' continues to return expected list of values");
107
108 ($k, $v) = each @array;
109 is ($k, 0,
110     "following 'values', 'each' and 'values', 'each' continues to return expected index");
111 is ($v, 'crunch',
112     "following 'values', 'each' and 'values', 'each' continues to return expected value");
113
114 # reset
115 while (each @array) { }
116
117 # each(ARRAY) in the conditional loop
118 $c = 0;
119 while (($k, $v) = each @array) {
120     is ($k, $c, "'each' on array in loop returns expected index '$c'");
121     is ($v, $array[$k],
122         "'each' on array in loop returns expected value '$array[$k]'");
123     $c++;
124 }
125
126 # each(ARRAY) on scalar context in conditional loop
127 # should guarantee to be wrapped into defined() function.
128 # first return value will be 0 --> [#90888]
129 $c = 0;
130 $k = 0;
131 $v = 0;
132 while ($k = each @array) {
133     is ($k, $v,
134         "'each' on array in scalar context in loop returns expected index '$v'");
135     $v++;
136 }
137
138 # each(ARRAY) in the conditional loop
139 $c = 0;
140 for (; ($k, $v) = each @array ;) {
141     is ($k, $c,
142         "'each' on array in list context in loop returns expected index '$c'");
143     is ($v, $array[$k],
144         "'each' on array in list context in loop returns expected value '$array[$k]'");
145     $c++;
146 }
147
148 # each(ARRAY) on scalar context in conditional loop
149 # --> [#90888]
150 $c = 0;
151 $k = 0;
152 $v = 0;
153 for (; $k = each(@array) ;) {
154     is ($k, $v,
155         "'each' on array in scalar context in loop returns expected index '$v'");
156     $v++;
157 }
158
159 # Reset the iterator when the array is cleared [RT #75596]
160 {
161     my @a = 'a' .. 'c';
162     my ($i, $v) = each @a;
163     is ("$i-$v", '0-a', "got expected index and value");
164     @a = 'A' .. 'C';
165     ($i, $v) = each @a;
166     is ("$i-$v", '0-A',
167         "got expected new index and value after array gets new content");
168 }
169
170 # Check that the iterator is reset when localization ends
171 {
172     @array = 'a' .. 'c';
173     my ($i, $v) = each @array;
174     is ("$i-$v", '0-a', "got expected index and value");
175     {
176         local @array = 'A' .. 'C';
177         my ($i, $v) = each @array;
178         is ("$i-$v", '0-A',
179             "got expected new index and value after array is localized and gets new content");
180         ($i, $v) = each @array;
181         is ("$i-$v", '1-B',
182             "got expected next index and value after array is localized and gets new content");
183     }
184     ($i, $v) = each @array;
185     is ("$i-$v", '1-b',
186          "got expected next index and value upon return to pre-localized array");
187     # Explicit reset
188     while (each @array) { }
189 }
190
191 my $a = 7;
192 *a = sub  { \@_ }->($a);
193 ($a, $b) = each our @a;
194 is "$a $b", "0 7", 'each in list assignment';
195 $a = 7;
196 ($a, $b) = (3, values @a);
197 is "$a $b", "3 7", 'values in list assignment';