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 no warnings 'deprecated';
  11 use vars qw(@array @r $k $v);
  12
  13 plan tests => 48;
  14
  15 @array = qw(crunch zam bloop);
  16
  17 (@r) = each @array;
  18 is (scalar @r, 2);
  19 is ($r[0], 0);
  20 is ($r[1], 'crunch');
  21 ($k, $v) = each @array;
  22 is ($k, 1);
  23 is ($v, 'zam');
  24 ($k, $v) = each @array;
  25 is ($k, 2);
  26 is ($v, 'bloop');
  27 (@r) = each @array;
  28 is (scalar @r, 0);
  29
  30 (@r) = each @array;
  31 is (scalar @r, 2);
  32 is ($r[0], 0);
  33 is ($r[1], 'crunch');
  34 ($k) = each @array;
  35 is ($k, 1);
  36 {
  37     $[ = 2;
  38     my ($k, $v) = each @array;
  39     is ($k, 4);
  40     is ($v, 'bloop');
  41     (@r) = each @array;
  42     is (scalar @r, 0);
  43 }
  44
  45 my @lex_array = qw(PLOP SKLIZZORCH RATTLE PBLRBLPSFT);
  46
  47 (@r) = each @lex_array;
  48 is (scalar @r, 2);
  49 is ($r[0], 0);
  50 is ($r[1], 'PLOP');
  51 ($k, $v) = each @lex_array;
  52 is ($k, 1);
  53 is ($v, 'SKLIZZORCH');
  54 ($k) = each @lex_array;
  55 is ($k, 2);
  56 {
  57     $[ = -42;
  58     my ($k, $v) = each @lex_array;
  59     is ($k, -39);
  60     is ($v, 'PBLRBLPSFT');
  61 }
  62 (@r) = each @lex_array;
  63 is (scalar @r, 0);
  64
  65 my $ar = ['bacon'];
  66
  67 (@r) = each @$ar;
  68 is (scalar @r, 2);
  69 is ($r[0], 0);
  70 is ($r[1], 'bacon');
  71
  72 (@r) = each @$ar;
  73 is (scalar @r, 0);
  74
  75 is (each @$ar, 0);
  76 is (scalar each @$ar, undef);
  77
  78 my @keys;
  79 @keys = keys @array;
  80 is ("@keys", "0 1 2");
  81
  82 @keys = keys @lex_array;
  83 is ("@keys", "0 1 2 3");
  84
  85 {
  86     $[ = 1;
  87
  88     @keys = keys @array;
  89     is ("@keys", "1 2 3");
  90
  91     @keys = keys @lex_array;
  92     is ("@keys", "1 2 3 4");
  93 }
  94
  95 ($k, $v) = each @array;
  96 is ($k, 0);
  97 is ($v, 'crunch');
  98
  99 @keys = keys @array;
 100 is ("@keys", "0 1 2");
 101
 102 ($k, $v) = each @array;
 103 is ($k, 0);
 104 is ($v, 'crunch');
 105
 106
 107
 108 my @values;
 109 @values = values @array;
 110 is ("@values", "@array");
 111
 112 @values = values @lex_array;
 113 is ("@values", "@lex_array");
 114
 115 {
 116     $[ = 1;
 117
 118     @values = values @array;
 119     is ("@values", "@array");
 120
 121     @values = values @lex_array;
 122     is ("@values", "@lex_array");
 123 }
 124
 125 ($k, $v) = each @array;
 126 is ($k, 0);
 127 is ($v, 'crunch');
 128
 129 @values = values @array;
 130 is ("@values", "@array");
 131
 132 ($k, $v) = each @array;
 133 is ($k, 0);
 134 is ($v, 'crunch');