fix codetest failure - ASSERT_ARGS does not have a ; after and
[parrot.git] / t / pmc / hash.t
blob2723cbb7260723b5f6a38eb1aeae4efa52a499ab
1 #!./parrot
2 # Copyright (C) 2001-2010, Parrot Foundation.
3 # $Id$
5 =head1 NAME
7 t/pmc/hash.t - Test the Hash PMC
9 =head1 SYNOPSIS
11     % prove t/pmc/hash.t
13 =head1 DESCRIPTION
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.
19 =cut
21 .include 'except_types.pasm'
22 .include 'datatypes.pasm'
23 .include 'hash_key_type.pasm'
25 .sub main :main
26     .include 'test_more.pir'
28     plan(174)
30     initial_hash_tests()
31     more_than_one_hash()
32     hash_key_type()
33     hash_value_type()
34     null_key()
35     hash_keys_with_nulls_in_them()
36     nearly_the_same_hash_keys()
37     the_same_hash_keys()
38     key_that_hashes_to_zero()
39     size_of_the_hash()
40     stress_test_loop_set_check()
41     stress_test_lots_of_keys()
42     stress_test_loop_set_loop_check()
43     testing_two_hash_indices_with_integers_at_a_time()
44     testing_two_hash_indices_with_numbers_at_a_time()
45     testing_two_hash_indices_with_strings_at_a_time()
46     setting_and_getting_scalar_pmcs()
47     setting_scalar_pmcs_and_getting_scalar_values()
48     getting_values_from_undefined_keys()
49     setting_and_getting_non_scalar_pmcs()
50     testing_clone()
51     clone_doesnt_crash_on_deleted_keys()
52     clone_preserves_order()
53     freeze_thaw_preserves_order()
54     compound_keys()
55     getting_pmcs_from_compound_keys()
56     getting_pmcs_from_string_int_compound_keys()
57     if_hash()
58     unless_hash()
59     defined_hash()
60     exists_hash_key()
61     delete_hash_key()
62     cloning_keys()
63     cloning_pmc_vals()
64     delete_and_free_list()
65     exists_with_constant_string_key()
66     hash_in_pir()
67     setting_with_compound_keys()
68     mutating_the_lookup_string()
69     check_whether_interface_is_done()
70     iter_over_hash()
71     broken_delete()
72     unicode_keys_register_rt_39249()
73     unicode_keys_literal_rt_39249()
75     integer_keys()
76     value_types_convertion()
77     elements_in_hash()
78     equality_tests()
80     pmc_keys()
81 .end
83 .sub initial_hash_tests
84     new $P0, 'Hash'
86     set $P0["foo"], -7
87     set $P0["bar"], 3.5
88     set $P0["baz"], "value"
90     set $I0, $P0["foo"]
91     set $N0, $P0["bar"]
92     set $S0, $P0["baz"]
94     is( $I0, -7,       'lookup Int in hash' )
95     is( $N0, 3.500000, 'lookup Num in hash' )
96     is( $S0, "value",  'lookup Str in hash' )
98     set $S1, "oof"
99     set $S2, "rab"
100     set $S3, "zab"
102     set $P0[$S1], 7
103     set $P0[$S2], -3.5
104     set $P0[$S3], "VALUE"
106     set $I0, $P0[$S1]
107     set $N0, $P0[$S2]
108     set $S0, $P0[$S3]
110     is( $I0, 7,         'lookup Int in hash via Str' )
111     is( $N0, -3.500000, 'lookup Num in hash via Str' )
112     is( $S0, "VALUE",   'lookup Str in hash via Str' )
114 .end
116 .sub more_than_one_hash
117     new $P0, ['Hash']
118     set $S0, "key"
119     set $P0[$S0], 1
121     new $P1, ['Hash']
122     set $S1, "another_key"
123     set $P1[$S1], 2
125     set $I0, $P0[$S0]
126     set $I1, $P1[$S1]
128     is( $I0, 1, 'two hashes: lookup Int from hash via Str' )
129     is( $I1, 2, 'two hashes: lookup Int from hash via Str in second' )
130 .end
132 .sub hash_key_type
133     .local pmc h
134     .local int i
135     h = new ['Hash']
136     h = .Hash_key_type_int
137     h['01'] = 42
138     i = h[1]
139     is(i, 42, 'key type int')
141     # Use the method here to check it at the same time.
142     h.'set_key_type'(.Hash_key_type_STRING)
143     h[1] = 42
144     i = h['01']
145     isnt(i, 42, 'key type STRING')
146     i = h.'get_key_type'()
147     is(i, .Hash_key_type_STRING, 'method get_key_type return type STRING')
149     push_eh invalid_type
150     h = -973 # Let's hope it will never become a valid type
151     pop_eh
152     ok(0, "Setting invalid type should throw")
153     goto end
154 invalid_type:
155     pop_eh
156     ok(1, 'Setting invalid type throws')
157 end:
158 .end
160 .sub hash_value_type
161     .local pmc h, eh
162     .local int r
163     h = new ['Hash']
165     h.'set_value_type'(.DATATYPE_INTVAL)
166     r  = h.'get_value_type'()
167     is(r, .DATATYPE_INTVAL, 'get/set _value_type')
169     r = 1
170     eh = new ['ExceptionHandler']
171     eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED)
172     set_label eh, catch
173     push_eh eh
174     h.'set_value_type'(999999)
175     r = 0
176   catch:
177     is(r, 1, 'set_value_type with invalid type throws')
178 .end
180 .sub null_key
181     new $P0, ['Hash']
182     $P0['yum'] = 5
183     null $S0
184     $I0 = 0
186     $P2 = new ['ExceptionHandler']
187     $P2.'handle_types'(.EXCEPTION_UNEXPECTED_NULL)
188     set_addr $P2, null_ex_eh
189     push_eh $P2
191     $P1 = $P0[$S0]
193     goto check
195 null_ex_eh:
196     $I0 = 1
198 check:
199     pop_eh
200     is( $I0, 1, 'using null string as key throws' )
201 .end
203 .sub hash_keys_with_nulls_in_them
204     new $P0, ['Hash']
205     set $S0, "parp\0me"
206     set $S1, "parp\0you"
208     set $P0[$S0], 1             # $P0{parp\0me} = 1
209     set $P0[$S1], 2             # $P0{parp\0you} = 2
211     set $I0, $P0[$S0]
212     set $I1, $P0[$S1]
214     is( $I0, 1, 'hash key with null 1' )
215     is( $I1, 2, 'hash key will null 2' )
216 .end
218 .sub nearly_the_same_hash_keys
219     new $P0, ['Hash']
220     set $S0, "a\0"
221     set $S1, "\0a"
223     set $P0[$S0], 1
224     set $P0[$S1], 2
226     set $I0, $P0[$S0]
227     set $I1, $P0[$S1]
229     is( $I0, 1, 'hash key with null' )
230     is( $I1, 2, 'almost identical hash key with null' )
231 .end
233 .sub the_same_hash_keys
234     new $P0, ['Hash']
235     set $S0, "Happy"
236     set $S1, "Happy"
238     set $P0[$S0], 1
239     set $I0, $P0[$S0]
240     is( $I0, 1, 'lookup by $S0' )
242     set $P0[$S1], 2
243     set $I1, $P0[$S1]
245     is( $I1, 2, 'set and lookup by $S1 (identical to $S0)' )
246 .end
248 # NB Next test depends on "key2" hashing to zero, which it does with
249 # the current algorithm; if the algorithm changes, change the test!
250 # XXX - really?
252 .sub key_that_hashes_to_zero
253         new $P0, ['Hash']
254         set $S0, "key2"
255         set $P0[$S0], 1
256         set $I0, $P0[$S0]
258         is( $I0, 1, 'key that hashes to zero XXX' )
259 .end
261 .sub size_of_the_hash
262     new $P0, ['Hash']
264     set $P0["0"], 1
265     set $I0, $P0
266     is( $I0, 1, 'hash size of 1' )
268     set $P0["1"], 1
269     set $I0, $P0
270     is( $I0, 2, 'hash size of 2' )
272     set $P0["0"], 1
273     set $I0, $P0
274     is( $I0, 2, 'hash size of 2' )
275 .end
277 .sub stress_test_loop_set_check
278     new $P0, 'Hash'
280         set $I0, 200
281         set $S0, "mikey"
282         set $P0[$S0], "base"
283         concat $S1, $S0, "s"
284         set $P0[$S1], "bases"
285         set $S2, $I0
286         concat $S1, $S0, $S2
287         set $P0[$S1], "start"
288         set $S3, $P0["mikey"]
289         is( $S3, 'base',  'setup: lookup mikey' )
290         set $S3, $P0["mikeys"]
291         is( $S3, 'bases', 'setup: lookup mikeys' )
292         set $S3, $P0["mikey200"]
293         is( $S3, 'start', 'setup: lookup mikey200' )
294 LOOP:
295         eq $I0, 0, DONE
296         sub $I0, $I0, 1
297         set $S2, $I0
298         concat $S1, $S0, $S2
299         concat $S4, $S0, $S2
300         eq $S1, $S4, L1
301         ##  this should be fail(), but it is not implemented yet
302         ok( 0, 'concat mismatch' )
304         set $P0[$S1], $I0
305         set $I1, $P0[$S1]
306         eq $I0, $I1, L2
307         ##  this should be fail(), but it is not implemented yet
308         ok( 0, 'lookup mismatch' )
310         branch LOOP
311 DONE:
312         set $I0, $P0["mikey199"]
313         is( $I0, 199, 'lookup: mikey199' )
314         set $I0, $P0["mikey117"]
315         is( $I0, 117, 'lookup: mikey117' )
316         set $I0, $P0["mikey1"]
317         is( $I0, 1, 'lookup: mikey1' )
318         set $I0, $P0["mikey23"]
319         is( $I0, 23, 'lookup: miky23' )
320         set $I0, $P0["mikey832"]
321         is( $I0, 0, 'lookup: mikey832 (never set)' )
322 .end
324 ## stuff them in, and check periodically that we can pull selected ones out.
325 ##   *_multiple_keys are used by stress_test_lots_of_keys
327 .sub set_multiple_keys
328     .param pmc hash
329     .param int key_index
330     .param int step
331     .param int count
333 again:
334     if count <= 0 goto ret
335     $S0 = key_index
336     $S1 = concat "key", $S0
337     $S2 = concat "value", $S0
338     hash[$S1] = $S2
339     key_index = key_index + step
340     count = count - 1
341     goto again
342 ret:
343 .end
345 .sub delete_multiple_keys
346     .param pmc hash
347     .param int key_index
348     .param int step
349     .param int count
351 again:
352     if count <= 0 goto ret
353     $S0 = key_index
354     $S1 = concat "key", $S0
355     delete hash[$S1]
356     key_index = key_index + step
357     count = count - 1
358     goto again
359 ret:
360 .end
362 .sub check_key
363     .param pmc hash
364     .param int index
366     $S10 = index
367     $S0 = concat "key", $S10
368     $S1 = concat "value", $S10
370     $S2 = hash[$S0]
371     $S3 = concat "correct value for key ", $S10
372     is( $S2, $S1, $S3 )
373 .end
375 .sub stress_test_lots_of_keys
376     new $P30, 'Hash'
377     $I29 = 1
378     $I30 = 1000
379     $I31 = 1000
381     # round 1
382     set_multiple_keys($P30, $I29, $I30, $I31)
383     check_key( $P30, 1 )
384     check_key( $P30, 1001 )
385     check_key( $P30, 2001 )
387     # round 2
388     $I21 = 100000
389     set_multiple_keys($P30, $I21, $I30, $I31)
390     check_key( $P30, 1 )
391     check_key( $P30, 1001 )
392     check_key( $P30, 2001 )
393     check_key( $P30, 100000 )
394     check_key( $P30, 101000 )
395     check_key( $P30, 102000 )
397     # round 3
398     $I22 = 50000
399     set_multiple_keys($P30, $I22, $I29, $I22)
400     check_key( $P30, 1 )
401     check_key( $P30, 1001 )
402     check_key( $P30, 2001 )
403     check_key( $P30, 500000 )
404     check_key( $P30, 510000 )
405     check_key( $P30, 520000 )
407     # round 4
408     delete_multiple_keys($P30, $I22, $I29, $I22)
409     check_key( $P30, 1001 )
410     check_key( $P30, 2001 )
411     $I50 = exists $P30['key50000']
412     $I51 = exists $P30['key51000']
413     $I52 = exists $P30['key52000']
414     is( $I50, 0, 'key50000 does not exist after delete' )
415     is( $I51, 0, 'key51000 does not exist after delete' )
416     is( $I52, 0, 'key52000 does not exist after delete' )
417 .end
419 # Check all values after setting all of them
420 .sub stress_test_loop_set_loop_check
421     new $P0, 'Hash'
423         set $I0, 200
424         set $S0, "mikey"
425 SETLOOP:
426         eq $I0, 0, DONE
427         sub $I0, $I0, 1
428         set $S2, $I0
429         concat $S1, $S0, $S2
430         set $P0[$S1], $I0
431         branch SETLOOP
433         set $I0, 200
434 GETLOOP:
435         eq $I0, 0, DONE
436         sub $I0, $I0, 1
437         set $S2, $I0
438         concat $S1, $S0, $S2
439         set $I1, $P0[$S1]
440         eq $I0, $I1, L2
441           is( $I0, $I1, 'lookup mismatch in stress test loop' )
442           .return()
444         branch GETLOOP
445 DONE:
446         ok( 1, 'stress test: loop set with loop check' )
447 .end
449 .sub testing_two_hash_indices_with_integers_at_a_time
450       new $P0, ['Hash']
452       set $P0["foo"],37
453       set $P0["bar"],-15
455       set $I0,$P0["foo"]
456       is( $I0, 37, 'lookup int in foo' )
458       set $I0,$P0["bar"]
459       is( $I0, -15, 'lookup int in bar' )
461       set $S1,"foo"
462       set $I0,$P0[$S1]
463       is( $I0,37, 'lookup int in foo via var' )
465       set $S1,"bar"
466       set $I0,$P0[$S1]
467       is( $I0,-15, 'lookup int in bar via var' )
468 .end
470 .sub testing_two_hash_indices_with_numbers_at_a_time
471       new $P0, ['Hash']
473       set $P0["foo"],37.100000
474       set $P0["bar"],-15.100000
476       set $N0,$P0["foo"]
477       is( $N0,37.100000, 'lookup num in foo' )
479       set $N0,$P0["bar"]
480       is( $N0,-15.100000, 'lookup num in bar' )
482       set $S1,"foo"
483       set $N0,$P0[$S1]
484       is( $N0,37.100000, 'lookup num in foo via var' )
486       set $S1,"bar"
487       set $N0,$P0[$S1]
488       is( $N0,-15.100000, 'lookup num in bar via var' )
490 .end
492 .sub testing_two_hash_indices_with_strings_at_a_time
493       new $P0, ['Hash']
495       set $P0["foo"],"baz"
496       set $P0["bar"],"qux"
498       set $S0,$P0["foo"]
499       is( $S0,"baz", 'lookup str in foo' )
501       set $S0,$P0["bar"]
502       is( $S0,"qux", 'lookup str in bar' )
504       set $S1,"foo"
505       set $S0,$P0[$S1]
506       is( $S0,"baz", 'lookup str in foo via var' )
508       set $S1,"bar"
509       set $S0,$P0[$S1]
510       is( $S0,"qux", 'lookup str in bar via var' )
512 .end
514 # So far, we have only used INTVALs, FLOATVALs and STRINGs as values
515 # and/or keys. Now we try PMCs.
517 .sub setting_and_getting_scalar_pmcs
518       new $P0, ['Hash']
519       new $P1, ['Integer']
520       new $P2, ['Integer']
522       set $S0, "non-PMC key"
524       set $P1, 10
525       set $P0[$S0], $P1
526       set $P2, $P0[$S0]
527       is( $P2, $P1, 'lookup PMC Integer' )
529       set $P1, -1234.000000
530       set $P0[$S0], $P1
531       set $P2, $P0[$S0]
532       is( $P2, $P1, 'lookup num after PMC Integer in slot' )
534       set $P1, "abcdefghijklmnopq"
535       set $P0[$S0], $P1
536       set $P2, $P0[$S0]
537       is( $P2, $P1, 'lookup string' )
539       new $P1, ['Undef']
540       set $P0[$S0], $P1
541       set $P2, $P0[$S0]
542       typeof $S1, $P2
543       is( $S1, "Undef", 'lookup Undef PMC' )
545 .end
547 .sub setting_scalar_pmcs_and_getting_scalar_values
548       new $P0, ['Hash']
549       new $P1, ['Integer']
551       set $S0, "A rather large key"
553       set $I0, 10
554       set $P1, $I0
555       set $P0[$S0], $P1
556       set $I1, $P0[$S0]
557       is( $I1, $I0, 'lookup PMC and get scalar Int' )
559       set $N0, -1234.000000
560       set $P1, $N0
561       set $P0[$S0], $P1
562       set $N1, $P0[$S0]
563       is( $N1, $N0, 'lookup PMC and get scalar Num' )
565       set $S1, "abcdefghijklmnopq"
566       set $P1, $S1
567       set $P0[$S0], $P1
568       set $S2, $P0[$S0]
569       is( $S2, $S1, 'lookup PMC and get scalar Str' )
571 .end
573 .sub getting_values_from_undefined_keys
574       new $P2, ['Hash']
576       set $I0, $P2["qwerty"]
577       set $N0, $P2["asdfgh"]
578       set $S0, $P2["zxcvbn"]
579       set $P0, $P2["123456"]
581       is( $I0,   0, 'undefined key returns Int 0' )
582       is( $N0, 0.0, 'undefined key returns Num 0.0' )
583       is( $S0,  "", 'undefined key returns Str ""' )
585       $I1 = 1
586       if_null $P0, P0_is_null
587         $I1 = 0
588     P0_is_null:
589       ok( $I1, 'undefined key returns null PMC' )
590 .end
592 .sub setting_and_getting_non_scalar_pmcs
593         new $P0, ['Hash']
594         new $P1, ['ResizablePMCArray']
595         new $P2, ['ResizablePMCArray']
596         set $P1[4],"string"
597         set $P0["one"],$P1
598         set $P2,$P0["one"]
599         set $S0,$P2[4]
600         is( $S0, 'string', 'set and get non-scalar PMCs' )
601 .end
603 .sub testing_clone
604     new $P0, ['Hash']
605     set $S0, "a"
606     set $P0[$S0], $S0
607     new $P2, ['ResizablePMCArray']
608     set $P2, 2
609     set $P0["b"], $P2
611     # $P0 = { a => "a", b => [undef, undef] }
613     clone $P1, $P0
614     set $P0["c"], 4
615     set $P3, $P0["b"]
616     set $P3, 3
617     set $P0["b"], $P3
618     set $P1["a"], "A"
620     # $P0 = { a => "a", b => [undef, undef, undef], c => 4 }
621     # $P1 = { a => "A", b => [undef, undef] }
623     set $S0, $P0["a"]
624     is( $S0, "a", 'original hash lookup pre-clone value' )
626     set $P5, $P0["b"]
627     set $I0, $P5
628     is( $I0, 3, 'original hash lookup post-clone value' )
630     set $I0, $P0["c"]
631     is( $I0, 4, 'original hash lookup post-clone value in new slot' )
633     set $S0, $P1["a"]
634     is( $S0, "A", 'cloned hash lookup post-clone value' )
636     set $P5, $P1["b"]
637     set $I0, $P5
638     is( $I0, 2, 'cloned hash lookup pre-clone complex value' )
640 # XXX: this should return undef or something, but it dies instead.
641 #     set $P3, $P0["c"]
642 #     unless $P3, ok6
643 #     print "not "
644 # ok6:
645 #     print "ok 6\n"
646 .end
648 .sub clone_doesnt_crash_on_deleted_keys
649     .local pmc hash1, hash2
650     .local string key1, key2
651     hash1 = new 'Hash'
652     key1 = 'foo'
653     key2 = 'bar'
654     hash1[key1] = 1
655     hash1[key2] = 2
656     delete hash1[key1]
657     hash2 = clone hash1
658     ok( 1, "clone doesn't crash on deleted keys" )
659 .end
661 # TT #116
662 # This test failure depends on the value if the hash seed, which is randomized.
663 # To try to ensure that the test fails reliably if there's a regression, it's
664 # run 3 times with different hash keys.
665 .sub clone_preserves_order
666     .local pmc h, cloned
667     .local string s1, s2
668     .local int all_ok
670     all_ok = 1
671     h      = new ['Hash']
673     h['a'] = 1
674     h['b'] = 2
675     h['c'] = 3
676     h['d'] = 4
677     h['e'] = 5
678     h['f'] = 6
679     h['g'] = 7
680     h['h'] = 8
681     h['i'] = 9
682     h['j'] = 10
683     h['k'] = 11
684     h['l'] = 12
686     cloned = clone h
687     #If the bug is present, the order of elements in the get_repr string will
688     #be different.
689     s1 = get_repr h
690     s2 = get_repr cloned
692     if s1 != s2 goto fail
694     h = new ['Hash']
696     h['aa'] = 1
697     h['bb'] = 2
698     h['cc'] = 3
699     h['dd'] = 4
700     h['ee'] = 5
701     h['ff'] = 6
702     h['gg'] = 7
703     h['hh'] = 8
704     h['ii'] = 9
705     h['jj'] = 10
706     h['kk'] = 11
707     h['ll'] = 12
709     cloned = clone h
710     s1 = get_repr h
711     s2 = get_repr cloned
712     if s1 != s2 goto fail
714     h = new ['Hash']
716     h['one']    = 1
717     h['two']    = 2
718     h['three']  = 3
719     h['four']   = 4
720     h['five']   = 5
721     h['six']    = 6
722     h['seven']  = 7
723     h['eight']  = 8
724     h['nine']   = 9
725     h['ten']    = 10
726     h['eleven'] = 11
727     h['twelve'] = 12
729     cloned = clone h
730     s1 = get_repr h
731     s2 = get_repr cloned
732     if s1 != s2 goto fail
734     goto end
735 fail:
736     all_ok = 0
737 end:
738     ok(all_ok, "clone preserves hash internal order")
739 .end
741 .sub freeze_thaw_preserves_order
742     # is internal order important somehow?
743     todo("freeze/thaw preserves hash internal order")
744     .return ()
746     .local pmc h, cloned
747     .local string s1, s2
748     .local int all_ok
750     all_ok = 1
751     h      = new ['Hash']
753     h['a'] = 1
754     h['b'] = 2
755     h['c'] = 3
756     h['d'] = 4
757     h['e'] = 5
758     h['f'] = 6
759     h['g'] = 7
760     h['h'] = 8
761     h['i'] = 9
762     h['j'] = 10
763     h['k'] = 11
764     h['l'] = 12
766     $S0 = freeze h
767     cloned = thaw $S0
768     s1 = get_repr h
769     s2 = get_repr cloned
771     if s1 != s2 goto fail
773     h = new ['Hash']
775     h['aa'] = 1
776     h['bb'] = 2
777     h['cc'] = 3
778     h['dd'] = 4
779     h['ee'] = 5
780     h['ff'] = 6
781     h['gg'] = 7
782     h['hh'] = 8
783     h['ii'] = 9
784     h['jj'] = 10
785     h['kk'] = 11
786     h['ll'] = 12
788     $S0 = freeze h
789     cloned = thaw $S0
790     s1 = get_repr h
791     s2 = get_repr cloned
792     if s1 != s2 goto fail
794     h = new ['Hash']
796     h['one']    = 1
797     h['two']    = 2
798     h['three']  = 3
799     h['four']   = 4
800     h['five']   = 5
801     h['six']    = 6
802     h['seven']  = 7
803     h['eight']  = 8
804     h['nine']   = 9
805     h['ten']    = 10
806     h['eleven'] = 11
807     h['twelve'] = 12
809     $S0 = freeze h
810     cloned = thaw $S0
811     s1 = get_repr h
812     s2 = get_repr cloned
813     if s1 != s2 goto fail
815     goto end
816 fail:
817     all_ok = 0
818 end:
819     ok(all_ok, "freeze/thaw preserves hash internal order")
820 .end
822 .sub compound_keys
823     new $P0, ['Hash']
824     new $P1, ['Hash']
825     new $P2, ['ResizablePMCArray']
826     set $P1["b"], "ab"
827     set $P0["a"], $P1
828     set $S0, $P0["a";"b"]
829     is( $S0, "ab", 'Str from compound key' )
831     set $P2[20], 77
832     set $P1["n"], $P2
833     set $I0, $P0["a";"n";20]
834     is( $I0, 77, 'Int from compound key^2' )
836     set $S0, "a"
837     set $S1, "n"
838     set $I0, 20
839     set $I0, $P0[$S0;$S1;$I0]
840     is( $I0, 77, 'Int from indirect compound key^2' )
842     set $P0["c"], $P2
843     set $P2[33], $P1
844     set $S0, $P0["c";33;"b"]
845     is( $S0, "ab", 'Str from indirect/direct compound key^2' )
847     set $S0, "c"
848     set $I1, 33
849     set $S2, "b"
850     set $S0, $P0[$S0;$I1;$S2]
851     is( $S0, "ab", 'Str from indirect compound key^2' )
853     set $P1["b"], 47.11
854     set $N0, $P0["c";$I1;$S2]
855     is( $N0, 47.11, 'Num from indirect compound key^2' )
856 .end
858 .sub getting_pmcs_from_compound_keys
859     new $P0, ['Hash']
860     new $P1, ['Hash']
861     new $P2, ['Integer']
862     set $P2, 12
863     set $P1["b"], $P2
864     set $P0["a"], $P1
865     set $P3, $P0["a";"b"]
866     set $S0, $P3
867     is( $S0, "12", "lookup PMC from compound key" )
868 .end
869 # 12
871 .sub getting_pmcs_from_string_int_compound_keys
872     new $P0, ['Hash']
873     new $P1, ['Hash']
874     new $P2, ['Integer']
875     set $P2, 4
876     set $P1[9], $P2
877     set $I0, $P1[9]
878     is( $I0, 4, 'lookup Int PMC from hash' )
880     set $P0["a"], $P1
881     set $I0, $P0["a";9]
882     is( $I0, 4, 'lookup Inc PMC from compound hash' )
883 .end
885 # A hash is only false if it has size 0
887 .sub if_hash
888     new $P0, ['Hash']
890     ## Could just use Test::More tests directly, but then we are really
891     ## checking casting to Int then testing value (I think)
892     ## ie. ok( $P0, '...' )
894     $I1 = 0
895     if $P0, L1
896       $I1 = 1
897   L1:
898     ok( $I1, 'Empty hash is false' )
900     set $P0["key"], "value"
901     $I1 = 1
902     if $P0, L2
903       $I1 = 0
904   L2:
905     ok( $I1, 'Hash with one slot is true' )
907     set $P0["key"], ""
908     $I1 = 1
909     if $P0, L3
910       $I1 = 0
911   L3:
912     ok( $I1, 'Hash with one value ("") is true' )
914     new $P1, ['Undef']
915     set $P0["key"], $P1
916     $I1 = 1
917     if $P0, L4
918       $I1 = 0
919   L4:
920     ok( $P0, 'Hash with one value (Undef PMC) is true' )
922 .end
924 .sub unless_hash
925     new $P0, ['Hash']
927     $I0 = 1
928     unless $P0, L1
929       $I0 = 0
930   L1:
931     ok( $I0, 'Empty hash is false in unless' )
933     $I0 = 0
934     set $P0["key"], "value"
935     unless $P0, L2
936       $I0 = 1
937   L2:
938     ok( $I0, 'Hash with one value is true' )
940     $I0 = 0
941     set $P0["key"], "\0"
942     unless $P0, L3
943       $I0 = 1
944   L3:
945     ok( $I0, 'Hash with one value ("\0") is true' )
947     $I0 = 0
948     new $P1, ['Undef']
949     set $P0["key"], $P1
950     unless $P0, L4
951       $I0 = 1
952   L4:
953     ok( $I0, 'Hash with one value (Undef PMC) is true' )
955 .end
957 .sub defined_hash
958     new $P0, ['Hash']
960     defined $I0, $P0
961     ok( $I0, 'Empty has is defined' )
963     ## nok() had not been (correctly) implemented when this test was written
965     defined $I0, $P1
966     $I0 = not $I0
967     ok( $I0, 'Unassigned var is undefined' )
969     set $P0["a"], 1
970     defined $I0, $P0["a"]
971     ok( $I0, 'Int in hash value is defined' )
973     defined $I0, $P0["b"]
974     $I0 = not $I0
975     ok( $I0, 'Unassigned hash slot is undefined' )
977     new $P1, ['Undef']
978     set $P0["c"], $P1
979     defined $I0, $P0["c"]
980     $I0 = not $I0
981     ok( $I0, 'Undef PMC in hash slot is undefined' )
982 .end
984 .sub exists_hash_key
985     new $P0, ['Hash']
987     set $P0["a"], 1
988     exists $I0, $P0["a"]
989     ok( $I0, 'assigned hash key exists' )
991     exists $I0, $P0["b"]
992     $I0 = not $I0
993     ok( $I0, 'unassigned hash key does not exist' )
995     new $P1, ['Undef']
996     set $P0["c"], $P1
997     exists $I0, $P0["c"]
998     ok( $I0, 'hash key assigned Undef PMC exists' )
999 .end
1001 .sub delete_hash_key
1002     new $P0, ['Hash']
1004     set $P0["a"], 1
1005     exists $I0, $P0["a"]
1006     ok( $I0, 'assigned hash key exists' )
1008     delete $P0["a"]
1009     exists $I0, $P0["a"]
1010     $I0 = not $I0
1011     ok( $I0, 'delete hash key does not exist' )
1012 .end
1014 .sub cloning_keys
1015     new $P10, ['Hash']
1016     new $P1, ['Key']
1018     set $P1, "Bar"
1019     set $P10[$P1], "Food"
1020     clone $P2, $P1
1021     set $S0, $P10[$P2]
1022     is( $S0, "Food", 'cloned key looks up same value' )
1024     set $S1, "Baa"
1025     set $P10[$S1], "Sheep"
1026     clone $S2, $S1
1027     set $S0, $P10[$S2]
1028     is( $S0, "Sheep", 'cloned key again look up same value' )
1029 .end
1031 .sub cloning_pmc_vals
1032     new $P10, ['Hash']
1034     new $P1, ['Undef']
1035     set $P1, "value"
1036     set $P10["str"], $P1
1038     new $P1, ['Undef']
1039     set $P1, 42
1040     set $P10["int"], $P1
1042     clone $P2, $P10
1043     set $P0, $P2["int"]
1044     is( $P0, 42, 'cloned hash contained pre-clone set int' )
1045     set $P0, $P2["str"]
1046     is( $P0, 'value', 'cloned hash contains pre-clone set str' )
1047 .end
1049 .sub delete_and_free_list
1050     set $I2, 10
1051     set $I1, 1
1052     new $P0, ['FixedPMCArray']
1053     set $P0, 1
1054     new $P1, ['Hash']
1055 outer:
1056     set $P0[0], $I1
1057     sprintf $S0, "ok %vd\n", $P0
1058     set $P1[$S0], $S0
1060     ## set $P1[key]=1 then delete it 100 times
1061     set $I0, 100
1063     set $P1["key"], 1
1064     delete $P1["key"]
1065     dec $I0
1066     if $I0, lp
1068     set $S1, $P1[$S0]
1069     # print $S1
1070     inc $I1
1071     le $I1, $I2, outer
1073     set $I0, $P1
1074     is( $I0, 10, 'hash has size 10' )
1075 .end
1077 ## XXX already tested?
1078 .sub exists_with_constant_string_key
1079     new $P16, ['Hash']
1081     set $P16["key1"], "value for key1"
1082     set $S16, $P16["key1"]
1083     is( $S16, "value for key1" , 'set and lookup value for const str key' )
1085     exists $I17, $P16["key1"]
1086     ok( $I17, 'exists with constant string key' )
1088     exists $I17, $P16["no such"]
1089     $I17 = not $I17
1090     ok( $I17, 'does not exist with unassigned const string key' )
1091 .end
1093 .sub hash_in_pir
1094     .local pmc hash1
1095     hash1 = new ['Hash']
1096     hash1['X'] = 'U'
1097     .local string val1
1098     val1 = hash1['X']
1099     is( val1, "U", 'hash in PIR' )
1100 .end
1102 .sub setting_with_compound_keys
1103     .local pmc outer_hash
1104     outer_hash = new ['Hash']
1105     .local pmc inner_hash
1106     inner_hash = new ['Hash']
1107     .local pmc inner_array
1108     inner_array = new ['ResizablePMCArray']
1109     .local string elem_string
1110     .local int    elem_int
1111     .local pmc    elem_pmc
1112     .local num    elem_num
1114     # setting and retrieving strings in an inner ResizablePMCArray
1115     inner_array[128] = 'inner_array:128'
1116     outer_hash['inner_array'] = inner_array
1117     elem_string = outer_hash['inner_array';128]
1118     is( elem_string, 'inner_array:128', 'string in inner ResizeablePMCArray' )
1119     outer_hash['inner_array';128] = 'changed inner_array:128'
1120     elem_string = outer_hash['inner_array';128]
1121     is( elem_string, 'changed inner_array:128', 'string in inner ResizeablePMCArray' )
1123     # setting and retrieving strings in an inner Hash
1124     inner_hash['129'] = 'inner_hash:129'
1125     outer_hash['inner_hash'] = inner_hash
1126     elem_string = outer_hash['inner_hash';'129']
1127     is( elem_string, 'inner_hash:129', 'string in inner Hash' )
1128     outer_hash['inner_hash';'129'] = 'changed inner_hash:129'
1129     elem_string = outer_hash['inner_hash';'129']
1130     is( elem_string, 'changed inner_hash:129', 'string in inner Hash' )
1132     # setting and retrieving integer in an inner ResizablePMCArray
1133     inner_array[130] = 130
1134     outer_hash['inner_array'] = inner_array
1135     elem_int = outer_hash['inner_array';130]
1136     is( elem_int, 130, 'int in inner ResizablePMCArray' )
1137     outer_hash['inner_array';130] = -130
1138     elem_int = outer_hash['inner_array';130]
1139     is( elem_int, -130, 'int in inner ResizablePMCArray' )
1141     # setting and retrieving integer in an inner Hash
1142     inner_hash['131'] = 131
1143     outer_hash['inner_hash'] = inner_hash
1144     elem_int = outer_hash['inner_hash';'131']
1145     is( elem_int, 131, 'int in inner Hash' )
1146     outer_hash['inner_hash';'131'] = -131
1147     elem_int = outer_hash['inner_hash';'131']
1148     is( elem_int, -131, 'int in inner Hash' )
1150     # setting and retrieving a PMC in an inner ResizablePMCArray
1151     .local pmc in_pmc
1152     in_pmc = new ['String']
1153     in_pmc = 'inner_array:132'
1154     inner_array[132] = in_pmc
1155     outer_hash['inner_array'] = inner_array
1156     elem_pmc = outer_hash['inner_array';132]
1157     is( elem_pmc, 'inner_array:132', 'PMC in inner ResizablePMCArray' )
1158     in_pmc = 'changed inner_array:132'
1159     outer_hash['inner_array';132] = in_pmc
1160     elem_pmc = outer_hash['inner_array';132]
1161     is( elem_pmc, 'changed inner_array:132', 'PMC in inner ResizablePMCArray' )
1163     # setting and retrieving a PMC in an inner Hash
1164     in_pmc = 'inner_array:133'
1165     inner_hash['133'] = in_pmc
1166     outer_hash['inner_hash'] = inner_hash
1167     elem_string = outer_hash['inner_hash';'133']
1168     is( elem_string, 'inner_array:133', 'PMC in inner Hash' )
1169     in_pmc = 'changed inner_hash:133'
1170     outer_hash['inner_hash';'133'] = in_pmc
1171     elem_string = outer_hash['inner_hash';'133']
1172     is( elem_string, 'changed inner_hash:133', 'PMC in inner Hash' )
1174     # setting and retrieving a float in an inner ResizablePMCArray
1175     inner_array[134] = 134.134
1176     outer_hash['inner_array'] = inner_array
1177     elem_num = outer_hash['inner_array';134]
1178     is( elem_num, 134.134000, 'float in inner ResizablePMCArray' )
1179     outer_hash['inner_array';134] = -134.134
1180     elem_num = outer_hash['inner_array';134]
1181     is( elem_num, -134.134000, 'float in inner ResizablePMCArray' )
1183     # setting and retrieving a float in an inner Hash
1184     inner_hash['135'] = 135.135
1185     outer_hash['inner_hash'] = inner_hash
1186     elem_num = outer_hash['inner_hash';'135']
1187     is( elem_num, 135.135000, 'float in inner Hash' )
1188     outer_hash['inner_hash';'135'] = -135.135
1189     elem_num = outer_hash['inner_hash';'135']
1190     is( elem_num, -135.135000, 'float in inner Hash' )
1192 .end
1194 .sub mutating_the_lookup_string
1195     new $P0, ['Hash']
1196     set $P0["a"], "one"
1197     set $P0["ab"], "two"
1198     set $P0["abc"], "three"
1200     set $S0, "a"
1201     set $S1, $P0[$S0]
1202     is( $S1, "one", 'lookup via str in reg' )
1204     concat $S0, "b"
1205     set $S1, $P0[$S0]
1206     is( $S1, "two", 'lookup via concated str in reg' )
1208     concat $S0, "c"
1209     set $S1, $P0[$S0]
1210     is( $S1, "three", 'lookup via concated^2 str in reg' )
1211 .end
1213 .sub check_whether_interface_is_done
1214     .local pmc pmc1
1215     pmc1 = new ['Hash']
1216     .local int bool1
1218     does bool1, pmc1, "scalar"
1219     bool1 = not bool1
1220     ok( bool1, 'Hash PMC does not do scalar' )
1222     does bool1, pmc1, "hash"
1223     ok( bool1, 'Hash PMC does hash' )
1225     does bool1, pmc1, "no_interface"
1226     bool1 = not bool1
1227     ok( bool1, 'Hash PMC does not do no_interface' )
1228 .end
1230 .sub iter_over_hash
1231     new $P0, ['Hash']
1232     set $P0['a'], 'x'
1234     iter $P1, $P0
1235     $I0 = 1
1236     if $P1 goto L1
1237       $I0 = 0
1238   L1:
1239     ok( $I0, 'iterator is true' )
1241     shift $P2, $P1
1242     is( $P2, 'a', 'shifting iterator give the key' )
1244     $I0 = 0
1245     if $P1 goto L2
1246       $I0 = 1
1247   L2:
1248     ok( $I0, 'iterator is now false' )
1249 .end
1251 ## thx to azuroth on irc
1252 .sub broken_delete
1253   .include "iterator.pasm"
1254   .local string result
1255   result = ""
1257   .local pmc thash
1259   # just put in some dummy data...
1260   thash = new ['Hash']
1261   thash["a"] = "b"
1262   thash["c"] = "d"
1263   thash["e"] = "f"
1265   .local pmc it
1266   it = iter thash
1267   it = .ITERATE_FROM_START
1269   .local pmc keys, key
1270   keys = new ['ResizablePMCArray']
1272   # go through the hash, print out all the keys: should be a c and e
1273 preit_loop:
1274   unless it goto preit_end
1276   key = shift it
1277   $S0 = key
1278   push keys, $S0
1280   branch preit_loop
1281 preit_end:
1283   keys.'sort'()
1284   result = join '', keys
1285   is( result, 'ace', 'iterated through keys successfully' )
1287   # get rid of the c element?
1288   delete thash["c"]
1289   keys = new ['ResizablePMCArray']
1291   # what do we have after deletion?
1292   result = ""
1294   it = iter thash
1295   it = .ITERATE_FROM_START
1297   # go through the hash, print out all the keys... I believe it should be a and e?
1298   # it actually outputs a, c and e.
1299 postit_loop:
1300   unless it goto postit_end
1302   key = shift it
1303   $S0 = key
1304   push keys, $S0
1307   branch postit_loop
1308 postit_end:
1310   keys.'sort'()
1311   result = join '', keys
1312   is( result, 'ae', 'the c key was no longer iterated over' )
1313 .end
1315 .sub unicode_keys_register_rt_39249
1316   $P1 = new ['Hash']
1318   $S99 = unicode:"\u7777"
1319   $P1[$S99] = "ok"
1320   $S1 = $P1[$S99]
1321   is( $S1, 'ok', 'unicode key' )
1322 .end
1324 .sub unicode_keys_literal_rt_39249
1325   $P1 = new ['Hash']
1327   $P1[unicode:"\u7777"] = "ok"
1328   $S1 = $P1[unicode:"\u7777"]
1329   is( $S1, 'ok', 'literal unicode key' )
1331   $S2 = unicode:"\u7777"
1332   $S1 = $P1[$S2]
1333   is( $S1, 'ok', 'literal unicode key lookup via var' )
1334 .end
1336 # Switch to use integer keys instead of strings.
1337 .sub integer_keys
1338     .include "hash_key_type.pasm"
1339     .local pmc hash
1340     hash = new ['Hash']
1341     hash = .Hash_key_type_int
1343     hash[0]   = 'foo'
1344     hash[42]  = 'bar'
1345     $S0       = 'foo'
1346     hash[$S0] = 'BAZ'
1348     $S0       = '42 parrots'
1349     hash[$S0] = 'Wins!'
1351     # 'foo' numifies to '0'. So check it
1352     $S0 = hash[0]
1353     is($S0, 'BAZ', 'Key was numified')
1355     # '42 parrots' numifies to '42'. So check it
1356     $S0 = hash[42]
1357     is($S0, 'Wins!', 'Key was numified again')
1358 .end
1360 # Check that we can set various value types and they properly converted
1361 .sub value_types_convertion
1362     .local pmc hash
1363     hash = new ['Hash']
1365     # PMC is first value type
1366     hash.'set_value_type'(.DATATYPE_PMC)
1367     $P0 = new 'Env' # arbitary choice. Just to prevent possible casting.
1368     hash['env'] = $P0
1369     hash['foo'] = 42
1370     hash['bar'] = 21285.06
1371     hash['baz'] = 'forty two'
1373     # Check that original value preserved
1374     $P1 = hash['env']
1375     $I0 = isa $P1, 'Env'
1376     ok($I0, 'Env PMC preserved')
1377     $I0 = hash['foo']
1378     is($I0, 42, 'Intval preserved')
1379     $N0 = hash['bar']
1380     is($N0, 21285.06, 'Number preserved')
1381     $S0 = hash['baz']
1382     is($S0, 'forty two', 'String preserved')
1384     # Clear the Hash and set INTVAL as stored values.
1385     hash.'set_value_type'(.DATATYPE_INTVAL)
1386     hash['foo'] = 42            # Use as-is
1387     hash['bar'] = 21285.06      # Truncate to int
1388     hash['baz'] = 'forty two'   # Cast to int
1390     $I0 = hash['foo']
1391     is($I0, 42, 'Intval preserved with datatype int')
1392     $I0 = hash['bar']
1393     is($I0, 21285, 'Floatval trunkated to int')
1394     $I0 = hash['baz']
1395     is($I0, 0, 'String casted to int')
1397     # TODO Add tests for String.
1398 .end
1400 # Check number of elements in Hash
1401 .sub 'elements_in_hash'
1402     .local pmc hash
1403     hash = new ['Hash']
1405     $I0 = elements hash
1406     is($I0, 0, "Empty hash has 0 items")
1408     hash['foo'] = 'FOO'
1409     $I0 = elements hash
1410     is($I0, 1, "Hash has 1 item")
1412     hash['foo'] = 'BAR'
1413     $I0 = elements hash
1414     is($I0, 1, "Hash still has 1 item after update")
1416     hash['bar'] = 'BAR'
1417     $I0 = elements hash
1418     is($I0, 2, "Hash has 2 items")
1420     delete hash['foo']
1421     $I0 = elements hash
1422     is($I0, 1, "Hash has 1 item after delete")
1424     delete hash['bar']
1425     $I0 = elements hash
1426     is($I0, 0, "Hash has 0 items after delete")
1428 .end
1430 .sub 'equality_tests'
1431     .local pmc hash1, hash2, hash3, hash4, hash5
1432     hash1 = new ['Hash']
1433     hash2 = new ['Hash']
1434     hash3 = new ['Hash']
1435     hash4 = new ['Hash']
1437     hash1['one'] = "Hello Parrot!"
1438     hash1['two'] = 1664
1439     hash1['three'] = 2.718
1441     hash2['ONE'] = "Hello Parrot!"
1442     hash2['TWO'] = 1664
1443     hash2['THREE'] = 2.718
1445     $P0 = box "Hello Parrot!"
1446     hash3['one'] = $P0
1447     $P0 = box 1664
1448     hash3['two'] = $P0
1449     $P0 = box 2.718
1450     hash3['three'] = $P0
1452     hash4['one'] = "Goodbye Parrot!"
1453     hash4['two'] = 1664
1454     hash4['three'] = 2.718
1456     hash5 = clone hash1
1458     isnt(hash1, hash2, 'Hashes with different keys')
1459     is(hash1, hash3, 'Equal hashes, physically disjoint')
1460     isnt(hash1, hash4, 'Different hash values')
1461     is(hash1, hash5, 'Clones are equal')
1462 .end
1464 # Switch to use PMC keys instead of strings.
1465 .sub 'pmc_keys'
1466     .include "hash_key_type.pasm"
1467     .local pmc hash
1468     hash = new ['Hash']
1469     hash = .Hash_key_type_PMC
1471     $P0 = new ['ResizableStringArray']
1472     push $P0, "foo"
1473     hash[$P0] = 'FOO'
1474     # Autoconvert INTVAL to Integer
1475     hash[42]  = 'bar'
1476     $S0       = 'foo'
1477     # Autoconvert STRING to String
1478     hash[$S0] = 'BAZ'
1480     $I0 = elements hash
1481     is($I0, 3, "Got 3 elements in Hash")
1483     # Iterate over keys and get types. We should have 3 different types:
1484     # ResizableStringArray, Integer and String
1485     .local pmc types, it
1486     types = new ['Hash']
1487     it = iter hash
1488   loop:
1489     unless it goto done
1490     $P0 = shift it
1491     $P1 = $P0.'key'()
1492     $S0 = typeof $P1
1493     types[$S0] = 1
1494     goto loop
1495   done:
1497     $I0 = elements types
1498     is($I0, 3, "Got 3 different types of PMC keys")
1499     $I0 = types['ResizableStringArray']
1500     ok($I0, "Including ResizableStringArray")
1501 .end
1503 # Local Variables:
1504 #   mode: pir
1505 #   fill-column: 100
1506 # End:
1507 # vim: expandtab shiftwidth=4 ft=pir: