t/op/each_array.t

   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 }