1#!./parrot 2# Copyright (C) 2001-2014, Parrot Foundation. 3 4=head1 NAME 5 6t/pmc/fixedintegerarray.t - FixedIntegerArray PMC 7 8=head1 SYNOPSIS 9 10 % prove t/pmc/fixedintegerarray.t 11 12=head1 DESCRIPTION 13 14Tests C<FixedIntegerArray> PMC. Checks size, sets various elements, including 15out-of-bounds test. Checks INT and PMC keys. 16 17=cut 18 19.sub 'main' :main 20 .include 'test_more.pir' 21 22 test_set_size() 23 test_reset_size() 24 test_set_first() 25 test_set_second() 26 test_out_of_bounds() 27 test_set_via_pmc() 28 test_get_via_pmc() 29 test_interface_done() 30 test_get_iter() 31 test_equality() 32 test_repr() 33 test_sort() 34 test_new_style_init() 35 test_invalid_init_tt1509() 36 test_custom_cmp() 37 38 done_testing() 39.end 40 41.sub 'test_new_style_init' 42 $P0 = new 'FixedIntegerArray', 10 43 44 $I0 = $P0 45 is($I0, 10, "New style init creates the correct # of elements") 46 47 $P0 = new ['FixedIntegerArray'], 10 48 49 $I0 = $P0 50 is($I0, 10, "New style init creates the correct # of elements for a key constant") 51.end 52 53.sub 'test_set_size' 54 $P0 = new ['FixedIntegerArray'] 55 56 $I0 = $P0 57 is($I0, 0, "Fresh array has 0 elements") 58 59 $P0 = 42 60 $I0 = $P0 61 is($I0, 42, "Size was set correctly") 62.end 63 64.sub 'test_reset_size' 65 $P0 = new ['FixedIntegerArray'] 66 67 $I0 = 1 68 $P0 = 1 69 push_eh handled 70 $P0 = 2 71 $I0 = 0 72 handled: 73 pop_eh 74 75 ok($I0, "Can't resize") 76.end 77 78.sub 'test_set_first' 79 $P0 = new ['FixedIntegerArray'] 80 $P0 = 1 81 82 $P0[0] = -7 83 $I0 = $P0[0] 84 is($I0, -7, "First element set to integer properly") 85 86 $P0[0] = 3.7 87 $I0 = $P0[0] 88 is($I0, 3, "First element set to number properly") 89 90 $P0[0] = "17" 91 $I0 = $P0[0] 92 is($I0, 17, "First element set to string properly") 93.end 94 95.sub 'test_set_second' 96 $P0 = new ['FixedIntegerArray'] 97 $P0 = 2 98 99 $P0[1] = -7 100 $I0 = $P0[1] 101 is($I0, -7, "Second element set to integer properly") 102 103 $P0[1] = 3.7 104 $I0 = $P0[1] 105 is($I0, 3, "Second element set to number properly") 106 107 $P0[1] = "17" 108 $I0 = $P0[1] 109 is($I0, 17, "Second element set to string properly") 110.end 111 112 113.sub 'test_out_of_bounds' 114 $P0 = new ['FixedIntegerArray'] 115 $P0 = 1 116 117 $I0 = 1 118 push_eh handle_set 119 $P0[2] = 7 120 $I0 = 0 121 handle_set: 122 ok($I0, "Can't set out-of-bounds element") 123 124 $P0[-1] = 7 125 $I0 = $P0[-1] 126 is($I0, 7, "Can set and get element on negative index") 127 128 $I0 = 1 129 push_eh handle_get 130 $I1 = $P0[2] 131 $I0 = 0 132 handle_get: 133 ok($I0, "Can't get out-of-bounds element") 134 135 $I0 = 1 136 push_eh handle_get_negative 137 $I1 = $P0[-4] 138 $I0 = 0 139 handle_get_negative: 140 ok($I0, "Can't get negative out-of-bounds element") 141.end 142 143# Set via PMC keys, access via INTs 144.sub 'test_set_via_pmc' 145 $P0 = new ['FixedIntegerArray'] 146 $P0 = 3 147 148 $P1 = new ['Key'] 149 150 $P1 = 0 151 $P0[$P1] = 25 152 $I0 = $P0[0] 153 is($I0, 25, "Set INTVAL via PMC Key works") 154 155 $P1 = 1 156 $P0[$P1] = 2.5 157 $I0 = $P0[1] 158 is($I0, 2, "Set FLOATVAL via PMC Key works") 159 160 $P1 = 2 161 $P0[$P1] = "17" 162 $I0 = $P0[2] 163 is($I0, 17, "Set STRING via PMC Key works") 164.end 165 166# Set via INTs, access via PMC Keys 167.sub 'test_get_via_pmc' 168 $P0 = new ['FixedIntegerArray'] 169 $P0 = 1024 170 171 $P0[25] = 125 172 $P0[128] = 10.2 173 $P0[513] = "17" 174 175 $P1 = new ['Integer'] 176 $P1 = 123456 177 $P0[1023] = $P1 178 179 $P2 = new ['Key'] 180 181 $P2 = 25 182 $I0 = $P0[$P2] 183 is($I0, 125, "Get INTVAL via Key works") 184 185 $P2 = 128 186 $N0 = $P0[$P2] 187 is($N0, 10.0, "Get FLOATVAL via Key works") 188 189 $P2 = 513 190 $S0 = $P0[$P2] 191 is($S0, "17", "Get STRING via Key works") 192 193 $P2 = 1023 194 $I0 = $P0[$P2] 195 is($I0, 123456, "Get INTVAL for stored PMC via Key works") 196 197.end 198 199.sub 'test_interface_done' 200 .local pmc pmc1 201 pmc1 = new ['FixedIntegerArray'] 202 .local int bool1 203 does bool1, pmc1, "scalar" 204 nok(bool1, "Does not scalar") 205 does bool1, pmc1, "array" 206 ok(bool1, "Does array") 207 does bool1, pmc1, "no_interface" 208 nok(bool1, "Does not no_interface") 209.end 210 211.sub 'test_get_iter' 212 $P0 = new ['FixedIntegerArray'] 213 $P0 = 3 214 $P0[0] = 42 215 $P0[1] = 43 216 $P0[2] = 44 217 $S0 = "" 218 $P1 = iter $P0 219 loop: 220 unless $P1 goto loop_end 221 $S2 = shift $P1 222 $S0 = concat $S0, $S2 223 goto loop 224 loop_end: 225 is($S0, "424344", "Iteration works") 226.end 227 228.sub 'test_equality' 229 .local pmc a1, a2, a3 230 a1 = new ['FixedIntegerArray'] 231 a2 = new ['FixedIntegerArray'] 232 233 is(a1, a2, "Empty arrays are equal") 234 235 a1 = 3 236 isnt(a1, a2, "Different size arrays aren't equal") 237 238 a2 = 3 239 240 a1[0] = 42 241 a2[0] = 42 242 is(a1, a2, "Equal with first element set") 243 244 a1[1] = 84 245 isnt(a1, a2, "Not equal when second element differ") 246 247 a2[1] = 84 248 is(a1, a2, "Equal when second element same") 249 250 a3 = new ['Complex'] 251 isnt(a1, a3, "Different PMC type is not equal") 252.end 253 254.sub 'test_repr' 255 .local pmc a1 256 .local string r 257 a1 = new ['FixedIntegerArray'] 258 a1 = 2 259 a1[0] = 7 260 a1[1] = 1 261 r = get_repr a1 262 is(r, '[ 7, 1 ]', 'get_repr') 263 r = a1 264 is(r, '[ 7, 1 ]', 'get_string') 265.end 266 267.sub 'test_new_style_init' 268 $P0 = new ['FixedIntegerArray'], 10 269 270 $I0 = $P0 271 is($I0, 10, "New style init creates the correct # of elements") 272.end 273 274.sub 'test_sort' 275 .local pmc a1, a2 276 a1 = new ['FixedIntegerArray'], 3 277 a1[0] = 7 278 a1[1] = 1 279 a1[2] = 5 280 281 a2 = new ['FixedIntegerArray'], 3 282 a2[0] = 1 283 a2[1] = 5 284 a2[2] = 7 285 286 a1.'sort'() 287 $I0 = iseq a1, a2 288 is($I0, 1, 'default sort') 289.end 290 291.sub test_invalid_init_tt1509 292 throws_substring(<<'CODE', 'illegal argument', 'New style init does not dump core for negative array lengths') 293 .sub main :main 294 $P0 = new ['FixedIntegerArray'], -10 295 .end 296CODE 297 298 throws_substring(<<'CODE', 'illegal argument', 'New style init (key constant) does not dump core for negative array lengths') 299 .sub main :main 300 $P0 = new 'FixedIntegerArray', -10 301 .end 302CODE 303.end 304 305.sub test_custom_cmp 306 $P0 = new ['FixedIntegerArray'] 307 $P0 = 3 308 $P0[0] = 1 309 $P0[1] = 2 310 $P0[2] = 3 311 $P1 = get_global 'sorter' 312 $P0.'sort'($P1) 313 $S0 = join ' ', $P0 314 is( $S0, '1 2 3', 'FIA sorted with custom cmp function' ) 315.end 316 317.sub sorter 318 .param pmc a 319 .param pmc b 320 321 $I0 = a > b 322 .return ($I0) 323.end 324 325 326 327# Local Variables: 328# mode: pir 329# fill-column: 100 330# End: 331# vim: expandtab shiftwidth=4 ft=pir: 332