t/op/arithmetics_pmc.t

   1 #!parrot
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/arithmetics_pmc.t - Arithmetic Ops involving PMCs
   8
   9 =head1 SYNOPSIS
  10
  11         % prove t/op/arithmetics_pmc.t
  12
  13 =head1 DESCRIPTION
  14
  15 Test handling C<dest> arg in 3-args arithmetic.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21     .include "iglobals.pasm"
  22
  23     plan(68)
  24
  25     # Don't check BigInt or BigNum without gmp
  26     .local pmc interp     # a handle to our interpreter object.
  27     interp = getinterp
  28     .local pmc config
  29     config = interp[.IGLOBALS_CONFIG_HASH]
  30     .local string gmp
  31     gmp = config['gmp']
  32
  33     run_tests_for('Integer')
  34     run_tests_for('Float')
  35
  36     if gmp goto do_big_ones
  37         skip( 34, "will not test BigInt or BigNum without gmp" )
  38         goto end
  39
  40   do_big_ones:
  41     run_tests_for('BigInt')
  42     run_tests_for('BigNum')
  43
  44   end:
  45 .end
  46
  47 .sub run_tests_for
  48     .param pmc type
  49     test_add(type)
  50     test_divide(type)
  51     test_multiply(type)
  52     test_floor_divide(type)
  53     test_logical_and(type)
  54     test_concatenate(type)
  55     test_logical_xor(type)
  56     test_logical_or(type)
  57     test_bitwise_shr(type)
  58     test_bitwise_or(type)
  59     test_bitwise_shl(type)
  60     test_bitwise_xor(type)
  61     test_modulus(type)
  62     test_pow(type)
  63     test_subtract(type)
  64     test_bitwise_lsr(type)
  65     test_bitwise_and(type)
  66 .end
  67
  68 .sub test_add
  69     .param pmc type
  70
  71     $P0 = new type
  72     $P0 = 40
  73     $P1 = new type
  74     $P1 = 2
  75     $P2 = new type
  76     $P2 = 115200
  77
  78     $P99 = $P2
  79
  80     $S0 = "original dest is untouched in add for "
  81     $S1 = type
  82     concat $S0, $S1
  83
  84     # ignore exceptions
  85     push_eh done
  86     add $P2, $P0, $P1
  87
  88     $I0 = cmp $P99, 115200
  89
  90     is( $I0, 0, $S0 )
  91     goto end
  92
  93   done:
  94     ok(1, 'ignoring exceptions')
  95   end:
  96 .end
  97
  98 .sub test_divide
  99     .param pmc type
 100
 101     $P0 = new type
 102     $P0 = 40
 103     $P1 = new type
 104     $P1 = 2
 105     $P2 = new type
 106     $P2 = 115200
 107
 108     $P99 = $P2
 109
 110     $S0 = "original dest is untouched in divide for "
 111     $S1 = type
 112     concat $S0, $S1
 113
 114     # ignore exceptions
 115     push_eh done
 116     div $P2, $P0, $P1
 117
 118     $I0 = cmp $P99, 115200
 119
 120     is( $I0, 0, $S0 )
 121     goto end
 122
 123   done:
 124     ok(1, 'ignoring exceptions')
 125   end:
 126 .end
 127
 128 .sub test_multiply
 129     .param pmc type
 130
 131     $P0 = new type
 132     $P0 = 40
 133     $P1 = new type
 134     $P1 = 2
 135     $P2 = new type
 136     $P2 = 115200
 137
 138     $P99 = $P2
 139
 140     $S0 = "original dest is untouched in multiply for "
 141     $S1 = type
 142     concat $S0, $S1
 143
 144     # ignore exceptions
 145     push_eh done
 146     mul $P2, $P0, $P1
 147
 148     $I0 = cmp $P99, 115200
 149
 150     is( $I0, 0, $S0 )
 151     goto end
 152
 153   done:
 154     ok(1, 'ignoring exceptions')
 155   end:
 156 .end
 157
 158 .sub test_floor_divide
 159     .param pmc type
 160
 161     $P0 = new type
 162     $P0 = 40
 163     $P1 = new type
 164     $P1 = 2
 165     $P2 = new type
 166     $P2 = 115200
 167
 168     $P99 = $P2
 169
 170     $S0 = "original dest is untouched in floor_divide for "
 171     $S1 = type
 172     concat $S0, $S1
 173
 174     # ignore exceptions
 175     push_eh done
 176     fdiv $P2, $P0, $P1
 177
 178     $I0 = cmp $P99, 115200
 179
 180     is( $I0, 0, $S0 )
 181     goto end
 182
 183   done:
 184     ok(1, 'ignoring exceptions')
 185   end:
 186 .end
 187
 188 .sub test_logical_and
 189     .param pmc type
 190
 191     $P0 = new type
 192     $P0 = 40
 193     $P1 = new type
 194     $P1 = 2
 195     $P2 = new type
 196     $P2 = 115200
 197
 198     $P99 = $P2
 199
 200     $S0 = "original dest is untouched in logical_and for "
 201     $S1 = type
 202     concat $S0, $S1
 203
 204     # ignore exceptions
 205     push_eh done
 206     and $P2, $P0, $P1
 207
 208     $I0 = cmp $P99, 115200
 209
 210     is( $I0, 0, $S0 )
 211     goto end
 212
 213   done:
 214     ok(1, 'ignoring exceptions')
 215   end:
 216 .end
 217
 218 .sub test_concatenate
 219     .param pmc type
 220
 221     $P0 = new type
 222     $P0 = 40
 223     $P1 = new type
 224     $P1 = 2
 225     $P2 = new type
 226     $P2 = 115200
 227
 228     $P99 = $P2
 229
 230     $S0 = "original dest is untouched in concatenate for "
 231     $S1 = type
 232     concat $S0, $S1
 233
 234     # ignore exceptions
 235     push_eh done
 236     concat $P2, $P0, $P1
 237
 238     $I0 = cmp $P99, 115200
 239
 240     is( $I0, 0, $S0 )
 241     goto end
 242
 243   done:
 244     ok(1, 'ignoring exceptions')
 245   end:
 246 .end
 247
 248 .sub test_logical_xor
 249     .param pmc type
 250
 251     $P0 = new type
 252     $P0 = 40
 253     $P1 = new type
 254     $P1 = 2
 255     $P2 = new type
 256     $P2 = 115200
 257
 258     $P99 = $P2
 259
 260     $S0 = "original dest is untouched in logical_xor for "
 261     $S1 = type
 262     concat $S0, $S1
 263
 264     # ignore exceptions
 265     push_eh done
 266     xor $P2, $P0, $P1
 267
 268     $I0 = cmp $P99, 115200
 269
 270     is( $I0, 0, $S0 )
 271     goto end
 272
 273   done:
 274     ok(1, 'ignoring exceptions')
 275   end:
 276 .end
 277
 278 .sub test_logical_or
 279     .param pmc type
 280
 281     $P0 = new type
 282     $P0 = 40
 283     $P1 = new type
 284     $P1 = 2
 285     $P2 = new type
 286     $P2 = 115200
 287
 288     $P99 = $P2
 289
 290     $S0 = "original dest is untouched in logical_or for "
 291     $S1 = type
 292     concat $S0, $S1
 293
 294     # ignore exceptions
 295     push_eh done
 296     or $P2, $P0, $P1
 297
 298     $I0 = cmp $P99, 115200
 299
 300     is( $I0, 0, $S0 )
 301     goto end
 302
 303   done:
 304     ok(1, 'ignoring exceptions')
 305   end:
 306 .end
 307
 308 .sub test_bitwise_shr
 309     .param pmc type
 310
 311     $P0 = new type
 312     $P0 = 40
 313     $P1 = new type
 314     $P1 = 2
 315     $P2 = new type
 316     $P2 = 115200
 317
 318     $P99 = $P2
 319
 320     $S0 = "original dest is untouched in bitwise_shr for "
 321     $S1 = type
 322     concat $S0, $S1
 323
 324     # ignore exceptions
 325     push_eh done
 326     shr $P2, $P0, $P1
 327
 328     $I0 = cmp $P99, 115200
 329
 330     is( $I0, 0, $S0 )
 331     goto end
 332
 333   done:
 334     ok(1, 'ignoring exceptions')
 335   end:
 336 .end
 337
 338 .sub test_bitwise_or
 339     .param pmc type
 340
 341     $P0 = new type
 342     $P0 = 40
 343     $P1 = new type
 344     $P1 = 2
 345     $P2 = new type
 346     $P2 = 115200
 347
 348     $P99 = $P2
 349
 350     $S0 = "original dest is untouched in bitwise_or for "
 351     $S1 = type
 352     concat $S0, $S1
 353
 354     # ignore exceptions
 355     push_eh done
 356     bor $P2, $P0, $P1
 357
 358     $I0 = cmp $P99, 115200
 359
 360     is( $I0, 0, $S0 )
 361     goto end
 362
 363   done:
 364     ok(1, 'ignoring exceptions')
 365   end:
 366 .end
 367
 368 .sub test_bitwise_shl
 369     .param pmc type
 370
 371     $P0 = new type
 372     $P0 = 40
 373     $P1 = new type
 374     $P1 = 2
 375     $P2 = new type
 376     $P2 = 115200
 377
 378     $P99 = $P2
 379
 380     $S0 = "original dest is untouched in bitwise_shl for "
 381     $S1 = type
 382     concat $S0, $S1
 383
 384     # ignore exceptions
 385     push_eh done
 386     shl $P2, $P0, $P1
 387
 388     $I0 = cmp $P99, 115200
 389
 390     is( $I0, 0, $S0 )
 391     goto end
 392
 393   done:
 394     ok(1, 'ignoring exceptions')
 395   end:
 396 .end
 397
 398 .sub test_bitwise_xor
 399     .param pmc type
 400
 401     $P0 = new type
 402     $P0 = 40
 403     $P1 = new type
 404     $P1 = 2
 405     $P2 = new type
 406     $P2 = 115200
 407
 408     $P99 = $P2
 409
 410     $S0 = "original dest is untouched in bitwise_xor for "
 411     $S1 = type
 412     concat $S0, $S1
 413
 414     # ignore exceptions
 415     push_eh done
 416     bxor $P2, $P0, $P1
 417
 418     $I0 = cmp $P99, 115200
 419
 420     is( $I0, 0, $S0 )
 421     goto end
 422
 423   done:
 424     ok(1, 'ignoring exceptions')
 425   end:
 426 .end
 427
 428 .sub test_modulus
 429     .param pmc type
 430
 431     $P0 = new type
 432     $P0 = 40
 433     $P1 = new type
 434     $P1 = 2
 435     $P2 = new type
 436     $P2 = 115200
 437
 438     $P99 = $P2
 439
 440     $S0 = "original dest is untouched in modulus for "
 441     $S1 = type
 442     concat $S0, $S1
 443
 444     # ignore exceptions
 445     push_eh done
 446     mod $P2, $P0, $P1
 447
 448     $I0 = cmp $P99, 115200
 449
 450     is( $I0, 0, $S0 )
 451     goto end
 452
 453   done:
 454     ok(1, 'ignoring exceptions')
 455   end:
 456 .end
 457
 458 .sub test_pow
 459     .param pmc type
 460
 461     $P0 = new type
 462     $P0 = 40
 463     $P1 = new type
 464     $P1 = 2
 465     $P2 = new type
 466     $P2 = 115200
 467
 468     $P99 = $P2
 469
 470     $S0 = "original dest is untouched in pow for "
 471     $S1 = type
 472     concat $S0, $S1
 473
 474     # ignore exceptions
 475     push_eh done
 476     pow $P2, $P0, $P1
 477
 478     $I0 = cmp $P99, 115200
 479
 480     is( $I0, 0, $S0 )
 481     goto end
 482
 483   done:
 484     ok(1, 'ignoring exceptions')
 485   end:
 486 .end
 487
 488 .sub test_subtract
 489     .param pmc type
 490
 491     $P0 = new type
 492     $P0 = 40
 493     $P1 = new type
 494     $P1 = 2
 495     $P2 = new type
 496     $P2 = 115200
 497
 498     $P99 = $P2
 499
 500     $S0 = "original dest is untouched in subtract for "
 501     $S1 = type
 502     concat $S0, $S1
 503
 504     # ignore exceptions
 505     push_eh done
 506     sub $P2, $P0, $P1
 507
 508     $I0 = cmp $P99, 115200
 509
 510     is( $I0, 0, $S0 )
 511     goto end
 512
 513   done:
 514     ok(1, 'ignoring exceptions')
 515   end:
 516 .end
 517
 518 .sub test_bitwise_lsr
 519     .param pmc type
 520
 521     $P0 = new type
 522     $P0 = 40
 523     $P1 = new type
 524     $P1 = 2
 525     $P2 = new type
 526     $P2 = 115200
 527
 528     $P99 = $P2
 529
 530     $S0 = "original dest is untouched in bitwise_lsr for "
 531     $S1 = type
 532     concat $S0, $S1
 533
 534     # ignore exceptions
 535     push_eh done
 536     lsr $P2, $P0, $P1
 537
 538     $I0 = cmp $P99, 115200
 539
 540     is( $I0, 0, $S0 )
 541     goto end
 542
 543   done:
 544     ok(1, 'ignoring exceptions')
 545   end:
 546 .end
 547
 548 .sub test_bitwise_and
 549     .param pmc type
 550
 551     $P0 = new type
 552     $P0 = 40
 553     $P1 = new type
 554     $P1 = 2
 555     $P2 = new type
 556     $P2 = 115200
 557
 558     $P99 = $P2
 559
 560     $S0 = "original dest is untouched in bitwise_and for "
 561     $S1 = type
 562     concat $S0, $S1
 563
 564     # ignore exceptions
 565     push_eh done
 566     band $P2, $P0, $P1
 567
 568     $I0 = cmp $P99, 115200
 569
 570     is( $I0, 0, $S0 )
 571     goto end
 572
 573   done:
 574     ok(1, 'ignoring exceptions')
 575   end:
 576 .end
 577
 578 # Local Variables:
 579 #   mode: pir
 580 #   cperl-indent-level: 4
 581 #   fill-column: 100
 582 # End:
 583 # vim: expandtab shiftwidth=4 ft=pir :