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; | |
17 | is (scalar @r, 2); | |
18 | is ($r[0], 0); | |
19 | is ($r[1], 'crunch'); | |
20 | ($k, $v) = each @array; | |
21 | is ($k, 1); | |
22 | is ($v, 'zam'); | |
23 | ($k, $v) = each @array; | |
24 | is ($k, 2); | |
25 | is ($v, 'bloop'); | |
26 | (@r) = each @array; | |
27 | is (scalar @r, 0); | |
28 | ||
29 | (@r) = each @array; | |
30 | is (scalar @r, 2); | |
31 | is ($r[0], 0); | |
32 | is ($r[1], 'crunch'); | |
33 | ($k) = each @array; | |
34 | is ($k, 1); | |
878d132a | 35 | |
e1dccc0d | 36 | my @lex_array = qw(PLOP SKLIZZORCH RATTLE); |
878d132a NC |
37 | |
38 | (@r) = each @lex_array; | |
39 | is (scalar @r, 2); | |
40 | is ($r[0], 0); | |
41 | is ($r[1], 'PLOP'); | |
42 | ($k, $v) = each @lex_array; | |
43 | is ($k, 1); | |
44 | is ($v, 'SKLIZZORCH'); | |
45 | ($k) = each @lex_array; | |
46 | is ($k, 2); | |
878d132a NC |
47 | (@r) = each @lex_array; |
48 | is (scalar @r, 0); | |
49 | ||
50 | my $ar = ['bacon']; | |
51 | ||
52 | (@r) = each @$ar; | |
53 | is (scalar @r, 2); | |
54 | is ($r[0], 0); | |
55 | is ($r[1], 'bacon'); | |
56 | ||
57 | (@r) = each @$ar; | |
58 | is (scalar @r, 0); | |
59 | ||
60 | is (each @$ar, 0); | |
61 | is (scalar each @$ar, undef); | |
62 | ||
63 | my @keys; | |
64 | @keys = keys @array; | |
65 | is ("@keys", "0 1 2"); | |
66 | ||
67 | @keys = keys @lex_array; | |
e1dccc0d | 68 | is ("@keys", "0 1 2"); |
878d132a NC |
69 | |
70 | ($k, $v) = each @array; | |
71 | is ($k, 0); | |
72 | is ($v, 'crunch'); | |
73 | ||
74 | @keys = keys @array; | |
75 | is ("@keys", "0 1 2"); | |
76 | ||
77 | ($k, $v) = each @array; | |
78 | is ($k, 0); | |
79 | is ($v, 'crunch'); | |
80 | ||
81 | ||
82 | ||
83 | my @values; | |
84 | @values = values @array; | |
85 | is ("@values", "@array"); | |
86 | ||
87 | @values = values @lex_array; | |
88 | is ("@values", "@lex_array"); | |
89 | ||
878d132a NC |
90 | ($k, $v) = each @array; |
91 | is ($k, 0); | |
92 | is ($v, 'crunch'); | |
93 | ||
94 | @values = values @array; | |
95 | is ("@values", "@array"); | |
96 | ||
97 | ($k, $v) = each @array; | |
98 | is ($k, 0); | |
99 | is ($v, 'crunch'); | |
459b64da HY |
100 | |
101 | # reset | |
459b64da HY |
102 | while (each @array) { } |
103 | ||
104 | # each(ARRAY) in the conditional loop | |
105 | $c = 0; | |
106 | while (($k, $v) = each @array) { | |
107 | is ($k, $c); | |
108 | is ($v, $array[$k]); | |
109 | $c++; | |
110 | } | |
111 | ||
112 | # each(ARRAY) on scalar context in conditional loop | |
113 | # should guarantee to be wrapped into defined() function. | |
e1dccc0d | 114 | # first return value will be 0 --> [#90888] |
459b64da HY |
115 | $c = 0; |
116 | $k = 0; | |
117 | $v = 0; | |
118 | while ($k = each @array) { | |
119 | is ($k, $v); | |
120 | $v++; | |
121 | } | |
122 | ||
123 | # each(ARRAY) in the conditional loop | |
124 | $c = 0; | |
125 | for (; ($k, $v) = each @array ;) { | |
126 | is ($k, $c); | |
127 | is ($v, $array[$k]); | |
128 | $c++; | |
129 | } | |
130 | ||
131 | # each(ARRAY) on scalar context in conditional loop | |
132 | # --> [#90888] | |
133 | $c = 0; | |
134 | $k = 0; | |
135 | $v = 0; | |
136 | for (; $k = each(@array) ;) { | |
137 | is ($k, $v); | |
138 | $v++; | |
139 | } | |
83f29afa VP |
140 | |
141 | # Reset the iterator when the array is cleared [RT #75596] | |
142 | { | |
143 | my @a = 'a' .. 'c'; | |
144 | my ($i, $v) = each @a; | |
145 | is ("$i-$v", '0-a'); | |
146 | @a = 'A' .. 'C'; | |
147 | ($i, $v) = each @a; | |
148 | is ("$i-$v", '0-A'); | |
149 | } | |
150 | ||
151 | # Check that the iterator is reset when localization ends | |
152 | { | |
153 | @array = 'a' .. 'c'; | |
154 | my ($i, $v) = each @array; | |
155 | is ("$i-$v", '0-a'); | |
156 | { | |
157 | local @array = 'A' .. 'C'; | |
158 | my ($i, $v) = each @array; | |
159 | is ("$i-$v", '0-A'); | |
160 | ($i, $v) = each @array; | |
161 | is ("$i-$v", '1-B'); | |
162 | } | |
163 | ($i, $v) = each @array; | |
164 | is ("$i-$v", '1-b'); | |
165 | # Explicit reset | |
166 | while (each @array) { } | |
167 | } |