xref: /openbsd/gnu/usr.bin/perl/t/op/each_array.t (revision 76d0caae) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8use strict;
9use warnings;
10our (@array, @r, $k, $v, $c);
11
12plan tests => 65;
13
14@array = qw(crunch zam bloop);
15
16(@r) = each @array;
17is (scalar @r, 2, "'each' on array returns index and value of next element");
18is ($r[0], 0, "got expected index");
19is ($r[1], 'crunch', "got expected value");
20($k, $v) = each @array;
21is ($k, 1, "got expected index of next element");
22is ($v, 'zam', "got expected value of next element");
23($k, $v) = each @array;
24is ($k, 2, "got expected index of remaining element");
25is ($v, 'bloop', "got expected value of remaining element");
26(@r) = each @array;
27is (scalar @r, 0,
28    "no elements remaining to be iterated over in original array");
29
30(@r) = each @array;
31is (scalar @r, 2, "start second iteration over original array");
32is ($r[0], 0, "got expected index");
33is ($r[1], 'crunch', "got expected value");
34($k) = each @array;
35is ($k, 1, "got index when only index was assigned to variable");
36
37my @lex_array = qw(PLOP SKLIZZORCH RATTLE);
38
39(@r) = each @lex_array;
40is (scalar @r, 2, "'each' on array returns index and value of next element");
41is ($r[0], 0, "got expected index");
42is ($r[1], 'PLOP', "got expected value");
43($k, $v) = each @lex_array;
44is ($k, 1, "got expected index of next element");
45is ($v, 'SKLIZZORCH', "got expected value of next element");
46($k) = each @lex_array;
47is ($k, 2, "got expected index of remaining element");
48(@r) = each @lex_array;
49is (scalar @r, 0,
50    "no elements remaining to be iterated over in original array");
51
52my $ar = ['bacon'];
53
54(@r) = each @$ar;
55is (scalar @r, 2,
56    "'each' on array inside reference returns index and value of next element");
57is ($r[0], 0, "got expected index");
58is ($r[1], 'bacon', "got expected value of array element inside reference");
59
60(@r) = each @$ar;
61is (scalar @r, 0,
62    "no elements remaining to be iterated over in array inside reference");
63
64is (each @$ar, 0, "scalar context 'each' on array returns expected index");
65is (scalar each @$ar, undef,
66    "no elements remaining to be iterated over; array reference case");
67
68my @keys;
69@keys = keys @array;
70is ("@keys", "0 1 2",
71    "'keys' on array in list context returns list of indices");
72
73@keys = keys @lex_array;
74is ("@keys", "0 1 2",
75    "'keys' on another array in list context returns list of indices");
76
77($k, $v) = each @array;
78is ($k, 0, "got expected index");
79is ($v, 'crunch', "got expected value");
80
81@keys = keys @array;
82is ("@keys", "0 1 2",
83    "'keys' on array in list context returns list of indices");
84
85($k, $v) = each @array;
86is ($k, 0, "following 'keys', got expected index");
87is ($v, 'crunch', "following 'keys', got expected value");
88
89
90
91my @values;
92@values = values @array;
93is ("@values", "@array",
94    "'values' on array returns list of values");
95
96@values = values @lex_array;
97is ("@values", "@lex_array",
98    "'values' on another array returns list of values");
99
100($k, $v) = each @array;
101is ($k, 0, "following 'values', got expected index");
102is ($v, 'crunch', "following 'values', got expected index");
103
104@values = values @array;
105is ("@values", "@array",
106    "following 'values' and 'each', 'values' continues to return expected list of values");
107
108($k, $v) = each @array;
109is ($k, 0,
110    "following 'values', 'each' and 'values', 'each' continues to return expected index");
111is ($v, 'crunch',
112    "following 'values', 'each' and 'values', 'each' continues to return expected value");
113
114# reset
115while (each @array) { }
116
117# each(ARRAY) in the conditional loop
118$c = 0;
119while (($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;
132while ($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;
140for (; ($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;
153for (; $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
191my $a = 7;
192*a = sub  { \@_ }->($a);
193($a, $b) = each our @a;
194is "$a $b", "0 7", 'each in list assignment';
195$a = 7;
196($a, $b) = (3, values @a);
197is "$a $b", "3 7", 'values in list assignment';
198