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);
  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);
  35
  36 my @lex_array = qw(PLOP SKLIZZORCH RATTLE);
  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);
  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;
  68 is ("@keys", "0 1 2");
  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
  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');
 100
 101 # reset
 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.
 114 # first return value will be 0 --> [#90888]
 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 }
 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 }