This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlapi: Slightly change names of two sections
[perl5.git] / t / op / each.t
CommitLineData
8d063cd8
LW
1#!./perl
2
a9be8dd0
KW
3use strict;
4use warnings;
5
f9a63242
JH
6BEGIN {
7 chdir 't' if -d 't';
677fb045 8 require './test.pl';
bbeb2775 9 require './charset_tools.pl';
624c42e2 10 set_up_inc('../lib');
c4d5f83a 11}
f9a63242 12
a9be8dd0 13my %h;
8d063cd8
LW
14$h{'abc'} = 'ABC';
15$h{'def'} = 'DEF';
a687059c
LW
16$h{'jkl','mno'} = "JKL\034MNO";
17$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
8d063cd8
LW
18$h{'a'} = 'A';
19$h{'b'} = 'B';
20$h{'c'} = 'C';
21$h{'d'} = 'D';
22$h{'e'} = 'E';
23$h{'f'} = 'F';
24$h{'g'} = 'G';
25$h{'h'} = 'H';
26$h{'i'} = 'I';
27$h{'j'} = 'J';
28$h{'k'} = 'K';
29$h{'l'} = 'L';
30$h{'m'} = 'M';
31$h{'n'} = 'N';
32$h{'o'} = 'O';
33$h{'p'} = 'P';
34$h{'q'} = 'Q';
35$h{'r'} = 'R';
36$h{'s'} = 'S';
37$h{'t'} = 'T';
38$h{'u'} = 'U';
39$h{'v'} = 'V';
40$h{'w'} = 'W';
41$h{'x'} = 'X';
42$h{'y'} = 'Y';
43$h{'z'} = 'Z';
44
a9be8dd0
KW
45my @keys = keys %h;
46my @values = values %h;
8d063cd8 47
59e20782
NC
48is ($#keys, 29, "keys");
49is ($#values, 29, "values");
8d063cd8 50
a9be8dd0 51my $i = 0; # stop -w complaints
75039078 52
a9be8dd0 53while (my ($key,$value) = each(%h)) {
9d116dd7
JH
54 if ($key eq $keys[$i] && $value eq $values[$i]
55 && (('a' lt 'A' && $key lt $value) || $key gt $value)) {
8d063cd8
LW
56 $key =~ y/a-z/A-Z/;
57 $i++ if $key eq $value;
58 }
59}
60
59e20782 61is ($i, 30, "each count");
378cc40b 62
a687059c 63@keys = ('blurfl', keys(%h), 'dyick');
59e20782 64is ($#keys, 31, "added a key");
75039078 65
cf8db57b
JH
66SKIP: {
67 skip "no Hash::Util on miniperl", 4, if is_miniperl;
68 require Hash::Util;
69 sub Hash::Util::num_buckets (\%);
70
a9be8dd0 71 my $size = Hash::Util::num_buckets(%h);
cf8db57b 72 keys %h = $size * 5;
a9be8dd0 73 my $newsize = Hash::Util::num_buckets(%h);
cf8db57b
JH
74 is ($newsize, $size * 8, "resize");
75 keys %h = 1;
76 $size = Hash::Util::num_buckets(%h);
77 is ($size, $newsize, "same size");
78 %h = (1,1);
79 $size = Hash::Util::num_buckets(%h);
80 is ($size, $newsize, "still same size");
81 undef %h;
82 %h = (1,1);
83 $size = Hash::Util::num_buckets(%h);
84 is ($size, 8, "size 8");
85}
3524d3b9
TP
86
87# test scalar each
a9be8dd0
KW
88my %hash = 1..20;
89my $total = 0;
90my $key;
3524d3b9 91$total += $key while $key = each %hash;
59e20782 92is ($total, 100, "test scalar each");
3524d3b9 93
a9be8dd0 94for (1..3) { my @foo = each %hash }
3524d3b9
TP
95keys %hash;
96$total = 0;
97$total += $key while $key = each %hash;
59e20782 98is ($total, 100, "test scalar keys resets iterator");
3524d3b9 99
a9be8dd0 100for (1..3) { my @foo = each %hash }
3524d3b9
TP
101$total = 0;
102$total += $key while $key = each %hash;
59e20782 103isnt ($total, 100, "test iterator of each is being maintained");
3524d3b9 104
a9be8dd0 105for (1..3) { my @foo = each %hash }
3524d3b9
TP
106values %hash;
107$total = 0;
108$total += $key while $key = each %hash;
59e20782 109is ($total, 100, "test values keys resets iterator");
3524d3b9 110
fe949405 111is (keys(%hash), 10, "keys (%hash)");
cf8db57b 112SKIP: {
fe949405 113 skip "no Hash::Util on miniperl", 8, if is_miniperl;
cf8db57b
JH
114 require Hash::Util;
115 sub Hash::Util::num_buckets (\%);
116
a9be8dd0 117 my $size = Hash::Util::num_buckets(%hash);
fe949405
NC
118 cmp_ok($size, '>=', keys %hash, 'sanity check - more buckets than keys');
119 %hash = ();
120 is(Hash::Util::num_buckets(%hash), $size,
121 "size doesn't change when hash is emptied");
122
123 %hash = split /, /, 'Pugh, Pugh, Barney McGrew, Cuthbert, Dibble, Grubb';
124 is (keys(%hash), 3, "now 3 keys");
125 # 3 keys won't be enough to trigger any "must grow" criteria:
126 is(Hash::Util::num_buckets(%hash), $size,
127 "size doesn't change with 3 keys");
128
129 keys(%hash) = keys(%hash);
130 is (Hash::Util::num_buckets(%hash), $size,
cf8db57b 131 "assign to keys does not shrink hash bucket array");
fe949405 132 is (keys(%hash), 3, "still 3 keys");
cf8db57b 133 keys(%hash) = $size + 100;
fe949405
NC
134 cmp_ok(Hash::Util::num_buckets(%hash), '>', $size,
135 "assign to keys will grow hash bucket array");
136 is (keys(%hash), 3, "but still 3 keys");
cf8db57b 137}
3524d3b9 138
a9be8dd0 139@::tests = (&next_test, &next_test, &next_test);
59af0135
GS
140{
141 package Obj;
677fb045 142 sub DESTROY { print "ok $::tests[1] # DESTROY called\n"; }
59af0135
GS
143 {
144 my $h = { A => bless [], __PACKAGE__ };
145 while (my($k,$v) = each %$h) {
677fb045 146 print "ok $::tests[0]\n" if $k eq 'A' and ref($v) eq 'Obj';
59af0135
GS
147 }
148 }
677fb045 149 print "ok $::tests[2]\n";
59af0135
GS
150}
151
f2b0cce7 152# Check for Unicode hash keys.
a9be8dd0 153my %u = ("\x{12}", "f", "\x{123}", "fo", "\x{1234}", "foo");
f2b0cce7 154$u{"\x{12345}"} = "bar";
b851fbc1 155@u{"\x{10FFFD}"} = "zap";
f2b0cce7 156
677fb045 157my %u2;
f2b0cce7 158foreach (keys %u) {
59e20782 159 is (length(), 1, "Check length of " . _qq $_);
677fb045 160 $u2{$_} = $u{$_};
f2b0cce7 161}
677fb045 162ok (eq_hash(\%u, \%u2), "copied unicode hash keys correctly?");
ca9dc00c 163
bbeb2775 164my $a = byte_utf8a_to_utf8n("\xe3\x81\x82"); my $A = "\x{3042}";
a9be8dd0 165my %b = ( $a => "non-utf8");
ca9dc00c
IH
166%u = ( $A => "utf8");
167
59e20782
NC
168is (exists $b{$A}, '', "utf8 key in bytes hash");
169is (exists $u{$a}, '', "bytes key in utf8 hash");
169da838 170print "# $b{$_}\n" for keys %b; # Used to core dump before change #8056.
677fb045 171pass ("if we got here change 8056 worked");
169da838 172print "# $u{$_}\n" for keys %u; # Used to core dump before change #8056.
677fb045 173pass ("change 8056 is thanks to Inaba Hiroto");
f9a63242 174
3ea3bee8
JH
175{
176 my %u;
bbeb2775
KW
177 my $u0 = pack("U0U", 0x00B6);
178 my $b0 = byte_utf8a_to_utf8n("\xC2\xB6"); # 0xC2 0xB6 is U+00B6 in UTF-8
3ea3bee8 179 my $u1 = pack("U0U", 0x0100);
bbeb2775 180 my $b1 = byte_utf8a_to_utf8n("\xC4\x80"); # 0xC4 0x80 is U+0100 in UTF-8
3ea3bee8
JH
181
182 $u{$u0} = 1;
183 $u{$b0} = 2;
184 $u{$u1} = 3;
185 $u{$b1} = 4;
186
187 is(scalar keys %u, 4, "four different Unicode keys");
bbeb2775
KW
188 is($u{$u0}, 1, "U+00B6 -> 1");
189 is($u{$b0}, 2, "U+00C2 U+00B6 -> 2");
3ea3bee8
JH
190 is($u{$u1}, 3, "U+0100 -> 3 ");
191 is($u{$b1}, 4, "U+00C4 U+0080 -> 4");
192}
a916b302
RGS
193
194# test for syntax errors
195for my $k (qw(each keys values)) {
196 eval $k;
197 like($@, qr/^Not enough arguments for $k/, "$k demands argument");
198}
867fa1e2
YO
199
200{
201 my %foo=(1..10);
202 my ($k,$v);
203 my $count=keys %foo;
204 my ($k1,$v1)=each(%foo);
205 my $yes = 0;
206 if (%foo) { $yes++ }
207 my ($k2,$v2)=each(%foo);
208 my $rest=0;
209 while (each(%foo)) {$rest++};
8bf4c401
YO
210 is($yes,1,"if(%foo) was true - my");
211 isnt($k1,$k2,"if(%foo) didnt mess with each (key) - my");
212 isnt($v1,$v2,"if(%foo) didnt mess with each (value) - my");
213 is($rest,3,"Got the expected number of keys - my");
867fa1e2 214 my $hsv=1 && %foo;
8bf4c401 215 is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - my");
aaf643ce 216 my @arr=%foo&&%foo;
8bf4c401 217 is(@arr,10,"Got expected number of elements in list context - my");
867fa1e2
YO
218}
219{
220 our %foo=(1..10);
221 my ($k,$v);
222 my $count=keys %foo;
223 my ($k1,$v1)=each(%foo);
224 my $yes = 0;
225 if (%foo) { $yes++ }
226 my ($k2,$v2)=each(%foo);
227 my $rest=0;
228 while (each(%foo)) {$rest++};
8bf4c401
YO
229 is($yes,1,"if(%foo) was true - our");
230 isnt($k1,$k2,"if(%foo) didnt mess with each (key) - our");
231 isnt($v1,$v2,"if(%foo) didnt mess with each (value) - our");
232 is($rest,3,"Got the expected number of keys - our");
867fa1e2 233 my $hsv=1 && %foo;
8bf4c401 234 is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - our");
aaf643ce 235 my @arr=%foo&&%foo;
8bf4c401 236 is(@arr,10,"Got expected number of elements in list context - our");
867fa1e2 237}
00a1a643
DM
238{
239 # make sure a deleted active iterator gets freed timely, even if the
240 # hash is otherwise empty
241
242 package Single;
243
244 my $c = 0;
245 sub DESTROY { $c++ };
246
247 {
248 my %h = ("a" => bless []);
249 my ($k,$v) = each %h;
250 delete $h{$k};
251 ::is($c, 0, "single key not yet freed");
252 }
253 ::is($c, 1, "single key now freed");
254}
41aa816f
FC
255
256{
257 # Make sure each() does not leave the iterator in an inconsistent state
258 # (RITER set to >= 0, with EITER null) if the active iterator is
259 # deleted, leaving the hash apparently empty.
260 my %h;
261 $h{1} = 2;
262 each %h;
263 delete $h{1};
264 each %h;
265 $h{1}=2;
266 is join ("-", each %h), '1-2',
267 'each on apparently empty hash does not leave RITER set';
268}
a7b39f85
YO
269{
270 my $warned= 0;
271 local $SIG{__WARN__}= sub {
272 /\QUse of each() on hash after insertion without resetting hash iterator results in undefined behavior\E/
273 and $warned++ for @_;
274 };
275 my %h= map { $_ => $_ } "A".."F";
276 while (my ($k, $v)= each %h) {
277 $h{"$k$k"}= $v;
278 }
279 ok($warned,"each() after insert produces warnings");
280 no warnings 'internal';
281 $warned= 0;
282 %h= map { $_ => $_ } "A".."F";
283 while (my ($k, $v)= each %h) {
284 $h{"$k$k"}= $v;
285 }
286 ok(!$warned, "no warnings 'internal' silences each() after insert warnings");
287}
e893e12c
NC
288{
289 # Test that the call to hv_iternext_flags() that calls prime_env_iter()
290 # produces the results consistent with subsequent iterations of %ENV
291 my $raw = run_perl(switches => ['-l'],
292 prog => 'for (1,2) { @a = keys %ENV; print scalar @a; print for @a }');
293 my @lines = split /\n/, $raw;
294 my $count1 = shift @lines;
295 my @got1 = splice @lines, 0, $count1;
296 my $count2 = shift @lines;
297 is($count1, $count2, 'both iterations of %ENV returned the same count of keys');
298 is(scalar @lines, $count2, 'second iteration of %ENV printed all keys');
299 is(join("\n", sort @got1), join("\n", sort @lines), 'both iterations of %ENV returned identical keys');
300}
d86b3122 301
00164771
NC
302fresh_perl_like('$a = keys %ENV; $b = () = keys %ENV; $c = keys %ENV; print qq=$a,$b,$c=',
303 qr/^([1-9][0-9]*),\1,\1$/,
304 undef,
305 'keys %ENV in scalar context triggers prime_env_iter if needed');
306fresh_perl_like('$a = $ENV{PATH}; $a = $ENV{q=DCL$PATH=}; $a = keys %ENV; $b = () = keys %ENV; $c = keys %ENV; print qq=$a,$b,$c=',
307 qr/^([1-9][0-9]*),\1,\1$/,
308 undef,
309 '%ENV lookup, and keys %ENV in scalar context remain consistent');
310
d86b3122
FC
311use feature 'refaliasing';
312no warnings 'experimental::refaliasing';
313$a = 7;
a9be8dd0 314my %h2;
d86b3122
FC
315\$h2{f} = \$a;
316($a, $b) = (each %h2);
317is "$a $b", "f 7", 'each in list assignment';
318$a = 7;
319($a, $b) = (3, values %h2);
320is "$a $b", "3 7", 'values in list assignment';
fe949405
NC
321
322done_testing();