This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
0c1e0804ea85faf9ad0c48f79dddfad16b911b47
[perl5.git] / 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 }