| 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 | use vars qw(@array @r $k $v $c); |
| 11 | |
| 12 | plan tests => 63; |
| 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 | } |