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