t/pmc/fixedintegerarray.t

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