t/pmc/resizableintegerarray.t

   1 #! parrot
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/resizableintegerarray.t - Tests for the ResizableIntegerArray PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/resizableintegerarray.t
  12
  13 =head1 DESCRIPTION
  14
  15 This tests the C<ResizableIntegerArray> PMC. It checks size, sets various
  16 elements, including out-of-bounds test as well as INT and PMC keys.
  17
  18 =cut
  19
  20 =for notes
  21
  22 Coverage plan:
  23
  24  * Get & Set Size
  25
  26  * Get & Set Element
  27      * Type of value (int, num, string, pmc)
  28      * Type of index (int, pmc)
  29      * index negative/in-range/beyond-end
  30      * Set doesn't clobber other elements
  31
  32  * Push/Unshift, Pop/Shift
  33      * Correct values
  34      * Correct sequence
  35      * Correctly resized
  36
  37  * Iterator
  38      * Doesn't change array size
  39      * Multiple concurrent iterators don't interfere
  40
  41 =cut
  42
  43 .sub main :main
  44     .include 'test_more.pir'
  45     plan(41)
  46
  47     test_does_interfaces()
  48
  49     test_get_size()
  50     test_resize()
  51     test_distinct_storage()
  52
  53     test_cant_set_negative()
  54     test_cant_get_negative()
  55     test_set_beyond_end()
  56     test_get_beyond_end()
  57
  58     test_conversion()
  59     test_conversion_overflow()
  60
  61     test_set_pmc_index()
  62     test_get_pmc_index()
  63
  64     test_push()
  65     test_pop()
  66     test_pop_many()
  67     test_push_many()
  68     test_push_pop()
  69     test_cant_pop_empty()
  70     test_shift()
  71     test_unshift()
  72     test_iterator()
  73 .end
  74
  75 .sub test_does_interfaces
  76     $P0 = new ['ResizableIntegerArray']
  77     ok( 1, 'Instantiated ResizableIntegerArray PMC' )
  78     $I0 = does $P0, 'array'
  79     ok( $I0, 'Interface does "array"' )
  80     $I0 = does $P0, 'scalar'
  81     is( $I0, 0, 'Interface does not do "scalar"' )
  82     $I0 = does $P0, 'no_interface'
  83     is( $I0, 0, 'Interface does not do "no_interface"' )
  84 .end
  85
  86 .sub test_get_size
  87     $P0 = new ['ResizableIntegerArray']
  88     $I0 = $P0
  89     is( $I0, 0, 'Initial array size is 0' )
  90     $I1 = elements $P0
  91     is( $I0, $I1, '... and "elements" opcode agrees' )
  92 .end
  93
  94 .sub test_resize
  95     $P0 = new ['ResizableIntegerArray']
  96     $I1 = 0
  97
  98     $P0 = 1
  99     $I0 = $P0
 100     ne $I0, 1, X1
 101     inc $I1
 102
 103     $P0 = 9
 104     $I0 = $P0
 105     ne $I0, 9, X1
 106     inc $I1
 107
 108     $P0 = 5
 109     $I0 = $P0
 110     ne $I0, 5, X1
 111     inc $I1
 112
 113     $P0 = 99999
 114     $I0 = $P0
 115     ne $I0, 99999, X1
 116     inc $I1
 117
 118     $P0 = 0
 119     $I0 = $P0
 120     ne $I0, 0, X1
 121     inc $I1
 122
 123     $P0 = 77
 124     $I0 = $P0
 125     ne $I0, 77, X1
 126     inc $I1
 127
 128 X1:
 129     is( $I1, 6, 'Setting array size (four different values, including 0)' )
 130
 131     $I2 = elements $P0
 132     is( $I0, $I2, '... and "elements" opcode still agrees' )
 133
 134     push_eh E
 135     $I1 = 1
 136     $P0 = -4
 137     $I1 = 0
 138 E:
 139     pop_eh
 140     ok( $I1, 'Setting negative size should throw an exception' )
 141 .end
 142
 143 .sub test_distinct_storage
 144     # Walk the array in pseudo-random order
 145     # Pick a sample size $I4 and another number $I2, such that
 146     #   ∀n: n > 0 ∧ $I2 ⁿ % $I4 = 1 ⇒ n % $I4 = 0
 147     $I4 = 17
 148     $I2 = 3
 149     # Create and fill array in random order
 150     $P0 = new ['ResizableIntegerArray']
 151     $P0 = $I4
 152 #   say '\n ... checking that pseudo-random sequence is exhaustive ...'
 153     $I0 = 1
 154 L1:
 155 #   say $I0
 156     $I0 = mul $I0, $I2
 157     $I0 = mod $I0, $I4
 158     $P0[$I0] = $I0
 159     gt $I0, 1, L1
 160     $P0[0] = 0
 161 #   say 0
 162     # Read back array and check values match
 163     $I0 = 0
 164 L2:
 165     $I1 = $P0[$I0]
 166     ne $I1, $I0, X1
 167     inc $I0
 168     lt $I0, $I4, L2
 169 X1:
 170     is( $I0, $I4, 'All array elements stored separately' )
 171 .end
 172
 173 .sub test_cant_set_negative
 174     $P0 = new ['ResizableIntegerArray']
 175     $P0 = 1
 176     $I0 = 1
 177     push_eh eh
 178     $P0[-1] = -7
 179     $I0 = 0
 180 eh:
 181     pop_eh
 182     ok( $I0, 'Setting with negative index should throw an exception' )
 183 .end
 184
 185 .sub test_cant_get_negative
 186     $P0 = new ['ResizableIntegerArray']
 187     $P0 = 1
 188     $I0 = 1
 189     push_eh eh
 190     $I0 = $P0[-1]
 191     $I0 = 0
 192 eh:
 193     pop_eh
 194     ok( $I0, 'Getting with negative index should throw an exception' )
 195 .end
 196
 197 .sub test_set_beyond_end
 198     $P0 = new ['ResizableIntegerArray']
 199     $P0 = 1
 200     $I0 = 0
 201     push_eh eh
 202     $P0[1] = -7
 203     $I0 = 1
 204 eh:
 205     pop_eh
 206     ok( $I0, 'Setting with too-big index should not throw an exception' )
 207
 208     $I0 = $P0
 209     is( $I0, 2, '... and should extend array' )
 210 .end
 211
 212 .sub test_get_beyond_end
 213     $P0 = new ['ResizableIntegerArray']
 214     $P0 = 1
 215     $I0 = 1
 216     push_eh eh
 217     $I1 = $P0[1]
 218     $I0 = 1
 219 eh:
 220     pop_eh
 221     ok( $I0, 'Getting with too-big index should not throw an exception' )
 222     is( $I1, 0, '... and result should be 0' )
 223
 224     $I0 = $P0
 225     is( $I0, 1, '... and should not extend array' )
 226 .end
 227
 228 .sub test_conversion
 229     $P0 = new ['ResizableIntegerArray']
 230     $P0 = 6
 231     $P0[0] = -7
 232     $P0[1] = 3.7
 233     $P0[2] = '17'
 234     $P1 = new ['Integer']
 235     $P1 = 123456
 236     $P0[3] = $P1
 237     $P2 = new ['Float']
 238     $P2 = 7.3
 239     $P0[4] = $P2
 240     $P3 = new ['String']
 241     $P3 = '987654321'
 242     $P0[5] = $P3
 243     $I0 = $P0[0]
 244     is( $I0, -7, 'Setting element to integer' )
 245     $N0 = $P0[1]
 246     is( $N0, 3.0, 'Setting element to float (gets truncated)' )
 247     $S0 = $P0[2]
 248     is( $S0, '17', 'Setting element to string (gets converted to int and back)' )
 249     $I0 = $P0[3]
 250     is( $I0, 123456, 'Setting element to boxed integer' )
 251     $N0 = $P0[4]
 252     is( $N0, 7.0, 'Setting element to boxed float (gets truncated)' )
 253     $S0 = $P0[5]
 254     is( $S0, '987654321', 'Setting element to boxed string (gets converted to int and back)' )
 255 .end
 256
 257 .sub test_conversion_overflow
 258     $P0 = new ['ResizableIntegerArray']
 259     $P0 = 1
 260
 261     $S0 = '12345678901234567890123456789012345678901234567890123456789012345678901234567890'
 262
 263     push_eh eh0
 264     $I1 = 1
 265         $P0[0] = $S0
 266         $I0 = $P0[0]
 267     $I1 = 0
 268 eh0:
 269     pop_eh
 270     ok( $I1, 'Throw exception when setting element to too-large digit-string' )
 271
 272 .end
 273
 274 .sub test_set_pmc_index
 275     $P0 = new ['ResizableIntegerArray']
 276     $P1 = new ['Key']
 277     $P1 = 0
 278     $P0[$P1] = 25
 279     $P1 = 1
 280     $P0[$P1] = 2.5
 281     $P1 = 2
 282     $P0[$P1] = '17'
 283
 284     $I1 = 0
 285
 286     $I0 = $P0[0]
 287     ne $I0, 25, X1
 288     inc $I1
 289
 290     $N0 = $P0[1]
 291     ne $N0, 2.0, X1
 292     inc $I1
 293
 294     $S0 = $P0[2]
 295     ne $S0, '17', X1
 296     inc $I1
 297 X1:
 298     is( $I1, 3, 'Setting via PMC key (3 different types)' )
 299 .end
 300
 301 .sub test_get_pmc_index
 302     $P0 = new ['ResizableIntegerArray']
 303     $P0 = 1
 304     $P0[25] = 125
 305     $P0[128] = 10.2
 306     $P0[513] = '17'
 307     $P0[1023] = 123456
 308
 309     $I1 = 0
 310
 311     $P2 = new ['Key']
 312
 313     $P2 = 25
 314     $I0 = $P0[$P2]
 315     ne $I0, 125, X1
 316     inc $I1
 317
 318     $P2 = 128
 319     $N0 = $P0[$P2]
 320     ne $N0, 10.0, X1
 321     inc $I1
 322
 323     $P2 = 513
 324     $S0 = $P0[$P2]
 325     ne $S0, '17', X1
 326     inc $I1
 327
 328     $P2 = 1023
 329     $I2 = $P0[$P2]
 330     ne $I2, 123456, X1
 331     inc $I1
 332 X1:
 333     is( $I1, 4, 'Getting via PMC key (4 different types)' )
 334 .end
 335
 336 .sub test_push
 337     $P0 = new ['ResizableIntegerArray']
 338     $P0[9999] = 0
 339     push $P0, 12345
 340     $I0 = $P0
 341     is( $I0, 10001, 'Push increases number of elements by one' )
 342     $I0 = $P0[10000]
 343     is( $I0, 12345, '... and stores correct value' )
 344 .end
 345
 346 .sub test_pop
 347     $P0 = new ['ResizableIntegerArray']
 348     $P0[0] = 4
 349     $P0[1] = 8
 350     $P0[2] = 16
 351     $I0 = $P0
 352     $I0 = pop $P0
 353     is( $I0, 16, 'Pop retrieves correct value' )
 354     $I0 = $P0
 355     is( $I0, 2, '... and reduces number of elements by one' )
 356 .end
 357
 358 .sub test_pop_many
 359     $P0 = new ['ResizableIntegerArray']
 360     $I0 = 0
 361 l1:
 362     $P0[$I0] = $I0
 363     inc $I0
 364     lt $I0, 100000, l1
 365 l2:
 366     le $I0, 0, e2
 367     dec $I0
 368     $I1 = pop $P0
 369     eq $I0, $I1, l2
 370 e2:
 371     is( $I0, $I1, 'Pop many times retrieves correct values' )
 372     $I0 = $P0
 373     is( $I0, 0, '... and leaves array empty' )
 374 .end
 375
 376 .sub test_push_many
 377     $P0 = new ['ResizableIntegerArray']
 378     $I0 = 0
 379 l1:
 380     push $P0, $I0
 381     inc $I0
 382     lt $I0, 100000, l1
 383     $I1 = $P0
 384     is( $I1, 100000, 'Push many values fills array to correct size' )
 385 l2:
 386     le $I0, 0, e2
 387     dec $I0
 388     $I1 = $P0[$I0]
 389     eq $I0, $I1, l2
 390 e2:
 391     is( $I0, $I1, '... and stores correct values')
 392 .end
 393
 394 .sub test_push_pop
 395     $P0 = new ['ResizableIntegerArray']
 396     $I1 = 0
 397
 398     push $P0, 2
 399     $I0 = $P0
 400     ne $I0, 1, X1
 401     inc $I1
 402
 403     push $P0, 4
 404     $I0 = $P0
 405     ne $I0, 2, X1
 406     inc $I1
 407
 408     push $P0, 6
 409     $I0 = $P0
 410     ne $I0, 3, X1
 411     inc $I1
 412
 413     $I0 = pop $P0
 414     ne $I0, 6, X1
 415     inc $I1
 416
 417     $I0 = $P0
 418     ne $I0, 2, X1
 419     inc $I1
 420
 421     $I0 = pop $P0
 422     ne $I0, 4, X1
 423     inc $I1
 424
 425     $I0 = $P0
 426     ne $I0, 1, X1
 427     inc $I1
 428
 429     $I0 = pop $P0
 430     ne $I0, 2, X1
 431     inc $I1
 432
 433     $I0 = $P0
 434     ne $I0, 0, X1
 435     inc $I1
 436
 437 X1:
 438     is( $I1, 9, 'Push-then-Pop retrieves values in reverse order' )
 439 .end
 440
 441 .sub test_cant_pop_empty
 442     $P0 = new ['ResizableIntegerArray']
 443     $I0 = 1
 444     push_eh eh
 445     $I0 = pop $P0
 446     $I0 = 0
 447 eh:
 448     pop_eh
 449     ok( $I0, 'Pop from empty array should throw an exception' )
 450 .end
 451
 452 # .sub test_cant_pop_empty
 453 # #   test_pass( 'pop from empty array should throw exception' )
 454 #     throws_like( <<'CODE', 'Can\'t pop from an empty array!', 'pop from empty array should throw exception' )
 455 # .sub main
 456 #     $P0 = new ['ResizableIntegerArray']
 457 #     $I0 = pop $P0
 458 # .end
 459 # CODE
 460 # #   test_test( 'pop from empty array should throw exception' )
 461 # .end
 462
 463 .sub test_shift
 464     $P0 = new ['ResizableIntegerArray']
 465     $P0[0] = 10
 466     $P0[1] = 20
 467
 468     $I1 = 0
 469
 470     $I0 = $P0
 471     ne $I0, 2, X1
 472     inc $I1
 473
 474     $I0 = shift $P0
 475     ne $I0, 10, X1
 476     inc $I1
 477
 478     $I0 = $P0
 479     ne $I0, 1, X1
 480     inc $I1
 481
 482     $I0 = shift $P0
 483     ne $I0, 20, X1
 484     inc $I1
 485
 486 X1:
 487     is( $I1, 4, 'Shift returns values in correct order' )
 488
 489     $I0 = $P0
 490     is( $I0, 0, '... and removes correct number of elements' )
 491 .end
 492
 493 .sub test_unshift
 494     $P0 = new ['ResizableIntegerArray']
 495     unshift $P0, 10
 496     unshift $P0, 20
 497
 498     $I0 = $P0
 499     is( $I0, 2, 'Unshift adds correct number of elements' )
 500
 501     $I1 = 0
 502
 503     $I0 = $P0[0]
 504     ne $I0, 20, X1
 505     inc $I1
 506     $I0 = $P0[1]
 507     ne $I0, 10, X1
 508     inc $I1
 509
 510 X1:
 511     is( $I1, 2, '... and stores values in correct order' )
 512 .end
 513
 514 .sub test_iterator
 515     $P0 = new ['ResizableIntegerArray']
 516     push_eh k0
 517     $P0[0] = 42
 518     $P0[1] = 43
 519     $P0[2] = 44
 520     push $P0, 999
 521     $I0 = 0
 522     $P1 = iter $P0
 523     $I2 = shift $P1
 524     inc $I0
 525     eq $I2, 42, k3
 526     dec $I0
 527     say 'Missing 42'
 528 k3:
 529     $I2 = shift $P1
 530     inc $I0
 531     eq $I2, 43, k2
 532     dec $I0
 533     say 'Missing 43'
 534 k2:
 535     $I2 = shift $P1
 536     inc $I0
 537     eq $I2, 44, k1
 538     dec $I0
 539     say 'Missing 44'
 540 k1:
 541     $I2 = shift $P1
 542     inc $I0
 543     eq $I2, 999, k0
 544     dec $I0
 545     say 'Missing 999'
 546 k0:
 547     pop_eh
 548     is( $I0, 4, 'get_iter: iterator returns all values in correct sequence' )
 549 .end
 550
 551 # Local Variables:
 552 #   mode: pir
 553 #   fill-column: 100
 554 # End:
 555 # vim: expandtab shiftwidth=4 ft=pir: