Commit | Line | Data |
---|---|---|
55b67815 | 1 | #!./perl |
878d132a NC |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | use strict; | |
55b67815 | 9 | use warnings; |
459b64da | 10 | use vars qw(@array @r $k $v $c); |
878d132a | 11 | |
83f29afa | 12 | plan tests => 63; |
878d132a NC |
13 | |
14 | @array = qw(crunch zam bloop); | |
15 | ||
16 | (@r) = each @array; | |
4c0cb726 JK |
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"); | |
878d132a | 20 | ($k, $v) = each @array; |
4c0cb726 JK |
21 | is ($k, 1, "got expected index of next element"); |
22 | is ($v, 'zam', "got expected value of next element"); | |
878d132a | 23 | ($k, $v) = each @array; |
4c0cb726 JK |
24 | is ($k, 2, "got expected index of remaining element"); |
25 | is ($v, 'bloop', "got expected value of remaining element"); | |
878d132a | 26 | (@r) = each @array; |
4c0cb726 JK |
27 | is (scalar @r, 0, |
28 | "no elements remaining to be iterated over in original array"); | |
878d132a NC |
29 | |
30 | (@r) = each @array; | |
4c0cb726 JK |
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"); | |
878d132a | 34 | ($k) = each @array; |
4c0cb726 | 35 | is ($k, 1, "got index when only index was assigned to variable"); |
878d132a | 36 | |
e1dccc0d | 37 | my @lex_array = qw(PLOP SKLIZZORCH RATTLE); |
878d132a NC |
38 | |
39 | (@r) = each @lex_array; | |
4c0cb726 JK |
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"); | |
878d132a | 43 | ($k, $v) = each @lex_array; |
4c0cb726 JK |
44 | is ($k, 1, "got expected index of next element"); |
45 | is ($v, 'SKLIZZORCH', "got expected value of next element"); | |
878d132a | 46 | ($k) = each @lex_array; |
4c0cb726 | 47 | is ($k, 2, "got expected index of remaining element"); |
878d132a | 48 | (@r) = each @lex_array; |
4c0cb726 JK |
49 | is (scalar @r, 0, |
50 | "no elements remaining to be iterated over in original array"); | |
878d132a NC |
51 | |
52 | my $ar = ['bacon']; | |
53 | ||
54 | (@r) = each @$ar; | |
4c0cb726 JK |
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"); | |
878d132a NC |
59 | |
60 | (@r) = each @$ar; | |
4c0cb726 JK |
61 | is (scalar @r, 0, |
62 | "no elements remaining to be iterated over in array inside reference"); | |
878d132a | 63 | |
4c0cb726 JK |
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"); | |
878d132a NC |
67 | |
68 | my @keys; | |
69 | @keys = keys @array; | |
4c0cb726 JK |
70 | is ("@keys", "0 1 2", |
71 | "'keys' on array in list context returns list of indices"); | |
878d132a NC |
72 | |
73 | @keys = keys @lex_array; | |
4c0cb726 JK |
74 | is ("@keys", "0 1 2", |
75 | "'keys' on another array in list context returns list of indices"); | |
878d132a NC |
76 | |
77 | ($k, $v) = each @array; | |
4c0cb726 JK |
78 | is ($k, 0, "got expected index"); |
79 | is ($v, 'crunch', "got expected value"); | |
878d132a NC |
80 | |
81 | @keys = keys @array; | |
4c0cb726 JK |
82 | is ("@keys", "0 1 2", |
83 | "'keys' on array in list context returns list of indices"); | |
878d132a NC |
84 | |
85 | ($k, $v) = each @array; | |
4c0cb726 JK |
86 | is ($k, 0, "following 'keys', got expected index"); |
87 | is ($v, 'crunch', "following 'keys', got expected value"); | |
878d132a NC |
88 | |
89 | ||
90 | ||
91 | my @values; | |
92 | @values = values @array; | |
4c0cb726 JK |
93 | is ("@values", "@array", |
94 | "'values' on array returns list of values"); | |
878d132a NC |
95 | |
96 | @values = values @lex_array; | |
4c0cb726 JK |
97 | is ("@values", "@lex_array", |
98 | "'values' on another array returns list of values"); | |
878d132a | 99 | |
878d132a | 100 | ($k, $v) = each @array; |
4c0cb726 JK |
101 | is ($k, 0, "following 'values', got expected index"); |
102 | is ($v, 'crunch', "following 'values', got expected index"); | |
878d132a NC |
103 | |
104 | @values = values @array; | |
4c0cb726 JK |
105 | is ("@values", "@array", |
106 | "following 'values' and 'each', 'values' continues to return expected list of values"); | |
878d132a NC |
107 | |
108 | ($k, $v) = each @array; | |
4c0cb726 JK |
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"); | |
459b64da HY |
113 | |
114 | # reset | |
459b64da HY |
115 | while (each @array) { } |
116 | ||
117 | # each(ARRAY) in the conditional loop | |
118 | $c = 0; | |
119 | while (($k, $v) = each @array) { | |
4c0cb726 JK |
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]'"); | |
459b64da HY |
123 | $c++; |
124 | } | |
125 | ||
126 | # each(ARRAY) on scalar context in conditional loop | |
127 | # should guarantee to be wrapped into defined() function. | |
e1dccc0d | 128 | # first return value will be 0 --> [#90888] |
459b64da HY |
129 | $c = 0; |
130 | $k = 0; | |
131 | $v = 0; | |
132 | while ($k = each @array) { | |
4c0cb726 JK |
133 | is ($k, $v, |
134 | "'each' on array in scalar context in loop returns expected index '$v'"); | |
459b64da HY |
135 | $v++; |
136 | } | |
137 | ||
138 | # each(ARRAY) in the conditional loop | |
139 | $c = 0; | |
140 | for (; ($k, $v) = each @array ;) { | |
4c0cb726 JK |
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]'"); | |
459b64da HY |
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) ;) { | |
4c0cb726 JK |
154 | is ($k, $v, |
155 | "'each' on array in scalar context in loop returns expected index '$v'"); | |
459b64da HY |
156 | $v++; |
157 | } | |
83f29afa VP |
158 | |
159 | # Reset the iterator when the array is cleared [RT #75596] | |
160 | { | |
161 | my @a = 'a' .. 'c'; | |
162 | my ($i, $v) = each @a; | |
4c0cb726 | 163 | is ("$i-$v", '0-a', "got expected index and value"); |
83f29afa VP |
164 | @a = 'A' .. 'C'; |
165 | ($i, $v) = each @a; | |
4c0cb726 JK |
166 | is ("$i-$v", '0-A', |
167 | "got expected new index and value after array gets new content"); | |
83f29afa VP |
168 | } |
169 | ||
170 | # Check that the iterator is reset when localization ends | |
171 | { | |
172 | @array = 'a' .. 'c'; | |
173 | my ($i, $v) = each @array; | |
4c0cb726 | 174 | is ("$i-$v", '0-a', "got expected index and value"); |
83f29afa VP |
175 | { |
176 | local @array = 'A' .. 'C'; | |
177 | my ($i, $v) = each @array; | |
4c0cb726 JK |
178 | is ("$i-$v", '0-A', |
179 | "got expected new index and value after array is localized and gets new content"); | |
83f29afa | 180 | ($i, $v) = each @array; |
4c0cb726 JK |
181 | is ("$i-$v", '1-B', |
182 | "got expected next index and value after array is localized and gets new content"); | |
83f29afa VP |
183 | } |
184 | ($i, $v) = each @array; | |
4c0cb726 JK |
185 | is ("$i-$v", '1-b', |
186 | "got expected next index and value upon return to pre-localized array"); | |
83f29afa VP |
187 | # Explicit reset |
188 | while (each @array) { } | |
189 | } |