t/pmc/hash.t

   1 #! parrot
   2 # Copyright (C) 2001-2008, The Perl Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/hash.t - Test the Hash PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/hash.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the C<Hash> PMC. Checks key access with various types of
  16 normal and potentially hazardous keys. Does a bit of stress testing as
  17 well.
  18
  19 =cut
  20
  21 .sub main :main
  22     .include 'include/test_more.pir'
  23
  24     plan(147)
  25
  26     initial_hash_tests()
  27     more_than_one_hash()
  28     hash_keys_with_nulls_in_them()
  29     nearly_the_same_hash_keys()
  30     the_same_hash_keys()
  31     key_that_hashes_to_zero()
  32     size_of_the_hash()
  33     stress_test_loop_set_check()
  34     stress_test_lots_of_keys()
  35     stress_test_loop_set_loop_check()
  36     testing_two_hash_indices_with_integers_at_a_time()
  37     testing_two_hash_indices_with_numbers_at_a_time()
  38     testing_two_hash_indices_with_strings_at_a_time()
  39     setting_and_getting_scalar_pmcs()
  40     setting_scalar_pmcs_and_getting_scalar_values()
  41     getting_values_from_undefined_keys()
  42     setting_and_getting_non_scalar_pmcs()
  43     testing_clone()
  44     compound_keys()
  45     getting_pmcs_from_compound_keys()
  46     getting_pmcs_from_string_int_compound_keys()
  47     if_hash()
  48     unless_hash()
  49     defined_hash()
  50     exists_hash_key()
  51     delete_hash_key()
  52     cloning_keys()
  53     cloning_pmc_vals()
  54     entry_types_type_keyed()
  55     delete_and_free_list()
  56     exists_with_constant_string_key()
  57     hash_in_pir()
  58     setting_with_compound_keys()
  59     mutating_the_lookup_string()
  60     check_whether_interface_is_done()
  61     iter_over_hash()
  62     broken_delete()
  63     unicode_keys_register_rt_39249()
  64     unicode_keys_literal_rt_39249()
  65
  66 .end
  67
  68 .sub initial_hash_tests
  69     new $P0, 'Hash'
  70
  71     set $P0["foo"], -7
  72     set $P0["bar"], 3.5
  73     set $P0["baz"], "value"
  74
  75     set $I0, $P0["foo"]
  76     set $N0, $P0["bar"]
  77     set $S0, $P0["baz"]
  78
  79     is( $I0, -7,       'lookup Int in hash' )
  80     is( $N0, 3.500000, 'lookup Num in hash' )
  81     is( $S0, "value",  'lookup Str in hash' )
  82
  83     set $S1, "oof"
  84     set $S2, "rab"
  85     set $S3, "zab"
  86
  87     set $P0[$S1], 7
  88     set $P0[$S2], -3.5
  89     set $P0[$S3], "VALUE"
  90
  91     set $I0, $P0[$S1]
  92     set $N0, $P0[$S2]
  93     set $S0, $P0[$S3]
  94
  95     is( $I0, 7,         'lookup Int in hash via Str' )
  96     is( $N0, -3.500000, 'lookup Num in hash via Str' )
  97     is( $S0, "VALUE",   'lookup Str in hash via Str' )
  98
  99 .end
 100
 101 .sub more_than_one_hash
 102     new $P0, 'Hash'
 103     set $S0, "key"
 104     set $P0[$S0], 1
 105
 106     new $P1, 'Hash'
 107     set $S1, "another_key"
 108     set $P1[$S1], 2
 109
 110     set $I0, $P0[$S0]
 111     set $I1, $P1[$S1]
 112
 113     is( $I0, 1, 'two hashes: lookup Int from hash via Str' )
 114     is( $I1, 2, 'two hashes: lookup Int from hash via Str in second' )
 115 .end
 116
 117 .sub hash_keys_with_nulls_in_them
 118     new $P0, 'Hash'
 119     set $S0, "parp\0me"
 120     set $S1, "parp\0you"
 121
 122     set $P0[$S0], 1             # $P0{parp\0me} = 1
 123     set $P0[$S1], 2             # $P0{parp\0you} = 2
 124
 125     set $I0, $P0[$S0]
 126     set $I1, $P0[$S1]
 127
 128     is( $I0, 1, 'hash key with null 1' )
 129     is( $I1, 2, 'hash key will null 2' )
 130 .end
 131
 132 .sub nearly_the_same_hash_keys
 133     new $P0, 'Hash'
 134     set $S0, "a\0"
 135     set $S1, "\0a"
 136
 137     set $P0[$S0], 1
 138     set $P0[$S1], 2
 139
 140     set $I0, $P0[$S0]
 141     set $I1, $P0[$S1]
 142
 143     is( $I0, 1, 'hash key with null' )
 144     is( $I1, 2, 'almost identical hash key with null' )
 145 .end
 146
 147 .sub the_same_hash_keys
 148     new $P0, 'Hash'
 149     set $S0, "Happy"
 150     set $S1, "Happy"
 151
 152     set $P0[$S0], 1
 153     set $I0, $P0[$S0]
 154     is( $I0, 1, 'lookup by $S0' )
 155
 156     set $P0[$S1], 2
 157     set $I1, $P0[$S1]
 158
 159     is( $I1, 2, 'set and lookup by $S1 (identical to $S0)' )
 160 .end
 161
 162 # NB Next test depends on "key2" hashing to zero, which it does with
 163 # the current algorithm; if the algorithm changes, change the test!
 164 # XXX - really?
 165
 166 .sub key_that_hashes_to_zero
 167         new $P0, 'Hash'
 168         set $S0, "key2"
 169         set $P0[$S0], 1
 170         set $I0, $P0[$S0]
 171
 172         is( $I0, 1, 'key that hashes to zero XXX' )
 173 .end
 174
 175 .sub size_of_the_hash
 176     new $P0, 'Hash'
 177
 178     set $P0["0"], 1
 179     set $I0, $P0
 180     is( $I0, 1, 'hash size of 1' )
 181
 182     set $P0["1"], 1
 183     set $I0, $P0
 184     is( $I0, 2, 'hash size of 2' )
 185
 186     set $P0["0"], 1
 187     set $I0, $P0
 188     is( $I0, 2, 'hash size of 2' )
 189 .end
 190
 191 .sub stress_test_loop_set_check
 192     new $P0, 'Hash'
 193
 194         set $I0, 200
 195         set $S0, "mikey"
 196         set $P0[$S0], "base"
 197         concat $S1, $S0, "s"
 198         set $P0[$S1], "bases"
 199         set $S2, $I0
 200         concat $S1, $S0, $S2
 201         set $P0[$S1], "start"
 202         set $S3, $P0["mikey"]
 203         is( $S3, 'base',  'setup: lookup mikey' )
 204         set $S3, $P0["mikeys"]
 205         is( $S3, 'bases', 'setup: lookup mikeys' )
 206         set $S3, $P0["mikey200"]
 207         is( $S3, 'start', 'setup: lookup mikey200' )
 208 LOOP:
 209         eq $I0, 0, DONE
 210         sub $I0, $I0, 1
 211         set $S2, $I0
 212         concat $S1, $S0, $S2
 213         concat $S4, $S0, $S2
 214         eq $S1, $S4, L1
 215         ##  this should be fail(), but it is not implemented yet
 216         ok( 0, 'concat mismatch' )
 217 L1:
 218         set $P0[$S1], $I0
 219         set $I1, $P0[$S1]
 220         eq $I0, $I1, L2
 221         ##  this should be fail(), but it is not implemented yet
 222         ok( 0, 'lookup mismatch' )
 223 L2:
 224         branch LOOP
 225 DONE:
 226         set $I0, $P0["mikey199"]
 227         is( $I0, 199, 'lookup: mikey199' )
 228         set $I0, $P0["mikey117"]
 229         is( $I0, 117, 'lookup: mikey117' )
 230         set $I0, $P0["mikey1"]
 231         is( $I0, 1, 'lookup: mikey1' )
 232         set $I0, $P0["mikey23"]
 233         is( $I0, 23, 'lookup: miky23' )
 234         set $I0, $P0["mikey832"]
 235         is( $I0, 0, 'lookup: mikey832 (never set)' )
 236 .end
 237
 238 ## stuff them in, and check periodically that we can pull selected ones out.
 239 ##   *_multiple_keys are used by stress_test_lots_of_keys
 240
 241 .sub set_multiple_keys
 242     .param pmc hash
 243     .param int key_index
 244     .param int step
 245     .param int count
 246
 247 again:
 248     if count <= 0 goto ret
 249     $S0 = key_index
 250     $S1 = concat "key", $S0
 251     $S2 = concat "value", $S0
 252     hash[$S1] = $S2
 253     key_index = key_index + step
 254     count = count - 1
 255     goto again
 256 ret:
 257 .end
 258
 259 .sub delete_multiple_keys
 260     .param pmc hash
 261     .param int key_index
 262     .param int step
 263     .param int count
 264
 265 again:
 266     if count <= 0 goto ret
 267     $S0 = key_index
 268     $S1 = concat "key", $S0
 269     delete hash[$S1]
 270     key_index = key_index + step
 271     count = count - 1
 272     goto again
 273 ret:
 274 .end
 275
 276 .sub check_key
 277     .param pmc hash
 278     .param int index
 279
 280     $S10 = index
 281     $S0 = concat "key", $S10
 282     $S1 = concat "value", $S10
 283
 284     $S2 = hash[$S0]
 285     $S3 = concat "correct value for key ", $S10
 286     is( $S2, $S1, $S3 )
 287 .end
 288
 289 .sub stress_test_lots_of_keys
 290     new $P30, 'Hash'
 291     $I29 = 1
 292     $I30 = 1000
 293     $I31 = 1000
 294
 295     # round 1
 296     set_multiple_keys($P30, $I29, $I30, $I31)
 297     check_key( $P30, 1 )
 298     check_key( $P30, 1001 )
 299     check_key( $P30, 2001 )
 300
 301     # round 2
 302     $I21 = 100000
 303     set_multiple_keys($P30, $I21, $I30, $I31)
 304     check_key( $P30, 1 )
 305     check_key( $P30, 1001 )
 306     check_key( $P30, 2001 )
 307     check_key( $P30, 100000 )
 308     check_key( $P30, 101000 )
 309     check_key( $P30, 102000 )
 310
 311     # round 3
 312     $I22 = 50000
 313     set_multiple_keys($P30, $I22, $I29, $I22)
 314     check_key( $P30, 1 )
 315     check_key( $P30, 1001 )
 316     check_key( $P30, 2001 )
 317     check_key( $P30, 500000 )
 318     check_key( $P30, 510000 )
 319     check_key( $P30, 520000 )
 320
 321     # round 4
 322     delete_multiple_keys($P30, $I22, $I29, $I22)
 323     check_key( $P30, 1001 )
 324     check_key( $P30, 2001 )
 325     $I50 = exists $P30['key50000']
 326     $I51 = exists $P30['key51000']
 327     $I52 = exists $P30['key52000']
 328     is( $I50, 0, 'key50000 does not exist after delete' )
 329     is( $I51, 0, 'key51000 does not exist after delete' )
 330     is( $I52, 0, 'key52000 does not exist after delete' )
 331 .end
 332
 333 # Check all values after setting all of them
 334 .sub stress_test_loop_set_loop_check
 335     new $P0, 'Hash'
 336
 337         set $I0, 200
 338         set $S0, "mikey"
 339 SETLOOP:
 340         eq $I0, 0, DONE
 341         sub $I0, $I0, 1
 342         set $S2, $I0
 343         concat $S1, $S0, $S2
 344         set $P0[$S1], $I0
 345         branch SETLOOP
 346
 347         set $I0, 200
 348 GETLOOP:
 349         eq $I0, 0, DONE
 350         sub $I0, $I0, 1
 351         set $S2, $I0
 352         concat $S1, $S0, $S2
 353         set $I1, $P0[$S1]
 354         eq $I0, $I1, L2
 355           is( $I0, $I1, 'lookup mismatch in stress test loop' )
 356           .return()
 357 L2:
 358         branch GETLOOP
 359 DONE:
 360         ok( 1, 'stress test: loop set with loop check' )
 361 .end
 362
 363 .sub testing_two_hash_indices_with_integers_at_a_time
 364       new $P0, 'Hash'
 365
 366       set $P0["foo"],37
 367       set $P0["bar"],-15
 368
 369       set $I0,$P0["foo"]
 370       is( $I0, 37, 'lookup int in foo' )
 371
 372       set $I0,$P0["bar"]
 373       is( $I0, -15, 'lookup int in bar' )
 374
 375       set $S1,"foo"
 376       set $I0,$P0[$S1]
 377       is( $I0,37, 'lookup int in foo via var' )
 378
 379       set $S1,"bar"
 380       set $I0,$P0[$S1]
 381       is( $I0,-15, 'lookup int in bar via var' )
 382 .end
 383
 384 .sub testing_two_hash_indices_with_numbers_at_a_time
 385       new $P0, 'Hash'
 386
 387       set $P0["foo"],37.100000
 388       set $P0["bar"],-15.100000
 389
 390       set $N0,$P0["foo"]
 391       is( $N0,37.100000, 'lookup num in foo' )
 392
 393       set $N0,$P0["bar"]
 394       is( $N0,-15.100000, 'lookup num in bar' )
 395
 396       set $S1,"foo"
 397       set $N0,$P0[$S1]
 398       is( $N0,37.100000, 'lookup num in foo via var' )
 399
 400       set $S1,"bar"
 401       set $N0,$P0[$S1]
 402       is( $N0,-15.100000, 'lookup num in bar via var' )
 403
 404 .end
 405
 406 .sub testing_two_hash_indices_with_strings_at_a_time
 407       new $P0, 'Hash'
 408
 409       set $P0["foo"],"baz"
 410       set $P0["bar"],"qux"
 411
 412       set $S0,$P0["foo"]
 413       is( $S0,"baz", 'lookup str in foo' )
 414
 415       set $S0,$P0["bar"]
 416       is( $S0,"qux", 'lookup str in bar' )
 417
 418       set $S1,"foo"
 419       set $S0,$P0[$S1]
 420       is( $S0,"baz", 'lookup str in foo via var' )
 421
 422       set $S1,"bar"
 423       set $S0,$P0[$S1]
 424       is( $S0,"qux", 'lookup str in bar via var' )
 425
 426 .end
 427
 428 # So far, we have only used INTVALs, FLOATVALs and STRINGs as values
 429 # and/or keys. Now we try PMCs.
 430
 431 .sub setting_and_getting_scalar_pmcs
 432       new $P0, 'Hash'
 433       new $P1, 'Integer'
 434       new $P2, 'Integer'
 435
 436       set $S0, "non-PMC key"
 437
 438       set $P1, 10
 439       set $P0[$S0], $P1
 440       set $P2, $P0[$S0]
 441       is( $P2, $P1, 'lookup PMC Integer' )
 442
 443       set $P1, -1234.000000
 444       set $P0[$S0], $P1
 445       set $P2, $P0[$S0]
 446       is( $P2, $P1, 'lookup num after PMC Integer in slot' )
 447
 448       set $P1, "abcdefghijklmnopq"
 449       set $P0[$S0], $P1
 450       set $P2, $P0[$S0]
 451       is( $P2, $P1, 'lookup string' )
 452
 453       new $P1, 'Undef'
 454       set $P0[$S0], $P1
 455       set $P2, $P0[$S0]
 456       typeof $S1, $P2
 457       is( $S1, "Undef", 'lookup Undef PMC' )
 458
 459 .end
 460
 461 .sub setting_scalar_pmcs_and_getting_scalar_values
 462       new $P0, 'Hash'
 463       new $P1, 'Integer'
 464
 465       set $S0, "A rather large key"
 466
 467       set $I0, 10
 468       set $P1, $I0
 469       set $P0[$S0], $P1
 470       set $I1, $P0[$S0]
 471       is( $I1, $I0, 'lookup PMC and get scalar Int' )
 472
 473       set $N0, -1234.000000
 474       set $P1, $N0
 475       set $P0[$S0], $P1
 476       set $N1, $P0[$S0]
 477       is( $N1, $N0, 'lookup PMC and get scalar Num' )
 478
 479       set $S1, "abcdefghijklmnopq"
 480       set $P1, $S1
 481       set $P0[$S0], $P1
 482       set $S2, $P0[$S0]
 483       is( $S2, $S1, 'lookup PMC and get scalar Str' )
 484
 485 .end
 486
 487 .sub getting_values_from_undefined_keys
 488       new $P2, 'Hash'
 489
 490       set $I0, $P2["qwerty"]
 491       set $N0, $P2["asdfgh"]
 492       set $S0, $P2["zxcvbn"]
 493       set $P0, $P2["123456"]
 494
 495       is( $I0,   0, 'undefined key returns Int 0' )
 496       is( $N0, 0.0, 'undefined key returns Num 0.0' )
 497       is( $S0,  "", 'undefined key returns Str ""' )
 498
 499       $I1 = 1
 500       if_null $P0, P0_is_null
 501         $I1 = 0
 502     P0_is_null:
 503       ok( $I1, 'undefined key returns null PMC' )
 504 .end
 505
 506 .sub setting_and_getting_non_scalar_pmcs
 507         new $P0,'Hash'
 508         new $P1,'ResizablePMCArray'
 509         new $P2,'ResizablePMCArray'
 510         set $P1[4],"string"
 511         set $P0["one"],$P1
 512         set $P2,$P0["one"]
 513         set $S0,$P2[4]
 514         is( $S0, 'string', 'set and get non-scalar PMCs' )
 515 .end
 516
 517 .sub testing_clone
 518     new $P0, 'Hash'
 519     set $S0, "a"
 520     set $P0[$S0], $S0
 521     new $P2, 'ResizablePMCArray'
 522     set $P2, 2
 523     set $P0["b"], $P2
 524
 525     # $P0 = { a => "a", b => [undef, undef] }
 526
 527     clone $P1, $P0
 528     set $P0["c"], 4
 529     set $P3, $P0["b"]
 530     set $P3, 3
 531     set $P0["b"], $P3
 532     set $P1["a"], "A"
 533
 534     # $P0 = { a => "a", b => [undef, undef, undef], c => 4 }
 535     # $P1 = { a => "A", b => [undef, undef] }
 536
 537     set $S0, $P0["a"]
 538     is( $S0, "a", 'original hash lookup pre-clone value' )
 539
 540     set $P5, $P0["b"]
 541     set $I0, $P5
 542     is( $I0, 3, 'original hash lookup post-clone value' )
 543
 544     set $I0, $P0["c"]
 545     is( $I0, 4, 'original hash lookup post-clone value in new slot' )
 546
 547     set $S0, $P1["a"]
 548     is( $S0, "A", 'cloned hash lookup post-clone value' )
 549
 550     set $P5, $P1["b"]
 551     set $I0, $P5
 552     is( $I0, 2, 'cloned hash lookup pre-clone complex value' )
 553
 554 # XXX: this should return undef or something, but it dies instead.
 555 #     set $P3, $P0["c"]
 556 #     unless $P3, ok6
 557 #     print "not "
 558 # ok6:
 559 #     print "ok 6\n"
 560 .end
 561
 562 .sub compound_keys
 563     new $P0, 'Hash'
 564     new $P1, 'Hash'
 565     new $P2, 'ResizablePMCArray'
 566     set $P1["b"], "ab"
 567     set $P0["a"], $P1
 568     set $S0, $P0["a";"b"]
 569     is( $S0, "ab", 'Str from compound key' )
 570
 571     set $P2[20], 77
 572     set $P1["n"], $P2
 573     set $I0, $P0["a";"n";20]
 574     is( $I0, 77, 'Int from compound key^2' )
 575
 576     set $S0, "a"
 577     set $S1, "n"
 578     set $I0, 20
 579     set $I0, $P0[$S0;$S1;$I0]
 580     is( $I0, 77, 'Int from indirect compound key^2' )
 581
 582     set $P0["c"], $P2
 583     set $P2[33], $P1
 584     set $S0, $P0["c";33;"b"]
 585     is( $S0, "ab", 'Str from indirect/direct compound key^2' )
 586
 587     set $S0, "c"
 588     set $I1, 33
 589     set $S2, "b"
 590     set $S0, $P0[$S0;$I1;$S2]
 591     is( $S0, "ab", 'Str from indirect compound key^2' )
 592
 593     set $P1["b"], 47.11
 594     set $N0, $P0["c";$I1;$S2]
 595     is( $N0, 47.11, 'Num from indirect compound key^2' )
 596 .end
 597
 598 .sub getting_pmcs_from_compound_keys
 599     new $P0, 'Hash'
 600     new $P1, 'Hash'
 601     new $P2, 'Integer'
 602     set $P2, 12
 603     set $P1["b"], $P2
 604     set $P0["a"], $P1
 605     set $P3, $P0["a";"b"]
 606     set $S0, $P3
 607     is( $S0, "12", "lookup PMC from compound key" )
 608 .end
 609 # 12
 610
 611 .sub getting_pmcs_from_string_int_compound_keys
 612     new $P0, 'Hash'
 613     new $P1, 'Hash'
 614     new $P2, 'Integer'
 615     set $P2, 4
 616     set $P1[9], $P2
 617     set $I0, $P1[9]
 618     is( $I0, 4, 'lookup Int PMC from hash' )
 619
 620     set $P0["a"], $P1
 621     set $I0, $P0["a";9]
 622     is( $I0, 4, 'lookup Inc PMC from compound hash' )
 623 .end
 624
 625 # A hash is only false if it has size 0
 626
 627 .sub if_hash
 628     new $P0, 'Hash'
 629
 630     ## Could just use Test::More tests directly, but then we are really
 631     ## checking casting to Int then testing value (I think)
 632     ## ie. ok( $P0, '...' )
 633
 634     $I1 = 0
 635     if $P0, L1
 636       $I1 = 1
 637   L1:
 638     ok( $I1, 'Empty hash is false' )
 639
 640     set $P0["key"], "value"
 641     $I1 = 1
 642     if $P0, L2
 643       $I1 = 0
 644   L2:
 645     ok( $I1, 'Hash with one slot is true' )
 646
 647     set $P0["key"], ""
 648     $I1 = 1
 649     if $P0, L3
 650       $I1 = 0
 651   L3:
 652     ok( $I1, 'Hash with one value ("") is true' )
 653
 654     new $P1, 'Undef'
 655     set $P0["key"], $P1
 656     $I1 = 1
 657     if $P0, L4
 658       $I1 = 0
 659   L4:
 660     ok( $P0, 'Hash with one value (Undef PMC) is true' )
 661
 662 .end
 663
 664 .sub unless_hash
 665     new $P0, 'Hash'
 666
 667     $I0 = 1
 668     unless $P0, L1
 669       $I0 = 0
 670   L1:
 671     ok( $I0, 'Empty hash is false in unless' )
 672
 673     $I0 = 0
 674     set $P0["key"], "value"
 675     unless $P0, L2
 676       $I0 = 1
 677   L2:
 678     ok( $I0, 'Hash with one value is true' )
 679
 680     $I0 = 0
 681     set $P0["key"], "\0"
 682     unless $P0, L3
 683       $I0 = 1
 684   L3:
 685     ok( $I0, 'Hash with one value ("\0") is true' )
 686
 687     $I0 = 0
 688     new $P1, 'Undef'
 689     set $P0["key"], $P1
 690     unless $P0, L4
 691       $I0 = 1
 692   L4:
 693     ok( $I0, 'Hash with one value (Undef PMC) is true' )
 694
 695 .end
 696
 697 .sub defined_hash
 698     new $P0, 'Hash'
 699
 700     defined $I0, $P0
 701     ok( $I0, 'Empty has is defined' )
 702
 703     ## nok() had not been (correctly) implemented when this test was written
 704
 705     defined $I0, $P1
 706     $I0 = not $I0
 707     ok( $I1, 'Unassigned var is undefined' )
 708
 709     set $P0["a"], 1
 710     defined $I0, $P0["a"]
 711     ok( $I0, 'Int in hash value is defined' )
 712
 713     defined $I0, $P0["b"]
 714     $I0 = not $I0
 715     ok( $I0, 'Unassigned hash slot is undefined' )
 716
 717     new $P1, 'Undef'
 718     set $P0["c"], $P1
 719     defined $I0, $P0["c"]
 720     $I0 = not $I0
 721     ok( $I0, 'Undef PMC in hash slot is undefined' )
 722 .end
 723
 724 .sub exists_hash_key
 725     new $P0, 'Hash'
 726
 727     set $P0["a"], 1
 728     exists $I0, $P0["a"]
 729     ok( $I0, 'assigned hash key exists' )
 730
 731     exists $I0, $P0["b"]
 732     $I0 = not $I0
 733     ok( $I0, 'unassigned hash key does not exist' )
 734
 735     new $P1, 'Undef'
 736     set $P0["c"], $P1
 737     exists $I0, $P0["c"]
 738     ok( $I0, 'hash key assigned Undef PMC exists' )
 739 .end
 740
 741 .sub delete_hash_key
 742     new $P0, 'Hash'
 743
 744     set $P0["a"], 1
 745     exists $I0, $P0["a"]
 746     ok( $I0, 'assigned hash key exists' )
 747
 748     delete $P0["a"]
 749     exists $I0, $P0["a"]
 750     $I0 = not $I0
 751     ok( $I0, 'delete hash key does not exist' )
 752 .end
 753
 754 .sub cloning_keys
 755     new $P10, 'Hash'
 756     new $P1, 'Key'
 757
 758     set $P1, "Bar"
 759     set $P10[$P1], "Food"
 760     clone $P2, $P1
 761     set $S0, $P10[$P2]
 762     is( $S0, "Food", 'cloned key looks up same value' )
 763
 764     set $S1, "Baa"
 765     set $P10[$S1], "Sheep"
 766     clone $S2, $S1
 767     set $S0, $P10[$S2]
 768     is( $S0, "Sheep", 'cloned key again look up same value' )
 769 .end
 770
 771 .sub cloning_pmc_vals
 772     new $P10, 'Hash'
 773
 774     new $P1, 'Undef'
 775     set $P1, "value"
 776     set $P10["str"], $P1
 777
 778     new $P1, 'Undef'
 779     set $P1, 42
 780     set $P10["int"], $P1
 781
 782     clone $P2, $P10
 783     set $P0, $P2["int"]
 784     is( $P0, 42, 'cloned hash contained pre-clone set int' )
 785     set $P0, $P2["str"]
 786     is( $P0, 'value', 'cloned hash contains pre-clone set str' )
 787 .end
 788
 789 .sub entry_types_type_keyed
 790     ## XXX is there any concern that including this will impact other tests?
 791     .include "pmctypes.pasm"
 792     new $P1, 'Hash'
 793
 794     new $P2, 'Integer'
 795     set $P1["Integer"], $P2
 796     typeof $I0, $P1["Integer"]
 797     is( $I0, .Integer, 'entry type is Integer' )
 798
 799     new $P3, 'Integer'
 800     set $P1["Integer"], $P3
 801     typeof $I0, $P1["Integer"]
 802     is( $I0, .Integer, 'entry type is Integer' )
 803
 804     set $P1["native int"], -123456
 805     typeof $I0, $P1["native int"]
 806     is( $I0, .Integer, 'entry type is Integer' )
 807
 808     set $P1["native float"], -123.456
 809     typeof $I0, $P1["native float"]
 810     is( $I0, .Float, 'entry type is Float' )
 811
 812     set $P1["native string"], "hello world\n"
 813     typeof $I0, $P1["native string"]
 814     is( $I0, .String, 'entry type is String' )
 815
 816 .end
 817
 818 .sub delete_and_free_list
 819     set $I2, 10
 820     set $I1, 1
 821     new $P0, 'SArray'
 822     set $P0, 1
 823     new $P1, 'Hash'
 824 outer:
 825     set $P0[0], $I1
 826     sprintf $S0, "ok %vd\n", $P0
 827     set $P1[$S0], $S0
 828
 829     ## set $P1[key]=1 then delete it 100 times
 830     set $I0, 100
 831 lp:
 832     set $P1["key"], 1
 833     delete $P1["key"]
 834     dec $I0
 835     if $I0, lp
 836
 837     set $S1, $P1[$S0]
 838     # print $S1
 839     inc $I1
 840     le $I1, $I2, outer
 841
 842     set $I0, $P1
 843     is( $I0, 10, 'hash has size 10' )
 844 .end
 845
 846 ## XXX already tested?
 847 .sub exists_with_constant_string_key
 848     new $P16, 'Hash'
 849
 850     set $P16["key1"], "value for key1"
 851     set $S16, $P16["key1"]
 852     is( $S16, "value for key1" , 'set and lookup value for const str key' )
 853
 854     exists $I17, $P16["key1"]
 855     ok( $I17, 'exists with constant string key' )
 856
 857     exists $I17, $P16["no such"]
 858     $I17 = not $I17
 859     ok( $I17, 'does not exist with unassigned const string key' )
 860 .end
 861
 862 .sub hash_in_pir
 863     .local pmc hash1
 864     hash1 = new 'Hash'
 865     hash1['X'] = 'U'
 866     .local string val1
 867     val1 = hash1['X']
 868     is( val1, "U", 'hash in PIR' )
 869 .end
 870
 871 .sub setting_with_compound_keys
 872     .local pmc outer_hash
 873     outer_hash = new 'Hash'
 874     .local pmc inner_hash
 875     inner_hash = new 'Hash'
 876     .local pmc inner_array
 877     inner_array = new 'ResizablePMCArray'
 878     .local string elem_string
 879     .local int    elem_int
 880     .local pmc    elem_pmc
 881     .local num    elem_num
 882
 883     # setting and retrieving strings in an inner ResizablePMCArray
 884     inner_array[128] = 'inner_array:128'
 885     outer_hash['inner_array'] = inner_array
 886     elem_string = outer_hash['inner_array';128]
 887     is( elem_string, 'inner_array:128', 'string in inner ResizeablePMCArray' )
 888     outer_hash['inner_array';128] = 'changed inner_array:128'
 889     elem_string = outer_hash['inner_array';128]
 890     is( elem_string, 'changed inner_array:128', 'string in inner ResizeablePMCArray' )
 891
 892     # setting and retrieving strings in an inner Hash
 893     inner_hash['129'] = 'inner_hash:129'
 894     outer_hash['inner_hash'] = inner_hash
 895     elem_string = outer_hash['inner_hash';'129']
 896     is( elem_string, 'inner_hash:129', 'string in inner Hash' )
 897     outer_hash['inner_hash';'129'] = 'changed inner_hash:129'
 898     elem_string = outer_hash['inner_hash';'129']
 899     is( elem_string, 'changed inner_hash:129', 'string in inner Hash' )
 900
 901     # setting and retrieving integer in an inner ResizablePMCArray
 902     inner_array[130] = 130
 903     outer_hash['inner_array'] = inner_array
 904     elem_int = outer_hash['inner_array';130]
 905     is( elem_int, 130, 'int in inner ResizablePMCArray' )
 906     outer_hash['inner_array';130] = -130
 907     elem_int = outer_hash['inner_array';130]
 908     is( elem_int, -130, 'int in inner ResizablePMCArray' )
 909
 910     # setting and retrieving integer in an inner Hash
 911     inner_hash['131'] = 131
 912     outer_hash['inner_hash'] = inner_hash
 913     elem_int = outer_hash['inner_hash';'131']
 914     is( elem_int, 131, 'int in inner Hash' )
 915     outer_hash['inner_hash';'131'] = -131
 916     elem_int = outer_hash['inner_hash';'131']
 917     is( elem_int, -131, 'int in inner Hash' )
 918
 919     # setting and retrieving a PMC in an inner ResizablePMCArray
 920     .local pmc in_pmc
 921     in_pmc = new 'String'
 922     in_pmc = 'inner_array:132'
 923     inner_array[132] = in_pmc
 924     outer_hash['inner_array'] = inner_array
 925     elem_pmc = outer_hash['inner_array';132]
 926     is( elem_pmc, 'inner_array:132', 'PMC in inner ResizablePMCArray' )
 927     in_pmc = 'changed inner_array:132'
 928     outer_hash['inner_array';132] = in_pmc
 929     elem_pmc = outer_hash['inner_array';132]
 930     is( elem_pmc, 'changed inner_array:132', 'PMC in inner ResizablePMCArray' )
 931
 932     # setting and retrieving a PMC in an inner Hash
 933     in_pmc = 'inner_array:133'
 934     inner_hash['133'] = in_pmc
 935     outer_hash['inner_hash'] = inner_hash
 936     elem_string = outer_hash['inner_hash';'133']
 937     is( elem_string, 'inner_array:133', 'PMC in inner Hash' )
 938     in_pmc = 'changed inner_hash:133'
 939     outer_hash['inner_hash';'133'] = in_pmc
 940     elem_string = outer_hash['inner_hash';'133']
 941     is( elem_string, 'changed inner_hash:133', 'PMC in inner Hash' )
 942
 943     # setting and retrieving a float in an inner ResizablePMCArray
 944     inner_array[134] = 134.134
 945     outer_hash['inner_array'] = inner_array
 946     elem_num = outer_hash['inner_array';134]
 947     is( elem_num, 134.134000, 'float in inner ResizablePMCArray' )
 948     outer_hash['inner_array';134] = -134.134
 949     elem_num = outer_hash['inner_array';134]
 950     is( elem_num, -134.134000, 'float in inner ResizablePMCArray' )
 951
 952     # setting and retrieving a float in an inner Hash
 953     inner_hash['135'] = 135.135
 954     outer_hash['inner_hash'] = inner_hash
 955     elem_num = outer_hash['inner_hash';'135']
 956     is( elem_num, 135.135000, 'float in inner Hash' )
 957     outer_hash['inner_hash';'135'] = -135.135
 958     elem_num = outer_hash['inner_hash';'135']
 959     is( elem_num, -135.135000, 'float in inner Hash' )
 960
 961 .end
 962
 963 .sub mutating_the_lookup_string
 964     new $P0, 'Hash'
 965     set $P0["a"], "one"
 966     set $P0["ab"], "two"
 967     set $P0["abc"], "three"
 968
 969     set $S0, "a"
 970     set $S1, $P0[$S0]
 971     is( $S1, "one", 'lookup via str in reg' )
 972
 973     concat $S0, "b"
 974     set $S1, $P0[$S0]
 975     is( $S1, "two", 'lookup via concated str in reg' )
 976
 977     concat $S0, "c"
 978     set $S1, $P0[$S0]
 979     is( $S1, "three", 'lookup via concated^2 str in reg' )
 980 .end
 981
 982 .sub check_whether_interface_is_done
 983     .local pmc pmc1
 984     pmc1 = new 'Hash'
 985     .local int bool1
 986
 987     does bool1, pmc1, "scalar"
 988     bool1 = not bool1
 989     ok( bool1, 'Hash PMC does not do scalar' )
 990
 991     does bool1, pmc1, "hash"
 992     ok( bool1, 'Hash PMC does hash' )
 993
 994     does bool1, pmc1, "no_interface"
 995     bool1 = not bool1
 996     ok( bool1, 'Hash PMC does not do no_interface' )
 997 .end
 998
 999 .sub iter_over_hash
1000     new $P0, 'Hash'
1001     set $P0['a'], 'x'
1002
1003     iter $P1, $P0
1004     $I0 = 1
1005     if $P1 goto L1
1006       $I0 = 0
1007   L1:
1008     ok( $I0, 'iterator is true' )
1009
1010     shift $P2, $P1
1011     is( $P2, 'a', 'shifting iterator give the key' )
1012
1013     $I0 = 0
1014     if $P1 goto L2
1015       $I0 = 1
1016   L2:
1017     ok( $I0, 'iterator is now false' )
1018 .end
1019
1020 ## thx to azuroth on irc
1021 .sub broken_delete
1022   .include "iterator.pasm"
1023   .local string result
1024   result = ""
1025
1026   .local pmc thash
1027
1028   # just put in some dummy data...
1029   thash = new 'Hash'
1030   thash["a"] = "b"
1031   thash["c"] = "d"
1032   thash["e"] = "f"
1033
1034   .local pmc iter
1035   iter = new 'Iterator', thash
1036   iter = .ITERATE_FROM_START
1037
1038   .local string key
1039
1040   # go through the hash, print out all the keys: should be a c and e
1041 preit_loop:
1042   unless iter goto preit_end
1043
1044   key = shift iter
1045   result .= key
1046
1047   branch preit_loop
1048 preit_end:
1049
1050   is( result, 'ace', 'iterated through keys successfully' )
1051
1052   # get rid of the c element?
1053   delete thash["c"]
1054
1055   # what do we have after deletion?
1056   result = ""
1057
1058   iter = new 'Iterator', thash
1059   iter = .ITERATE_FROM_START
1060
1061   # go through the hash, print out all the keys... I believe it should be a and e?
1062   # it actually outputs a, c and e.
1063 postit_loop:
1064   unless iter goto postit_end
1065
1066   key = shift iter
1067   result .= key
1068
1069   branch postit_loop
1070 postit_end:
1071
1072   is( result, 'ae', 'the c key was no longer iterated over' )
1073 .end
1074
1075 .sub unicode_keys_register_rt_39249
1076   $P1 = new 'Hash'
1077
1078   $S99 = unicode:"\u7777"
1079   $P1[$S99] = "ok"
1080   $S1 = $P1[$S99]
1081   is( $S1, 'ok', 'unicode key' )
1082 .end
1083
1084 .sub unicode_keys_literal_rt_39249
1085   $P1 = new 'Hash'
1086
1087   $P1[unicode:"\u7777"] = "ok"
1088   $S1 = $P1[unicode:"\u7777"]
1089   is( $S1, 'ok', 'literal unicode key' )
1090
1091   $S2 = unicode:"\u7777"
1092   $S1 = $P1[$S2]
1093   is( $S1, 'ok', 'literal unicode key lookup via var' )
1094 .end
1095
1096 # Local Variables:
1097 #   mode: pir
1098 #   fill-column: 100
1099 # End:
1100 # vim: expandtab shiftwidth=4 ft=pir: