1#!/usr/bin/perl -Tw 2 3BEGIN { 4 if ($ENV{PERL_CORE}) { 5 require Config; import Config; 6 no warnings 'once'; 7 if ($Config{extensions} !~ /\bHash\/Util\b/) { 8 print "1..0 # Skip: Hash::Util was not built\n"; 9 exit 0; 10 } 11 } 12} 13 14use strict; 15use Test::More; 16 17sub numbers_first { # Sort helper: All digit entries sort in front of others 18 # Makes sorting portable across ASCII/EBCDIC 19 return $a cmp $b if ($a =~ /^\d+$/) == ($b =~ /^\d+$/); 20 return -1 if $a =~ /^\d+$/; 21 return 1; 22} 23 24my @Exported_Funcs; 25BEGIN { 26 @Exported_Funcs = qw( 27 fieldhash fieldhashes 28 29 all_keys 30 lock_keys unlock_keys 31 lock_value unlock_value 32 lock_hash unlock_hash 33 lock_keys_plus 34 hash_locked hash_unlocked 35 hashref_locked hashref_unlocked 36 hidden_keys legal_keys 37 38 lock_ref_keys unlock_ref_keys 39 lock_ref_value unlock_ref_value 40 lock_hashref unlock_hashref 41 lock_ref_keys_plus 42 hidden_ref_keys legal_ref_keys 43 44 hash_seed hash_value bucket_stats bucket_info bucket_array 45 hv_store 46 lock_hash_recurse unlock_hash_recurse 47 lock_hashref_recurse unlock_hashref_recurse 48 ); 49 plan tests => 250 + @Exported_Funcs; 50 use_ok 'Hash::Util', @Exported_Funcs; 51} 52foreach my $func (@Exported_Funcs) { 53 can_ok __PACKAGE__, $func; 54} 55 56my %hash = (foo => 42, bar => 23, locked => 'yep'); 57lock_keys(%hash); 58eval { $hash{baz} = 99; }; 59like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/, 60 'lock_keys()'); 61is( $hash{bar}, 23, '$hash{bar} == 23' ); 62ok( !exists $hash{baz},'!exists $hash{baz}' ); 63 64delete $hash{bar}; 65ok( !exists $hash{bar},'!exists $hash{bar}' ); 66$hash{bar} = 69; 67is( $hash{bar}, 69 ,'$hash{bar} == 69'); 68 69eval { () = $hash{i_dont_exist} }; 70like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/, 71 'Disallowed 1' ); 72 73lock_value(%hash, 'locked'); 74eval { print "# oops" if $hash{four} }; 75like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/, 76 'Disallowed 2' ); 77 78eval { $hash{"\x{2323}"} = 3 }; 79like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/, 80 'wide hex key' ); 81 82eval { delete $hash{locked} }; 83like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/, 84 'trying to delete a locked key' ); 85eval { $hash{locked} = 42; }; 86like( $@, qr/^Modification of a read-only value attempted/, 87 'trying to change a locked key' ); 88is( $hash{locked}, 'yep', '$hash{locked} is yep' ); 89 90eval { delete $hash{I_dont_exist} }; 91like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/, 92 'trying to delete a key that doesnt exist' ); 93 94ok( !exists $hash{I_dont_exist},'!exists $hash{I_dont_exist}' ); 95 96unlock_keys(%hash); 97$hash{I_dont_exist} = 42; 98is( $hash{I_dont_exist}, 42, 'unlock_keys' ); 99 100eval { $hash{locked} = 42; }; 101like( $@, qr/^Modification of a read-only value attempted/, 102 ' individual key still readonly' ); 103eval { delete $hash{locked} }, 104is( $@, '', ' but can be deleted :(' ); 105 106unlock_value(%hash, 'locked'); 107$hash{locked} = 42; 108is( $hash{locked}, 42, 'unlock_value' ); 109 110 111{ 112 my %hash = ( foo => 42, locked => 23 ); 113 114 lock_keys(%hash); 115 eval { %hash = ( wubble => 42 ) }; # we know this will bomb 116 like( $@, qr/^Attempt to access disallowed key 'wubble'/,'Disallowed 3' ); 117 unlock_keys(%hash); 118} 119 120{ 121 my %hash = (KEY => 'val', RO => 'val'); 122 lock_keys(%hash); 123 lock_value(%hash, 'RO'); 124 125 eval { %hash = (KEY => 1) }; 126 like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/, 127 'attempt to delete readonly key from restricted hash' ); 128} 129 130{ 131 my %hash = (KEY => 1, RO => 2); 132 lock_keys(%hash); 133 eval { %hash = (KEY => 1, RO => 2) }; 134 is( $@, '', 'No error message, as expected'); 135} 136 137{ 138 my %hash = (); 139 lock_keys(%hash, qw(foo bar)); 140 is( keys %hash, 0, 'lock_keys() w/keyset shouldnt add new keys' ); 141 $hash{foo} = 42; 142 is( keys %hash, 1, '1 element in hash' ); 143 eval { $hash{wibble} = 42 }; 144 like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, 145 'write threw error (locked)'); 146 147 unlock_keys(%hash); 148 eval { $hash{wibble} = 23; }; 149 is( $@, '', 'unlock_keys' ); 150} 151 152{ 153 my %hash = (foo => 42, bar => undef, baz => 0); 154 lock_keys(%hash, qw(foo bar baz up down)); 155 is( keys %hash, 3, 'lock_keys() w/keyset didnt add new keys' ); 156 is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 },'is_deeply' ); 157 158 eval { $hash{up} = 42; }; 159 is( $@, '','No error 1' ); 160 161 eval { $hash{wibble} = 23 }; 162 like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/, 163 'locked "wibble"' ); 164} 165 166{ 167 my %hash = (foo => 42, bar => undef); 168 eval { lock_keys(%hash, qw(foo baz)); }; 169 like( $@, qr/^Hash has key 'bar' which is not in the new key set/, 170 'carp test' ); 171} 172 173{ 174 my %hash = (foo => 42, bar => 23); 175 lock_hash( %hash ); 176 ok( hashref_locked( \%hash ), 'hashref_locked' ); 177 ok( hash_locked( %hash ), 'hash_locked' ); 178 179 ok( Internals::SvREADONLY(%hash),'Was locked %hash' ); 180 ok( Internals::SvREADONLY($hash{foo}),'Was locked $hash{foo}' ); 181 ok( Internals::SvREADONLY($hash{bar}),'Was locked $hash{bar}' ); 182 183 unlock_hash ( %hash ); 184 ok( hashref_unlocked( { %hash } ), 'hashref_unlocked' ); 185 ok( hash_unlocked( %hash ), 'hash_unlocked' ); 186 187 ok( !Internals::SvREADONLY(%hash),'Was unlocked %hash' ); 188 ok( !Internals::SvREADONLY($hash{foo}),'Was unlocked $hash{foo}' ); 189 ok( !Internals::SvREADONLY($hash{bar}),'Was unlocked $hash{bar}' ); 190} 191 192{ 193 my %hash = (foo => 42, bar => 23); 194 ok( ! hashref_locked( { %hash } ), 'hashref_locked negated' ); 195 ok( ! hash_locked( %hash ), 'hash_locked negated' ); 196 197 lock_hash( %hash ); 198 ok( ! hashref_unlocked( \%hash ), 'hashref_unlocked negated' ); 199 ok( ! hash_unlocked( %hash ), 'hash_unlocked negated' ); 200} 201 202lock_keys(%ENV); 203eval { () = $ENV{I_DONT_EXIST} }; 204like( 205 $@, 206 qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/, 207 'locked %ENV' 208); 209unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise 210 211{ 212 my %hash; 213 214 lock_keys(%hash, 'first'); 215 216 is (scalar keys %hash, 0, "place holder isn't a key"); 217 $hash{first} = 1; 218 is (scalar keys %hash, 1, "we now have a key"); 219 delete $hash{first}; 220 is (scalar keys %hash, 0, "now no key"); 221 222 unlock_keys(%hash); 223 224 $hash{interregnum} = 1.5; 225 is (scalar keys %hash, 1, "key again"); 226 delete $hash{interregnum}; 227 is (scalar keys %hash, 0, "no key again"); 228 229 lock_keys(%hash, 'second'); 230 231 is (scalar keys %hash, 0, "place holder isn't a key"); 232 233 eval {$hash{zeroeth} = 0}; 234 like ($@, 235 qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/, 236 'locked key never mentioned before should fail'); 237 eval {$hash{first} = -1}; 238 like ($@, 239 qr/^Attempt to access disallowed key 'first' in a restricted hash/, 240 'previously locked place holders should also fail'); 241 is (scalar keys %hash, 0, "and therefore there are no keys"); 242 $hash{second} = 1; 243 is (scalar keys %hash, 1, "we now have just one key"); 244 delete $hash{second}; 245 is (scalar keys %hash, 0, "back to zero"); 246 247 unlock_keys(%hash); # We have deliberately left a placeholder. 248 249 $hash{void} = undef; 250 $hash{nowt} = undef; 251 252 is (scalar keys %hash, 2, "two keys, values both undef"); 253 254 lock_keys(%hash); 255 256 is (scalar keys %hash, 2, "still two keys after locking"); 257 258 eval {$hash{second} = -1}; 259 like ($@, 260 qr/^Attempt to access disallowed key 'second' in a restricted hash/, 261 'previously locked place holders should fail'); 262 263 is ($hash{void}, undef, 264 "undef values should not be misunderstood as placeholders"); 265 is ($hash{nowt}, undef, 266 "undef values should not be misunderstood as placeholders (again)"); 267} 268 269{ 270 # perl #18651 - tim@consultix-inc.com found a rather nasty data dependant 271 # bug whereby hash iterators could lose hash keys (and values, as the code 272 # is common) for restricted hashes. 273 274 my @keys = qw(small medium large); 275 276 # There should be no difference whether it is restricted or not 277 foreach my $lock (0, 1) { 278 # Try setting all combinations of the 3 keys 279 foreach my $usekeys (0..7) { 280 my @usekeys; 281 for my $bits (0,1,2) { 282 push @usekeys, $keys[$bits] if $usekeys & (1 << $bits); 283 } 284 my %clean = map {$_ => length $_} @usekeys; 285 my %target; 286 lock_keys ( %target, @keys ) if $lock; 287 288 while (my ($k, $v) = each %clean) { 289 $target{$k} = $v; 290 } 291 292 my $message 293 = ($lock ? 'locked' : 'not locked') . ' keys ' . join ',', @usekeys; 294 295 is (scalar keys %target, scalar keys %clean, "scalar keys for $message"); 296 is (scalar values %target, scalar values %clean, 297 "scalar values for $message"); 298 # Yes. All these sorts are necessary. Even for "identical hashes" 299 # Because the data dependency of the test involves two of the strings 300 # colliding on the same bucket, so the iterator order (output of keys, 301 # values, each) depends on the addition order in the hash. And locking 302 # the keys of the hash involves behind the scenes key additions. 303 is_deeply( [sort keys %target] , [sort keys %clean], 304 "list keys for $message"); 305 is_deeply( [sort values %target] , [sort values %clean], 306 "list values for $message"); 307 308 is_deeply( [sort %target] , [sort %clean], 309 "hash in list context for $message"); 310 311 my (@clean, @target); 312 while (my ($k, $v) = each %clean) { 313 push @clean, $k, $v; 314 } 315 while (my ($k, $v) = each %target) { 316 push @target, $k, $v; 317 } 318 319 is_deeply( [sort @target] , [sort @clean], 320 "iterating with each for $message"); 321 } 322 } 323} 324 325# Check clear works on locked empty hashes - SEGVs on 5.8.2. 326{ 327 my %hash; 328 lock_hash(%hash); 329 %hash = (); 330 ok(keys(%hash) == 0, 'clear empty lock_hash() hash'); 331} 332{ 333 my %hash; 334 lock_keys(%hash); 335 %hash = (); 336 ok(keys(%hash) == 0, 'clear empty lock_keys() hash'); 337} 338 339# Copy-on-write scalars should not be deletable after lock_hash; 340{ 341 my %hash = (key=>__PACKAGE__); 342 lock_hash(%hash); 343 eval { delete $hash{key} }; 344 like $@, qr/^Attempt to delete readonly key /, 345 'COW scalars are not exempt from lock_hash (delete)'; 346 eval { %hash = () }; 347 like $@, qr/^Attempt to delete readonly key /, 348 'COW scalars are not exempt from lock_hash (clear)'; 349} 350 351my $hash_seed = hash_seed(); 352ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed"); 353 354{ 355 package Minder; 356 my $counter; 357 sub DESTROY { 358 --$counter; 359 } 360 sub new { 361 ++$counter; 362 bless [], __PACKAGE__; 363 } 364 package main; 365 366 for my $state ('', 'locked') { 367 my $a = Minder->new(); 368 is ($counter, 1, "There is 1 object $state"); 369 my %hash; 370 $hash{a} = $a; 371 is ($counter, 1, "There is still 1 object $state"); 372 373 lock_keys(%hash) if $state; 374 375 is ($counter, 1, "There is still 1 object $state"); 376 undef $a; 377 is ($counter, 1, "Still 1 object $state"); 378 delete $hash{a}; 379 is ($counter, 0, "0 objects when hash key is deleted $state"); 380 $hash{a} = undef; 381 is ($counter, 0, "Still 0 objects $state"); 382 %hash = (); 383 is ($counter, 0, "0 objects after clear $state"); 384 } 385} 386{ 387 my %hash = map {$_,$_} qw(fwiffffff foosht teeoo); 388 lock_keys(%hash); 389 delete $hash{fwiffffff}; 390 is (scalar keys %hash, 2,"Count of keys after delete on locked hash"); 391 unlock_keys(%hash); 392 is (scalar keys %hash, 2,"Count of keys after unlock"); 393 394 my ($first, $value) = each %hash; 395 is ($hash{$first}, $value, "Key has the expected value before the lock"); 396 lock_keys(%hash); 397 is ($hash{$first}, $value, "Key has the expected value after the lock"); 398 399 my ($second, $v2) = each %hash; 400 401 is ($hash{$first}, $value, "Still correct after iterator advances"); 402 is ($hash{$second}, $v2, "Other key has the expected value"); 403} 404{ 405 my $x='foo'; 406 my %test; 407 hv_store(%test,'x',$x); 408 is($test{x},'foo','hv_store() stored'); 409 $test{x}='bar'; 410 is($x,'bar','hv_store() aliased'); 411 is($test{x},'bar','hv_store() aliased and stored'); 412} 413 414{ 415 my %hash=map { $_ => 1 } qw( a b c d e f); 416 delete $hash{c}; 417 lock_keys(%hash); 418 ok(Internals::SvREADONLY(%hash),'lock_keys DDS/t 1'); 419 delete @hash{qw(b e)}; 420 my @hidden=sort(hidden_keys(%hash)); 421 my @legal=sort(legal_keys(%hash)); 422 my @keys=sort(keys(%hash)); 423 #warn "@legal\n@keys\n"; 424 is("@hidden","b e",'lock_keys @hidden DDS/t'); 425 is("@legal","a b d e f",'lock_keys @legal DDS/t'); 426 is("@keys","a d f",'lock_keys @keys DDS/t'); 427} 428{ 429 my %hash=(0..9); 430 lock_keys(%hash); 431 ok(Internals::SvREADONLY(%hash),'lock_keys DDS/t 2'); 432 Hash::Util::unlock_keys(%hash); 433 ok(!Internals::SvREADONLY(%hash),'unlock_keys DDS/t 2'); 434} 435{ 436 my %hash=(0..9); 437 lock_keys(%hash,keys(%hash),'a'..'f'); 438 ok(Internals::SvREADONLY(%hash),'lock_keys args DDS/t'); 439 my @hidden=sort numbers_first hidden_keys(%hash); 440 my @legal=sort numbers_first legal_keys(%hash); 441 my @keys=sort numbers_first keys(%hash); 442 is("@hidden","a b c d e f",'lock_keys() @hidden DDS/t 3'); 443 is("@legal","0 2 4 6 8 a b c d e f",'lock_keys() @legal DDS/t 3'); 444 is("@keys","0 2 4 6 8",'lock_keys() @keys'); 445} 446{ 447 my %hash=map { $_ => 1 } qw( a b c d e f); 448 delete $hash{c}; 449 lock_ref_keys(\%hash); 450 ok(Internals::SvREADONLY(%hash),'lock_ref_keys DDS/t'); 451 delete @hash{qw(b e)}; 452 my @hidden=sort(hidden_keys(%hash)); 453 my @legal=sort(legal_keys(%hash)); 454 my @keys=sort(keys(%hash)); 455 #warn "@legal\n@keys\n"; 456 is("@hidden","b e",'lock_ref_keys @hidden DDS/t 1'); 457 is("@legal","a b d e f",'lock_ref_keys @legal DDS/t 1'); 458 is("@keys","a d f",'lock_ref_keys @keys DDS/t 1'); 459} 460{ 461 my %hash=(0..9); 462 lock_ref_keys(\%hash,keys %hash,'a'..'f'); 463 ok(Internals::SvREADONLY(%hash),'lock_ref_keys args DDS/t'); 464 my @hidden=sort numbers_first hidden_keys(%hash); 465 my @legal=sort numbers_first legal_keys(%hash); 466 my @keys=sort numbers_first keys(%hash); 467 is("@hidden","a b c d e f",'lock_ref_keys() @hidden DDS/t 2'); 468 is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys() @legal DDS/t 2'); 469 is("@keys","0 2 4 6 8",'lock_ref_keys() @keys DDS/t 2'); 470} 471{ 472 my %hash=(0..9); 473 lock_ref_keys_plus(\%hash,'a'..'f'); 474 ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args DDS/t'); 475 my @hidden=sort numbers_first hidden_keys(%hash); 476 my @legal=sort numbers_first legal_keys(%hash); 477 my @keys=sort numbers_first keys(%hash); 478 is("@hidden","a b c d e f",'lock_ref_keys_plus() @hidden DDS/t'); 479 is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal DDS/t'); 480 is("@keys","0 2 4 6 8",'lock_ref_keys_plus() @keys DDS/t'); 481} 482{ 483 my %hash=(0..9, 'a' => 'alpha'); 484 lock_ref_keys_plus(\%hash,'a'..'f'); 485 ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args overlap'); 486 my @hidden=sort numbers_first hidden_keys(%hash); 487 my @legal=sort numbers_first legal_keys(%hash); 488 my @keys=sort numbers_first keys(%hash); 489 is("@hidden","b c d e f",'lock_ref_keys_plus() @hidden overlap'); 490 is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal overlap'); 491 is("@keys","0 2 4 6 8 a",'lock_ref_keys_plus() @keys overlap'); 492} 493{ 494 my %hash=(0..9); 495 lock_keys_plus(%hash,'a'..'f'); 496 ok(Internals::SvREADONLY(%hash),'lock_keys_plus args DDS/t'); 497 my @hidden=sort numbers_first hidden_keys(%hash); 498 my @legal=sort numbers_first legal_keys(%hash); 499 my @keys=sort numbers_first keys(%hash); 500 is("@hidden","a b c d e f",'lock_keys_plus() @hidden DDS/t 3'); 501 is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal DDS/t 3'); 502 is("@keys","0 2 4 6 8",'lock_keys_plus() @keys DDS/t 3'); 503} 504{ 505 my %hash=(0..9, 'a' => 'alpha'); 506 lock_keys_plus(%hash,'a'..'f'); 507 ok(Internals::SvREADONLY(%hash),'lock_keys_plus args overlap non-ref'); 508 my @hidden=sort numbers_first hidden_keys(%hash); 509 my @legal=sort numbers_first legal_keys(%hash); 510 my @keys=sort numbers_first keys(%hash); 511 is("@hidden","b c d e f",'lock_keys_plus() @hidden overlap non-ref'); 512 is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal overlap non-ref'); 513 is("@keys","0 2 4 6 8 a",'lock_keys_plus() @keys overlap non-ref'); 514} 515 516{ 517 my %hash = ('a'..'f'); 518 my @keys = (); 519 my @ph = (); 520 my @lock = ('a', 'c', 'e', 'g'); 521 lock_keys(%hash, @lock); 522 my $ref = all_keys(%hash, @keys, @ph); 523 my @crrack = sort(@keys); 524 my @ooooff = qw(a c e); 525 my @bam = qw(g); 526 527 ok(ref $ref eq ref \%hash && $ref == \%hash, 528 "all_keys() - \$ref is a reference to \%hash"); 529 is_deeply(\@crrack, \@ooooff, "Keys are what they should be"); 530 is_deeply(\@ph, \@bam, "Placeholders in place"); 531} 532 533{ 534 # lock_hash_recurse / unlock_hash_recurse 535 my %hash = ( 536 a => 'alpha', 537 b => [ qw( beta gamma delta ) ], 538 c => [ 'epsilon', { zeta => 'eta' }, ], 539 d => { theta => 'iota' }, 540 ); 541 lock_hash_recurse(%hash); 542 ok( hash_locked(%hash), 543 "lock_hash_recurse(): top-level hash locked" ); 544 ok( hash_locked(%{$hash{d}}), 545 "lock_hash_recurse(): element which is hashref locked" ); 546 ok( ! hash_locked(%{$hash{c}[1]}), 547 "lock_hash_recurse(): element which is hashref in array ref not locked" ); 548 549 unlock_hash_recurse(%hash); 550 ok( hash_unlocked(%hash), 551 "unlock_hash_recurse(): top-level hash unlocked" ); 552 ok( hash_unlocked(%{$hash{d}}), 553 "unlock_hash_recurse(): element which is hashref unlocked" ); 554 { 555 local $@; 556 eval { $hash{d} = { theta => 'kappa' }; }; 557 ok(! $@, "No error; can assign to unlocked hash") 558 or diag($@); 559 } 560 ok( hash_unlocked(%{$hash{c}[1]}), 561 "unlock_hash_recurse(): element which is hashref in array ref not locked" ); 562} 563 564{ 565 # lock_hashref_recurse / unlock_hashref_recurse 566 my %hash = ( 567 a => 'alpha', 568 b => [ qw( beta gamma delta ) ], 569 c => [ 'epsilon', { zeta => 'eta' }, ], 570 d => { theta => 'iota' }, 571 ); 572 Hash::Util::lock_hashref_recurse(\%hash); 573 ok( hash_locked(%hash), 574 "lock_hash_recurse(): top-level hash locked" ); 575 ok( hash_locked(%{$hash{d}}), 576 "lock_hash_recurse(): element which is hashref locked" ); 577 ok( ! hash_locked(%{$hash{c}[1]}), 578 "lock_hash_recurse(): element which is hashref in array ref not locked" ); 579 580 Hash::Util::unlock_hashref_recurse(\%hash); 581 ok( hash_unlocked(%hash), 582 "unlock_hash_recurse(): top-level hash unlocked" ); 583 ok( hash_unlocked(%{$hash{d}}), 584 "unlock_hash_recurse(): element which is hashref unlocked" ); 585 { 586 local $@; 587 eval { $hash{d} = { theta => 'kappa' }; }; 588 ok(! $@, "No error; can assign to unlocked hash") 589 or diag($@); 590 } 591 ok( hash_unlocked(%{$hash{c}[1]}), 592 "unlock_hash_recurse(): element which is hashref in array ref not locked" ); 593} 594 595{ 596 my $h1= hash_value("foo"); 597 my $h2= hash_value("bar"); 598 is( $h1, hash_value("foo") ); 599 is( $h2, hash_value("bar") ); 600 601 my $seed= hash_seed(); 602 my $h1s= hash_value("foo",$seed); 603 my $h2s= hash_value("bar",$seed); 604 605 is( $h1s, hash_value("foo",$seed) ); 606 is( $h2s, hash_value("bar",$seed) ); 607 608 $seed= join "", map { chr $_ } 1..length($seed); 609 610 my $h1s2= hash_value("foo",$seed); 611 my $h2s2= hash_value("bar",$seed); 612 613 is( $h1s2, hash_value("foo",$seed) ); 614 is( $h2s2, hash_value("bar",$seed) ); 615 616 isnt($h1s,$h1s2); 617 isnt($h1s,$h1s2); 618 619} 620 621{ 622 my @info1= bucket_info({}); 623 my @info2= bucket_info({1..10}); 624 my @stats1= bucket_stats({}); 625 my @stats2= bucket_stats({1..10}); 626 my $array1= bucket_array({}); 627 my $array2= bucket_array({1..10}); 628 is("@info1","0 8 0"); 629 like("@info2[0,1]",qr/5 (?:8|16)/); 630 is("@stats1","0 8 0"); 631 like("@stats2[0,1]",qr/5 (?:8|16)/); 632 my @keys1= sort map { ref $_ ? @$_ : () } @$array1; 633 my @keys2= sort map { ref $_ ? @$_ : () } @$array2; 634 is("@keys1",""); 635 is("@keys2","1 3 5 7 9"); 636} 637