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