t/pmc/fixedstringarray.t

   1 #!./parrot
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/fixedstringarray.t - FixedStringArray PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/fixedstringarray.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests C<FixedStringArray> 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(50)
  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_clone()
  33     test_clone_unitialized()
  34     test_truth()
  35     test_get_iter()
  36     test_freez_thaw()
  37     test_get_string()
  38     test_equality()
  39     test_gc()
  40     test_number()
  41     test_new_style_init()
  42     test_invalid_init_tt1509()
  43 .end
  44
  45 .sub 'test_set_size'
  46     $P0 = new ['FixedStringArray']
  47
  48     $I0 = $P0
  49     is($I0, 0, "Fresh array has 0 elements")
  50
  51     $P0 = 42
  52     $I0 = $P0
  53     is($I0, 42, "Size was set correctly")
  54 .end
  55
  56 .sub 'test_reset_size'
  57     $P0 = new ['FixedStringArray']
  58
  59     $I0 = 1
  60     $P0 = 1
  61     push_eh handled
  62     $P0 = 2
  63     $I0 = 0
  64   handled:
  65     pop_eh
  66
  67     ok($I0, "Can't resize")
  68 .end
  69
  70
  71 .sub 'test_set_first'
  72     $P0 = new ['FixedStringArray']
  73     $P0 = 1
  74
  75     $P0[0] = -7
  76     $I0 = $P0[0]
  77     is($I0, -7, "First element set to integer properly")
  78
  79     $P0[0] = 3.7
  80     $N0 = $P0[0]
  81     is($N0, 3.7, "First element set to number properly")
  82
  83     $P0[0] = "muwhahaha"
  84     $S0 = $P0[0]
  85     is($S0, "muwhahaha", "First element set to string properly")
  86 .end
  87
  88
  89 .sub 'test_set_second'
  90     $P0 = new ['FixedStringArray']
  91     $P0 = 2
  92
  93     $P0[1] = -7
  94     $I0 = $P0[1]
  95     is($I0, -7, "Second element set to integer properly")
  96
  97     $P0[1] = 3.7
  98     $I0 = $P0[1]
  99     is($I0, 3, "Second element set to number properly")
 100
 101     $P0[1] = "purple"
 102     $S0 = $P0[1]
 103     is($S0, "purple", "Second element set to string properly")
 104 .end
 105
 106 .sub 'test_out_of_bounds'
 107     $P0 = new ['FixedStringArray']
 108     $P0 = 1
 109
 110     $I0 = 1
 111     push_eh handle_set
 112     $P0[2] = 7
 113     $I0 = 0
 114   handle_set:
 115     ok($I0, "Can't set out-of-bounds element")
 116     pop_eh
 117
 118     $I0 = 1
 119     push_eh handle_set_negative
 120     $P0[-42] = 7
 121     $I0 = 0
 122   handle_set_negative:
 123     ok($I0, "Can't set element on negative index")
 124     pop_eh
 125
 126     $I0 = 1
 127     push_eh handle_get
 128     $I1 = $P0[2]
 129     $I0 = 0
 130   handle_get:
 131     ok($I0, "Can't get out-of-bounds element")
 132     pop_eh
 133
 134     $I0 = 1
 135     push_eh handle_get_negative
 136     $I1 = $P0[-1]
 137     $I0 = 0
 138   handle_get_negative:
 139     ok($I0, "Can't get element with negative index")
 140     pop_eh
 141
 142 .end
 143
 144
 145 # Set via PMC keys, access via INTs
 146 .sub 'test_set_via_pmc'
 147     $P0 = new ['FixedStringArray']
 148     $P0 = 3
 149
 150     $P1 = new ['Key']
 151
 152     $P1 = 0
 153     $P0[$P1] = 25
 154     $S0 = $P0[0]
 155     is($S0, "25", "Set INTVAL via PMC Key works")
 156
 157     $P1 = 1
 158     $P0[$P1] = 2.5
 159     $S0 = $P0[1]
 160     is($S0, "2.5", "Set FLOATVAL via PMC Key works")
 161
 162     $P1 = 2
 163     $P0[$P1] = "bleep"
 164     $S0 = $P0[2]
 165     is($S0, "bleep", "Set STRING via PMC Key works")
 166 .end
 167
 168 # Set via INTs, access via PMC Keys
 169 .sub 'test_get_via_pmc'
 170     $P0 = new ['FixedStringArray']
 171     $P0 = 1024
 172
 173     $P0[25]   = 125
 174     $P0[128]  = 10.2
 175     $P0[513]  = "blah"
 176
 177     $P1 = new ['Integer']
 178     $P1 = 123456
 179     $P0[1023] = $P1
 180
 181     $P2 = new ['Key']
 182
 183     $P2 = 25
 184     $I0 = $P0[$P2]
 185     is($I0, 125, "Get INTVAL via Key works")
 186
 187     $P2 = 128
 188     $N0 = $P0[$P2]
 189     is($N0, 10.2, "Get FLOATVAL via Key works")
 190
 191     $P2 = 513
 192     $S0 = $P0[$P2]
 193     is($S0, "blah", "Get STRING via Key works")
 194
 195     $P2 = 1023
 196     $I0 = $P0[$P2]
 197     is($I0, 123456, "Get INTVAL for stored PMC via Key works")
 198
 199 .end
 200
 201
 202 .sub 'test_interface_done'
 203     .local pmc pmc1
 204     pmc1 = new ['FixedStringArray']
 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
 215 .sub 'test_clone'
 216      new $P0, ['FixedStringArray']
 217      set $P0, 3
 218      set $P0[0], "abcde"
 219      set $P0[1], "fghi"
 220      set $P0[2], "jkl"
 221      clone $P1, $P0
 222      set $P0[0], ""
 223      set $P0[1], ""
 224      set $P0[2], ""
 225      set $S0, $P1[0]
 226      is($S0, "abcde", "First element cloned")
 227      set $S0, $P1[1]
 228      is($S0, "fghi", "Second element cloned")
 229      set $S0, $P1[2]
 230      is($S0, "jkl", "Third element cloned")
 231 .end
 232
 233 .sub 'test_clone_unitialized'
 234     $P0 = new ['FixedStringArray']
 235     $P1 = clone $P0
 236
 237     $I0 = 0
 238     push_eh clone_1
 239     $P0 = 10
 240     $P1 = 20
 241     $I0 = 1
 242   clone_1:
 243     pop_eh
 244     ok($I0, "Resize of uninitialized clone successful")
 245
 246     $I1 = 1
 247     push_eh clone_2
 248     $P2 = clone $P0
 249     $P2 = 30
 250     $I0 = 0
 251   clone_2:
 252     ok($I0, "Resize of initialization not successful")
 253     pop_eh
 254
 255 .end
 256
 257 .sub 'test_truth'
 258     $P0 = new ['FixedStringArray']
 259     nok($P0, "Empty array is false")
 260     $P0 = 10
 261     ok($P0, "Non-empty array is true")
 262 .end
 263
 264 .sub 'test_gc'
 265     $P0 = new ['FixedStringArray']
 266     $P0 = 8192
 267
 268     $I0 = 0
 269   loop:
 270     $P0[$I0] = $I0
 271     inc $I0
 272     sweep 1
 273     if $I0 < 8192 goto loop
 274
 275     $S0 = $P0[1000]
 276     is($S0, "1000", "1000th element survived")
 277     $S0 = $P0[2000]
 278     is($S0, "2000", "2000th element survived")
 279     $S0 = $P0[4000]
 280     is($S0, "4000", "4000th element survived")
 281     $S0 = $P0[8000]
 282     is($S0, "8000", "8000th element survived")
 283 .end
 284
 285 .sub 'test_get_iter'
 286     $P0 = new ['FixedStringArray']
 287     $P0 = 3
 288     $P0[0] = "foo"
 289     $P0[1] = "bar"
 290     $P0[2] = "baz"
 291     $S0 = ""
 292     $P1 = iter $P0
 293   loop:
 294     unless $P1 goto loop_end
 295     $S2 = shift $P1
 296     concat $S0, $S2
 297     goto loop
 298   loop_end:
 299     is($S0, "foobarbaz", "Iteration works")
 300 .end
 301
 302 .sub 'test_freez_thaw'
 303     .local pmc fsa, it
 304     .local string s
 305
 306     new fsa, ['FixedStringArray']
 307     fsa = 5
 308     fsa[0] = 42
 309     fsa[1] = 43
 310     fsa[2] = 44
 311     fsa[3] = 99
 312     fsa[4] = 101
 313
 314     s = freeze fsa
 315     fsa = thaw s
 316
 317     it = iter fsa
 318     $S0 = ""
 319   loop:
 320     unless it goto loop_end
 321     s = shift it
 322     concat $S0, s
 323     goto loop
 324   loop_end:
 325     is($S0, "42434499101", "get_iter works")
 326 .end
 327
 328 .sub 'test_get_string'
 329     $P0 = new ['FixedStringArray']
 330     $P0 = 2
 331     $P0[0] = "foo"
 332     is($P0, '[ "foo", "" ]', "Array stringified properly")
 333 .end
 334
 335 .sub 'test_equality'
 336     .local pmc a1, a2, other
 337     .local int i
 338     .local string s
 339     a1 = new ['FixedStringArray']
 340     a2 = new ['FixedStringArray']
 341     other = new ['Integer']
 342
 343     is(a1, a2, "Empty arrays are equal")
 344
 345     i = iseq a1, other
 346     is(i, 0, "Not equal to other type")
 347
 348     a1 = 3
 349     isnt(a1, a2, "Different size arrays aren't equal")
 350
 351     a2 = 3
 352
 353     a1[0] = "foo"
 354     a2[0] = "foo"
 355     is(a1, a2, "Equal with first element set")
 356
 357     a1[1] = "bar"
 358     a2[1] = "BAR"
 359     isnt(a1, a2, "Not equal when second element differ")
 360
 361     a2[1] = "bar"
 362     is(a1, a2, "Equal when second element same")
 363
 364     null s
 365     a2[1] = s
 366     isnt(a1, a2, "Not equal when second element is null")
 367 .end
 368
 369
 370 .sub 'test_number'
 371     .local pmc fsa
 372     fsa = new ['FixedStringArray']
 373     fsa = 3
 374
 375     $I0 = fsa
 376     is($I0, 3, "get_integer returns correct size")
 377     $N0 = fsa
 378     is($N0, 3.0, "get_number returns correct size")
 379 .end
 380
 381 .sub 'test_new_style_init'
 382     $P0 = new 'FixedStringArray', 10
 383
 384     $I0 = $P0
 385     is($I0, 10, "New style init creates the correct # of elements")
 386
 387     $P0 = new ['FixedStringArray'], 10
 388
 389     $I0 = $P0
 390     is($I0, 10, "New style init creates the correct # of elements for a key constant")
 391 .end
 392
 393 .sub test_invalid_init_tt1509
 394     throws_substring(<<'CODE', 'FixedStringArray: Cannot set array size to a negative number (-10)', 'New style init does not dump core for negative array lengths')
 395     .sub main
 396         $P0 = new ['FixedStringArray'], -10
 397     .end
 398 CODE
 399
 400     throws_substring(<<'CODE', 'FixedStringArray: Cannot set array size to a negative number (-10)', 'New style init (key constant) does not dump core for negative array lengths')
 401     .sub main
 402         $P0 = new 'FixedStringArray', -10
 403     .end
 404 CODE
 405 .end
 406
 407 # Local Variables:
 408 #   mode: pir
 409 #   fill-column: 100
 410 # End:
 411 # vim: expandtab shiftwidth=4 ft=pir: