1#!./parrot
2# Copyright (C) 2011, Parrot Foundation.
3
4.sub 'main' :main
5    .include 'test_more.pir'
6
7    plan(20)
8
9    test_create()
10    test_interp_same_after_compile()
11    test_vtable_get_bool()
12    test_vtable_get_pmc_keyed_int()
13    test_vtable_get_string_keyed_int()
14    test_vtable_get_number_keyed_int()
15    test_method_constant_counts()
16    test_method_main_sub()
17    test_method_subs_by_tag()
18    test_method_subs_by_tag_tag_syntax()
19    test_method_serialized_size()
20    test_method_serialize()
21    test_method_all_subs()
22    test_method_read_from_file()
23    test_method_write_to_file()
24    test_method_deserialize()
25.end
26
27.sub 'test_create'
28    $P0 = new ['PackfileView']
29.end
30
31.sub 'test_interp_same_after_compile'
32    $P0 = getinterp
33    $P2 = compreg "PIR"
34    $S0 = ".sub __init :anon :init\nok(1, 'init function executed on demand')\n.end"
35    $P5 = $P2.'compile'($S0)
36    $P1 = getinterp
37    is_same($P0, $P1, "interp['packfile'] does not change over IMCC invocation")
38.end
39
40.sub 'test_vtable_get_bool'
41    $P0 = new ['PackfileView']
42    if $P0 goto fail_first
43    ok(1, "New PackfileView is false")
44    goto pass_first
45  fail_first:
46    ok(0, "New PackfileView should be empty and false")
47  pass_first:
48
49    $P0 = getinterp
50    $P1 = $P0["packfile"]
51    unless $P1 goto fail_second
52    ok(1, "Current packfileview is not false")
53    goto pass_second
54  fail_second:
55    ok(0, "Current packfileview is false")
56  pass_second:
57.end
58
59.sub 'test_vtable_get_pmc_keyed_int'
60    # TODO
61.end
62
63.sub 'test_vtable_get_string_keyed_int'
64    # TODO
65.end
66
67.sub 'test_vtable_get_number_keyed_int'
68    # TODO
69.end
70
71.sub 'test_method_constant_counts'
72    $P0 = getinterp
73    $P1 = $P0["packfile"]
74    $P2 = $P1.'constant_counts'()
75    $I0 = isa $P2, 'FixedIntegerArray'
76    ok($I0, "packfileview.constant_counts returns a FixedIntegerArray")
77    $I2 = elements $P2
78    is($I2, 3, "packfileview.constant_counts returns 3 types of constants")
79.end
80
81.sub 'test_method_main_sub'
82    $P0 = getinterp
83    $P1 = $P0["packfile"]
84    $P2 = $P1.'main_sub'()
85    .const 'Sub' main_sub = 'main'
86    is($P2, main_sub,"packfileview.main_sub returns the actual main sub")
87.end
88
89# We are executing this file as a program, so :load functions shouldn't be
90# triggered automatically. In the 'test_method_subs_by_tag' test, we do it
91# manually.
92.sub '__onload' :load
93    ok(1, "can manually trigger :load")
94.end
95.sub 'test_method_subs_by_tag'
96    $P0 = getinterp
97    $P1 = $P0["packfile"]
98    $P3 = $P1.'subs_by_tag'("load")
99    $I0 = elements $P3
100    is($I0, 1)
101    $P4 = $P3[0]
102    $P4()
103
104    $P2 = compreg "PIR"
105    $S0 = ".sub __init :anon :init\nok(1, 'init function executed on demand')\n.end"
106    $P5 = $P2.'compile'($S0)
107    $P3 = $P5.'subs_by_tag'("init")
108    $I0 = elements $P3
109    is($I0, 1)
110    $P4 = $P3[0]
111    $P4()
112.end
113
114.sub 'test_method_subs_by_tag_tag_syntax'
115    $P0 = getinterp
116    $P1 = $P0["packfile"]
117
118    $P2 = $P1.'subs_by_tag'("tag-a")
119    $I0 = elements $P2
120    is($I0, 1, "Can get subs marked 'tag-a'")
121
122    $P2 = $P1.'subs_by_tag'("tag-b")
123    $I0 = elements $P2
124    is($I0, 2, "Can get subs marked 'tag-b'")
125
126    $P2 = $P1.'subs_by_tag'("tag-c")
127    $I0 = elements $P2
128    is($I0, 2, "Can get subs marked 'tag-c'")
129
130    # For upgrade, verify that :init is the same as :tag("init")
131    $P2 = compreg "PIR"
132    $S0 = <<'__EOCODE__'
133
134.sub __init_old :init
135    .return("init_old")
136.end
137
138.sub __init_tag :tag("init")
139    .return("init_tag")
140.end
141
142.sub __not_init :tag("something-else")
143    .return("not_init")
144.end
145__EOCODE__
146
147    $P1 = $P2.'compile'($S0)
148    $P3 = $P1.'subs_by_tag'("init")
149    $I0 = elements $P3
150    is($I0, 2)
151.end
152
153.sub 'test_method_serialized_size'
154    $P0 = new ['PackfileView']
155    $I0 = $P0.'serialized_size'()
156    is($I0, 0, "Empty PackfileView has serialized_size 0")
157
158    $P0 = getinterp
159    $P1 = $P0["packfile"]
160    $I0 = $P1.'serialized_size'()
161    isnt($I0, 0, "non-empty PackfileView has serialized_size != 0")
162.end
163
164.sub 'test_method_serialize'
165    $P0 = new ['PackfileView']
166    $S0 = $P0.'serialize'()
167    is($S0, "", "Empty PackfileView serializes to empty string")
168
169    $P0 = getinterp
170    $P1 = $P0["packfile"]
171    $S0 = $P1.'serialize'()
172    isnt($S0, "", "Non-empty PackfileView serializes to non-empty string")
173.end
174
175.sub 'test_method_deserialize'
176    # TODO
177.end
178
179.sub 'test_method_all_subs'
180    $P0 = getinterp
181    $P1 = $P0["packfile"]
182    $P2 = $P1.'all_subs'()
183    $S0 = typeof $P2
184    is($S0, "ResizablePMCArray")
185    $I0 = elements $P2
186    isnt($I0, 0)
187
188    # TODO: Should we iterate over all subs, and verify that they are all
189    # Sub objects?
190.end
191
192.sub 'test_method_read_from_file'
193    # TODO: Would really like temporary files for this. GH #517
194.end
195
196.sub 'test_method_write_to_file'
197    # TODO: Would really like temporary files for this. GH #517
198.end
199
200# Subs with :tag syntax
201.sub 'tag1' :tag("tag-a")
202    .return('tag1')
203.end
204
205.sub 'tag2' :tag("tag-b")
206    .return('tag2')
207.end
208
209.sub 'tag3' :tag("tag-c")
210    .return('tag3')
211.end
212
213.sub 'tag4' :tag("tag-c", "tag-b")
214    .return('tag4')
215.end
216
217# Helper method
218.sub 'is_same'
219    .param pmc x
220    .param pmc y
221    .param string msg
222    $I0 = issame x, y
223    'ok'($I0, msg)
224.end
225
226# Local Variables:
227#   mode: pir
228#   fill-column: 100
229# End:
230# vim: expandtab shiftwidth=4 ft=pir:
231