t/op/arithmetics.t

   1 #!./parrot
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/arithmetics.t - Arithmetic Ops
   8
   9 =head1 SYNOPSIS
  10
  11         % prove t/op/arithmetics.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests basic arithmetic on various combinations of Parrot integer and
  16 number types.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'test_more.pir'
  22     .include 'iglobals.pasm'
  23
  24     plan(80)
  25
  26     take_the_negative_of_a_native_integer()
  27     take_the_absolute_of_a_native_integer()
  28     add_native_integer_to_native_integer()
  29     subtract_native_integer_from_native_integer()
  30     multiply_native_integer_with_native_integer()
  31     divide_native_integer_by_native_integer()
  32     negate_minus_zero_point_zero()
  33     negate_a_native_number()
  34     take_the_absolute_of_a_native_number()
  35     ceil_of_a_native_number()
  36     floor_of_a_native_number()
  37     add_native_integer_to_native_number()
  38     subtract_native_integer_from_native_number()
  39     multiply_native_number_with_native_integer()
  40     divide_native_number_by_native_integer()
  41     add_native_number_to_native_number()
  42     subtract_native_number_from_native_number()
  43     multiply_native_number_with_native_number()
  44     divide_native_number_by_native_number()
  45     # END_OF_TESTS
  46
  47 .end
  48
  49 #
  50 # Operations on a single INTVAL
  51 #
  52 .sub take_the_negative_of_a_native_integer
  53     set $I0, 0
  54     neg $I0
  55     is( $I0, "0", 'take_the_negative_of_a_native_integer' )
  56
  57     set $I0, 1234567890
  58     neg $I0
  59     is( $I0, "-1234567890", 'take_the_negative_of_a_native_integer' )
  60
  61     set $I0, -1234567890
  62     neg $I0
  63     is( $I0, "1234567890", 'take_the_negative_of_a_native_integer' )
  64
  65     set $I0, 0
  66     set $I1, 0
  67     neg $I1, $I0
  68     is( $I1, "0", 'take_the_negative_of_a_native_integer' )
  69
  70     set $I0, 1234567890
  71     neg $I1, $I0
  72     is( $I1, "-1234567890", 'take_the_negative_of_a_native_integer' )
  73
  74     set $I0, -1234567890
  75     neg $I1, $I0
  76     is( $I1, "1234567890", 'take_the_negative_of_a_native_integer' )
  77 .end
  78
  79 .sub take_the_absolute_of_a_native_integer
  80     set $I0, 0
  81     abs $I0
  82     is( $I0, "0", 'take_the_absolute_of_a_native_integer' )
  83
  84     set $I0, 1234567890
  85     abs $I0
  86     is( $I0, "1234567890", 'take_the_absolute_of_a_native_integer' )
  87
  88     set $I0, -1234567890
  89     abs $I0
  90     is( $I0, "1234567890", 'take_the_absolute_of_a_native_integer' )
  91
  92     set $I0, 0
  93     set $I1, 0
  94     abs $I1, $I0
  95     is( $I1, "0", 'take_the_absolute_of_a_native_integer' )
  96
  97     set $I0, 1234567890
  98     abs $I1, $I0
  99     is( $I1, "1234567890", 'take_the_absolute_of_a_native_integer' )
 100
 101     set $I0, -1234567890
 102     abs $I1, $I0
 103     is( $I1, "1234567890", 'take_the_absolute_of_a_native_integer' )
 104 .end
 105
 106 #
 107 # first arg is INTVAL, second arg is INTVAL
 108 #
 109 .sub add_native_integer_to_native_integer
 110     set $I0, 4000
 111     set $I1, -123
 112     add $I2, $I0, $I1
 113     is( $I2, "3877", 'add_native_integer_to_native_integer' )
 114
 115     add $I0, $I0, $I1
 116     is( $I0, "3877", 'add_native_integer_to_native_integer' )
 117 .end
 118
 119 .sub subtract_native_integer_from_native_integer
 120     set $I0, 4000
 121     set $I1, -123
 122     sub $I2, $I0, $I1
 123     is( $I2, "4123", 'subtract_native_integer_from_native_integer' )
 124
 125     sub $I0, $I0, $I1
 126     is( $I0, "4123", 'subtract_native_integer_from_native_integer' )
 127 .end
 128
 129 .sub multiply_native_integer_with_native_integer
 130     set $I0, 4000
 131     set $I1, -123
 132     mul $I2, $I0, $I1
 133     is( $I2, "-492000", 'multiply_native_integer_with_native_integer' )
 134
 135     mul $I0, $I0, $I1
 136     is( $I0, "-492000", 'multiply_native_integer_with_native_integer' )
 137 .end
 138
 139 .sub divide_native_integer_by_native_integer
 140     set $I0, 4000
 141     set $I1, -123
 142     div $I2, $I0, $I1
 143     is( $I2, "-32", 'divide_native_integer_by_native_integer' )
 144
 145     div $I0, $I0, $I1
 146     is( $I0, "-32", 'divide_native_integer_by_native_integer' )
 147 .end
 148
 149 #
 150 # print -0.0 as -0
 151 #
 152 .sub negate_minus_zero_point_zero
 153     .local pmc interp, config_hash
 154     .local string has_negative_zero
 155     interp = getinterp
 156     config_hash = interp[.IGLOBALS_CONFIG_HASH]
 157     has_negative_zero = config_hash['has_negative_zero']
 158
 159     set $N0, 0
 160     neg $N0
 161     $S0 = $N0
 162     unless has_negative_zero goto Todo_test1
 163     is( $S0, "-0", '1' )
 164     goto End_test1
 165 Todo_test1:
 166     $I0 = $S0 == "-0"
 167     todo($I0, 'negative zero, TT #313')
 168 End_test1:
 169
 170     set $N0, -0.0
 171     neg $N0
 172     $S0 = $N0
 173     is( $S0, "0", '2' )
 174
 175     set $N0, -0.0
 176     neg $N1, $N0
 177     $S0 = $N1
 178     is( $S0, "0", '3' )
 179
 180     set $N0, 0
 181     set $N1, 1
 182     neg $N1, $N0
 183     $S0 = $N1
 184     unless has_negative_zero goto Todo_test4
 185     is( $S0, "-0", '4' )
 186     goto End_test4
 187 Todo_test4:
 188     $I0 = $S0 == "-0"
 189     todo($I0, 'negative zero, TT #313')
 190 End_test4:
 191 .end
 192
 193 #
 194 # Operations on a single NUMVAL
 195 #
 196 .sub negate_a_native_number
 197     set $N0, 123.4567890
 198     neg $N0
 199     is( $N0, "-123.456789", 'negate_a_native_number' )
 200
 201     set $N0, -123.4567890
 202     neg $N0
 203     is( $N0, "123.456789", 'negate_a_native_number' )
 204
 205     set $N0, 123.4567890
 206     neg $N1, $N0
 207     is( $N1, "-123.456789", 'negate_a_native_number' )
 208
 209     set $N0, -123.4567890
 210     neg $N1, $N0
 211     is( $N1, "123.456789", 'negate_a_native_number' )
 212 .end
 213
 214 .sub take_the_absolute_of_a_native_number
 215     set $N0, 0
 216     abs $N0
 217     is( $N0, "0", 'take_the_absolute_of_a_native_number' )
 218
 219     set $N0, -0.0
 220     abs $N0
 221     is( $N0, "0", 'take_the_absolute_of_a_native_number' )
 222
 223     set $N0, 123.45678901
 224     abs $N0
 225     is( $N0, "123.45678901", 'take_the_absolute_of_a_native_number' )
 226
 227     set $N0, -123.45678901
 228     abs $N0
 229     is( $N0, "123.45678901", 'take_the_absolute_of_a_native_number' )
 230
 231     set $N0, 0
 232     set $N1, 1
 233     abs $N1, $N0
 234     is( $N1, "0", 'take_the_absolute_of_a_native_number' )
 235
 236     set $N0, 0.0
 237     set $N1, 1
 238     abs $N1, $N0
 239     is( $N1, "0", 'take_the_absolute_of_a_native_number' )
 240
 241     set $N0, 123.45678901
 242     set $N1, 1
 243     abs $N1, $N0
 244     is( $N1, "123.45678901", 'take_the_absolute_of_a_native_number' )
 245
 246     set $N0, -123.45678901
 247     set $N1, 1
 248     abs $N1, $N0
 249     is( $N1, "123.45678901", 'take_the_absolute_of_a_native_number' )
 250 .end
 251
 252 .sub ceil_of_a_native_number
 253     set $N0, 0
 254     ceil $N0
 255     is( $N0, "0", 'ceil_of_a_native_number' )
 256
 257     set $N0, 123.45678901
 258     ceil $N0
 259     is( $N0, "124", 'ceil_of_a_native_number' )
 260
 261     set $N0, -123.45678901
 262     ceil $N0
 263     is( $N0, "-123", 'ceil_of_a_native_number' )
 264
 265     set $N0, 0
 266     set $N1, 1
 267     ceil $N1, $N0
 268     is( $N1, "0", 'ceil_of_a_native_number' )
 269
 270     set $N0, 0.0
 271     set $N1, 1
 272     ceil $N1, $N0
 273     is( $N1, "0", 'ceil_of_a_native_number' )
 274
 275     set $N0, 123.45678901
 276     set $N1, 1
 277     ceil $N1, $N0
 278     is( $N1, "124", 'ceil_of_a_native_number' )
 279
 280     set $N0, -123.45678901
 281     set $N1, 1
 282     ceil $N1, $N0
 283     is( $N1, "-123", 'ceil_of_a_native_number' )
 284
 285     set $N0, 0
 286     set $I1, 1
 287     ceil $I1, $N0
 288     is( $I1, "0", 'ceil_of_a_native_number' )
 289
 290     set $N0, 0.0
 291     set $I1, 1
 292     ceil $I1, $N0
 293     is( $I1, "0", 'ceil_of_a_native_number' )
 294
 295     set $N0, 123.45678901
 296     set $I1, 1
 297     ceil $I1, $N0
 298     is( $I1, "124", 'ceil_of_a_native_number' )
 299
 300     set $N0, -123.45678901
 301     set $I1, 1
 302     ceil $I1, $N0
 303     is( $I1, "-123", 'ceil_of_a_native_number' )
 304 .end
 305
 306 .sub floor_of_a_native_number
 307     set $N0, 0
 308     floor $N0
 309     is( $N0, "0", 'floor_of_a_native_number' )
 310
 311     set $N0, 123.45678901
 312     floor $N0
 313     is( $N0, "123", 'floor_of_a_native_number' )
 314
 315     set $N0, -123.45678901
 316     floor $N0
 317     is( $N0, "-124", 'floor_of_a_native_number' )
 318
 319     set $N0, 0
 320     set $N1, 1
 321     floor $N1, $N0
 322     is( $N1, "0", 'floor_of_a_native_number' )
 323
 324     set $N0, 0.0
 325     set $N1, 1
 326     floor $N1, $N0
 327     is( $N1, "0", 'floor_of_a_native_number' )
 328
 329     set $N0, 123.45678901
 330     set $N1, 1
 331     floor $N1, $N0
 332     is( $N1, "123", 'floor_of_a_native_number' )
 333
 334     set $N0, -123.45678901
 335     set $N1, 1
 336     floor $N1, $N0
 337     is( $N1, "-124", 'floor_of_a_native_number' )
 338
 339     set $N0, 0
 340     set $I1, 1
 341     floor $I1, $N0
 342     is( $I1, "0", 'floor_of_a_native_number' )
 343
 344     set $N0, 0.0
 345     set $I1, 1
 346     floor $I1, $N0
 347     is( $I1, "0", 'floor_of_a_native_number' )
 348
 349     set $N0, 123.45678901
 350     set $I1, 1
 351     floor $I1, $N0
 352     is( $I1, "123", 'floor_of_a_native_number' )
 353
 354     set $N0, -123.45678901
 355     set $I1, 1
 356     floor $I1, $N0
 357     is( $I1, "-124", 'floor_of_a_native_number' )
 358
 359 .end
 360
 361 #
 362 # FLOATVAL and INTVAL tests
 363 #
 364 .sub add_native_integer_to_native_number
 365     set $I0, 4000
 366     set $N0, -123.123
 367     add $N1, $N0, $I0
 368     is( $N1, "3876.877", 'add_native_integer_to_native_number' )
 369
 370     add $N0, $N0, $I0
 371     is( $N0, "3876.877", 'add_native_integer_to_native_number' )
 372
 373     add $N0, $I0
 374     is( $N0, "7876.877", 'add_native_integer_to_native_number' )
 375
 376 .end
 377
 378 .sub subtract_native_integer_from_native_number
 379     set $I0, 4000
 380     set $N0, -123.123
 381     sub $N1, $N0, $I0
 382     is( $N1, "-4123.123", 'subtract_native_integer_from_native_number' )
 383
 384     sub $N0, $N0, $I0
 385     is( $N0, "-4123.123", 'subtract_native_integer_from_native_number' )
 386
 387     sub $N0, $I0
 388     is( $N0, "-8123.123", 'subtract_native_integer_from_native_number' )
 389
 390 .end
 391
 392 .sub multiply_native_number_with_native_integer
 393     set $I0, 4000
 394     set $N0, -123.123
 395     mul $N1, $N0, $I0
 396     is( $N1, "-492492", 'multiply_native_number_with_native_integer' )
 397
 398     mul $N0, $N0, $I0
 399     is( $N0, "-492492", 'multiply_native_number_with_native_integer' )
 400
 401     mul $N0, -2
 402     is( $N0, "984984", 'multiply_native_number_with_native_integer' )
 403 .end
 404
 405 .sub divide_native_number_by_native_integer
 406     set $I0, 4000
 407     set $N0, -123.123
 408     div $N1, $N0, $I0
 409     is( $N1, "-0.03078075", 'divide_native_number_by_native_integer' )
 410
 411     div $N0, $N0, $I0
 412     is( $N0, "-0.03078075", 'divide_native_number_by_native_integer' )
 413
 414     div $N0, 1
 415     is( $N0, "-0.03078075", 'divide_native_number_by_native_integer' )
 416
 417     set $N0, 100.000
 418     div $N0, 100
 419     is( $N0, "1", 'divide_native_number_by_native_integer' )
 420
 421     div $N0, 0.01
 422     is( $N0, "100", 'divide_native_number_by_native_integer' )
 423 .end
 424
 425 #
 426 # FLOATVAL and FLOATVAL tests
 427 #
 428 .sub add_native_number_to_native_number
 429     set $N2, 4000.246
 430     set $N0, -123.123
 431     add $N1, $N0, $N2
 432     is( $N1, "3877.123", 'add_native_number_to_native_number' )
 433
 434     add $N0, $N0, $N2
 435     is( $N0, "3877.123", 'add_native_number_to_native_number' )
 436 .end
 437
 438 .sub subtract_native_number_from_native_number
 439     set $N2, 4000.246
 440     set $N0, -123.123
 441     sub $N1, $N0, $N2
 442     is( $N1, "-4123.369", 'subtract_native_number_from_native_number' )
 443
 444     sub $N0, $N0, $N2
 445     is( $N0, "-4123.369", 'subtract_native_number_from_native_number' )
 446
 447 .end
 448
 449 .sub multiply_native_number_with_native_number
 450     set $N2, 4000.246
 451     set $N0, -123.123
 452     mul $N1, $N0, $N2
 453     is( $N1, "-492522.288258", 'multiply_native_number_with_native_number' )
 454
 455     mul $N0, $N0, $N2
 456     is( $N0, "-492522.288258", 'multiply_native_number_with_native_number' )
 457
 458 .end
 459
 460 .sub divide_native_number_by_native_number
 461     set $N2, 4000.246
 462     set $N0, -123.123
 463     div $N1, $N0, $N2
 464     is( $N1, "-0.0307788571002883", 'divide_native_number_by_native_number' )
 465
 466     div $N0, $N0, $N2
 467     is( $N0, "-0.0307788571002883", 'divide_native_number_by_native_number' )
 468
 469 .end
 470
 471 # Local Variables:
 472 #   mode: pir
 473 #   fill-column: 100
 474 # End:
 475 # vim: expandtab shiftwidth=4 ft=pir: