1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9plan tests => 59; 10 11$h{'abc'} = 'ABC'; 12$h{'def'} = 'DEF'; 13$h{'jkl','mno'} = "JKL\034MNO"; 14$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5); 15$h{'a'} = 'A'; 16$h{'b'} = 'B'; 17$h{'c'} = 'C'; 18$h{'d'} = 'D'; 19$h{'e'} = 'E'; 20$h{'f'} = 'F'; 21$h{'g'} = 'G'; 22$h{'h'} = 'H'; 23$h{'i'} = 'I'; 24$h{'j'} = 'J'; 25$h{'k'} = 'K'; 26$h{'l'} = 'L'; 27$h{'m'} = 'M'; 28$h{'n'} = 'N'; 29$h{'o'} = 'O'; 30$h{'p'} = 'P'; 31$h{'q'} = 'Q'; 32$h{'r'} = 'R'; 33$h{'s'} = 'S'; 34$h{'t'} = 'T'; 35$h{'u'} = 'U'; 36$h{'v'} = 'V'; 37$h{'w'} = 'W'; 38$h{'x'} = 'X'; 39$h{'y'} = 'Y'; 40$h{'z'} = 'Z'; 41 42@keys = keys %h; 43@values = values %h; 44 45is ($#keys, 29, "keys"); 46is ($#values, 29, "values"); 47 48$i = 0; # stop -w complaints 49 50while (($key,$value) = each(%h)) { 51 if ($key eq $keys[$i] && $value eq $values[$i] 52 && (('a' lt 'A' && $key lt $value) || $key gt $value)) { 53 $key =~ y/a-z/A-Z/; 54 $i++ if $key eq $value; 55 } 56} 57 58is ($i, 30, "each count"); 59 60@keys = ('blurfl', keys(%h), 'dyick'); 61is ($#keys, 31, "added a key"); 62 63SKIP: { 64 skip "no Hash::Util on miniperl", 4, if is_miniperl; 65 require Hash::Util; 66 sub Hash::Util::num_buckets (\%); 67 68 $size = Hash::Util::num_buckets(%h); 69 keys %h = $size * 5; 70 $newsize = Hash::Util::num_buckets(%h); 71 is ($newsize, $size * 8, "resize"); 72 keys %h = 1; 73 $size = Hash::Util::num_buckets(%h); 74 is ($size, $newsize, "same size"); 75 %h = (1,1); 76 $size = Hash::Util::num_buckets(%h); 77 is ($size, $newsize, "still same size"); 78 undef %h; 79 %h = (1,1); 80 $size = Hash::Util::num_buckets(%h); 81 is ($size, 8, "size 8"); 82} 83 84# test scalar each 85%hash = 1..20; 86$total = 0; 87$total += $key while $key = each %hash; 88is ($total, 100, "test scalar each"); 89 90for (1..3) { @foo = each %hash } 91keys %hash; 92$total = 0; 93$total += $key while $key = each %hash; 94is ($total, 100, "test scalar keys resets iterator"); 95 96for (1..3) { @foo = each %hash } 97$total = 0; 98$total += $key while $key = each %hash; 99isnt ($total, 100, "test iterator of each is being maintained"); 100 101for (1..3) { @foo = each %hash } 102values %hash; 103$total = 0; 104$total += $key while $key = each %hash; 105is ($total, 100, "test values keys resets iterator"); 106 107SKIP: { 108 skip "no Hash::Util on miniperl", 3, if is_miniperl; 109 require Hash::Util; 110 sub Hash::Util::num_buckets (\%); 111 112 $size = Hash::Util::num_buckets(%hash); 113 keys(%hash) = $size / 2; 114 is ($size, Hash::Util::num_buckets(%hash), 115 "assign to keys does not shrink hash bucket array"); 116 keys(%hash) = $size + 100; 117 isnt ($size, Hash::Util::num_buckets(%hash), 118 "assignment to keys of a number not large enough does not change size"); 119 is (keys(%hash), 10, "keys (%hash)"); 120} 121 122@tests = (&next_test, &next_test, &next_test); 123{ 124 package Obj; 125 sub DESTROY { print "ok $::tests[1] # DESTROY called\n"; } 126 { 127 my $h = { A => bless [], __PACKAGE__ }; 128 while (my($k,$v) = each %$h) { 129 print "ok $::tests[0]\n" if $k eq 'A' and ref($v) eq 'Obj'; 130 } 131 } 132 print "ok $::tests[2]\n"; 133} 134 135# Check for Unicode hash keys. 136%u = ("\x{12}", "f", "\x{123}", "fo", "\x{1234}", "foo"); 137$u{"\x{12345}"} = "bar"; 138@u{"\x{10FFFD}"} = "zap"; 139 140my %u2; 141foreach (keys %u) { 142 is (length(), 1, "Check length of " . _qq $_); 143 $u2{$_} = $u{$_}; 144} 145ok (eq_hash(\%u, \%u2), "copied unicode hash keys correctly?"); 146 147$a = "\xe3\x81\x82"; $A = "\x{3042}"; 148%b = ( $a => "non-utf8"); 149%u = ( $A => "utf8"); 150 151is (exists $b{$A}, '', "utf8 key in bytes hash"); 152is (exists $u{$a}, '', "bytes key in utf8 hash"); 153print "# $b{$_}\n" for keys %b; # Used to core dump before change #8056. 154pass ("if we got here change 8056 worked"); 155print "# $u{$_}\n" for keys %u; # Used to core dump before change #8056. 156pass ("change 8056 is thanks to Inaba Hiroto"); 157 158# on EBCDIC chars are mapped differently so pick something that needs encoding 159# there too. 160$d = pack("U*", 0xe3, 0x81, 0xAF); 161{ use bytes; $ol = bytes::length($d) } 162cmp_ok ($ol, '>', 3, "check encoding on EBCDIC"); 163%u = ($d => "downgrade"); 164for (keys %u) { 165 is (length, 3, "check length"); 166 is ($_, pack("U*", 0xe3, 0x81, 0xAF), "check value"); 167} 168{ 169 { use bytes; is (bytes::length($d), $ol) } 170} 171 172{ 173 my %u; 174 my $u0 = pack("U0U", 0x00FF); 175 my $b0 = "\xC3\xBF"; # 0xCB 0xBF is U+00FF in UTF-8 176 my $u1 = pack("U0U", 0x0100); 177 my $b1 = "\xC4\x80"; # 0xC4 0x80 is U+0100 in UTF-8 178 179 $u{$u0} = 1; 180 $u{$b0} = 2; 181 $u{$u1} = 3; 182 $u{$b1} = 4; 183 184 is(scalar keys %u, 4, "four different Unicode keys"); 185 is($u{$u0}, 1, "U+00FF -> 1"); 186 is($u{$b0}, 2, "U+00C3 U+00BF -> 2"); 187 is($u{$u1}, 3, "U+0100 -> 3 "); 188 is($u{$b1}, 4, "U+00C4 U+0080 -> 4"); 189} 190 191# test for syntax errors 192for my $k (qw(each keys values)) { 193 eval $k; 194 like($@, qr/^Not enough arguments for $k/, "$k demands argument"); 195} 196 197{ 198 my %foo=(1..10); 199 my ($k,$v); 200 my $count=keys %foo; 201 my ($k1,$v1)=each(%foo); 202 my $yes = 0; 203 if (%foo) { $yes++ } 204 my ($k2,$v2)=each(%foo); 205 my $rest=0; 206 while (each(%foo)) {$rest++}; 207 is($yes,1,"if(%foo) was true - my"); 208 isnt($k1,$k2,"if(%foo) didnt mess with each (key) - my"); 209 isnt($v1,$v2,"if(%foo) didnt mess with each (value) - my"); 210 is($rest,3,"Got the expected number of keys - my"); 211 my $hsv=1 && %foo; 212 is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - my"); 213 my @arr=%foo&&%foo; 214 is(@arr,10,"Got expected number of elements in list context - my"); 215} 216{ 217 our %foo=(1..10); 218 my ($k,$v); 219 my $count=keys %foo; 220 my ($k1,$v1)=each(%foo); 221 my $yes = 0; 222 if (%foo) { $yes++ } 223 my ($k2,$v2)=each(%foo); 224 my $rest=0; 225 while (each(%foo)) {$rest++}; 226 is($yes,1,"if(%foo) was true - our"); 227 isnt($k1,$k2,"if(%foo) didnt mess with each (key) - our"); 228 isnt($v1,$v2,"if(%foo) didnt mess with each (value) - our"); 229 is($rest,3,"Got the expected number of keys - our"); 230 my $hsv=1 && %foo; 231 is($hsv,$count,"Got the count of keys from %foo in scalar assignment context - our"); 232 my @arr=%foo&&%foo; 233 is(@arr,10,"Got expected number of elements in list context - our"); 234} 235{ 236 # make sure a deleted active iterator gets freed timely, even if the 237 # hash is otherwise empty 238 239 package Single; 240 241 my $c = 0; 242 sub DESTROY { $c++ }; 243 244 { 245 my %h = ("a" => bless []); 246 my ($k,$v) = each %h; 247 delete $h{$k}; 248 ::is($c, 0, "single key not yet freed"); 249 } 250 ::is($c, 1, "single key now freed"); 251} 252 253{ 254 # Make sure each() does not leave the iterator in an inconsistent state 255 # (RITER set to >= 0, with EITER null) if the active iterator is 256 # deleted, leaving the hash apparently empty. 257 my %h; 258 $h{1} = 2; 259 each %h; 260 delete $h{1}; 261 each %h; 262 $h{1}=2; 263 is join ("-", each %h), '1-2', 264 'each on apparently empty hash does not leave RITER set'; 265} 266{ 267 my $warned= 0; 268 local $SIG{__WARN__}= sub { 269 /\QUse of each() on hash after insertion without resetting hash iterator results in undefined behavior\E/ 270 and $warned++ for @_; 271 }; 272 my %h= map { $_ => $_ } "A".."F"; 273 while (my ($k, $v)= each %h) { 274 $h{"$k$k"}= $v; 275 } 276 ok($warned,"each() after insert produces warnings"); 277 no warnings 'internal'; 278 $warned= 0; 279 %h= map { $_ => $_ } "A".."F"; 280 while (my ($k, $v)= each %h) { 281 $h{"$k$k"}= $v; 282 } 283 ok(!$warned, "no warnings 'internal' silences each() after insert warnings"); 284} 285 286use feature 'refaliasing'; 287no warnings 'experimental::refaliasing'; 288$a = 7; 289\$h2{f} = \$a; 290($a, $b) = (each %h2); 291is "$a $b", "f 7", 'each in list assignment'; 292$a = 7; 293($a, $b) = (3, values %h2); 294is "$a $b", "3 7", 'values in list assignment'; 295