1#!./parrot 2# Copyright (C) 2010, Parrot Foundation. 3 4=head1 NAME 5 6t/dynoplibs/bit.t - Bitwise Dynops 7 8=head1 SYNOPSIS 9 10 % prove t/dynoplibs/bit.t 11 12=head1 DESCRIPTION 13 14Tests basic arithmetic on various combinations of Parrot integer and 15number types. 16 17=cut 18 19.loadlib 'bit_ops' 20 21.sub main :main 22 .include 'test_more.pir' 23 24 plan(139) 25 26 bnot_p_p_creates_destination() 27 band_1() 28 bands_null_string() 29 bands_2() 30 bands_3() 31 bands_4() 32 bands_cow() 33 bor_1() 34 bor_2() 35 bors_null_string() 36 bors_2() 37 bors_3() 38 bors_cow() 39 shl_1() 40 shl_2() 41 shl_3() 42 shr_1() 43 shr_2() 44 lsr_1() 45 bxor_1() 46 bxors_null_string() 47 bxors_2() 48 bxors_3() 49 bxors_cow() 50 bnots_null_string() 51 bnots_2() 52 bnots_cow() 53 bnot_1() 54 rot_1() 55 # END_OF_TESTS 56 57.end 58 59.sub 'bnot_p_p_creates_destination' 60 $P0 = box 3 61 $P1 = bnot $P0 62 is( $P1, -4, 'bnot_p_p_creates_destination' ) 63.end 64 65.sub band_1 66 $P0 = new['Integer'] 67 $P0 = 3 68 $I0 = 8 69 band $P0, $I0 70 is( $P0, 0, 'band_p_i' ) 71 is( $I0, 8, 'band_p_i' ) 72 73 $P0 = 3 74 band $P0, 8 75 is( $P0, 0, 'band_p_ic' ) 76 77 $P0 = 3 78 $P1 = new ['Integer'] 79 $P1 = 1 80 band $P0, $P1 81 is( $P0, 1, 'band_p_p' ) 82 is( $P1, 1, 'band_p_p' ) 83 84 $I0 = 3 85 band $P0, $P0, $I0 86 is( $P0, 1, 'band_p_p_i' ) 87 is( $I0, 3, 'band_p_p_i' ) 88 89 band $P0, $P0, 3 90 is( $P0, 1, 'band_p_p_ic' ) 91 92 $P0 = 4 93 $P1 = 3 94 $P2 = new ['Integer'] 95 band $P2, $P0, $P1 96 is( $P0, 4, 'band_p_p_p' ) 97 is( $P1, 3, 'band_p_p_p' ) 98 is( $P2, 0, 'band_p_p_p' ) 99.end 100 101.sub bands_null_string 102 null $S1 103 set $S2, "abc" 104 $S1 = bands $S1, $S2 105 null $S3 106 is( $S1, $S3, 'ok1' ) 107 108 set $S1, "" 109 $S1 = bands $S1, $S2 110 nok( $S1, 'ok2' ) 111 112 null $S2 113 set $S1, "abc" 114 $S1 = bands $S1, $S2 115 null $S3 116 is( $S1, $S3, 'ok3' ) 117 118 set $S2, "" 119 $S1 = bands $S1, $S2 120 nok( $S1, 'ok4' ) 121.end 122 123.sub bands_2 124 set $S1, "abc" 125 set $S2, "EE" 126 $S1 = bands $S1, $S2 127 is( $S1, "A@", 'bands 2' ) 128 is( $S2, "EE", 'bands 2' ) 129 130 $S1 = bands "abc", $S2 131 is( $S1, "A@", 'bands 2' ) 132 133 $S2 = bands "abc", "EE" 134 is( $S2, "A@", 'bands 2' ) 135.end 136 137.sub bands_3 138 set $S1, "abc" 139 set $S2, "EE" 140 bands $S0, $S1, $S2 141 is( $S0, "A@", 'bands 3' ) 142 is( $S1, "abc", 'bands 3' ) 143 is( $S2, "EE", 'bands 3' ) 144.end 145 146.sub bands_4 147 $P0 = box "abc" 148 $P1 = new ['String'] 149 $S0 = "EE" 150 bands $P1, $P0, $S0 151 is( $P1, "A@", 'bands 4' ) 152 is( $P0, "abc", 'bands 4' ) 153 is( $S0, "EE", 'bands 4' ) 154 155 $P1 = bands $P0, "EE" 156 is( $P1, "A@", 'bands 4' ) 157 is( $P0, "abc", 'bands 4' ) 158 159 $P0 = box "abc" 160 $S0 = "EE" 161 bands $P0, $S0 162 is( $P0, "A@", 'bands 4' ) 163 is( $S0, "EE", 'bands 4' ) 164 165 $P0 = box "abc" 166 bands $P0, "EE" 167 is( $P0, "A@", 'bands 4' ) 168.end 169 170.sub bands_cow 171 set $S1, "foo" 172 substr $S2, $S1, 0, 3 173 $S1 = bands $S1, "bar" 174 is( $S2, "foo", 'bands COW' ) 175.end 176 177.sub bor_1 178 $P0 = new ['Integer'] 179 $P1 = clone $P0 180 $P0 = 4 181 $P1 = 3 182 bor $P0, $P1 183 is( $P0, 7, 'bor_p_p' ) 184 is( $P1, 3, 'bor_p_p' ) 185 186 $P0 = 1 187 $I0 = 3 188 $P1 = new ['Integer'] 189 bor $P1, $P0, $I0 190 is( $P0, 1, 'bor_p_p_i' ) 191 is( $I0, 3, 'bor_p_p_i' ) 192 is( $P1, 3, 'bor_p_p_i' ) 193 194 $P0 = 1 195 $P1 = new ['Integer'] 196 bor $P1, $P0, 2 197 is( $P0, 1, 'bor_p_p_ic' ) 198 is( $P1, 3, 'bor_p_p_ic' ) 199 200 $P0 = 1 201 $P1 = new ['Integer'] 202 $P1 = 2 203 $P2 = new ['Integer'] 204 bor $P2, $P0, $P1 205 is( $P0, 1, 'bor_p_p_p' ) 206 is( $P1, 2, 'bor_p_p_p' ) 207 is( $P2, 3, 'bor_p_p_p' ) 208.end 209 210.sub bor_2 211 $I0 = 40 212 $P0 = box 20 213 bor $P0, $I0 214 is( $P0, 60, 'bor_p_i' ) 215 216 $P0 = box 30 217 bor $P0, 40 218 is( $P0, 62, 'bor_p_ic' ) 219.end 220 221.sub bors_null_string 222 null $S1 223 null $S2 224 $S1 = bors $S1, $S2 225 null $S3 226 is( $S1, $S3, 'bors NULL string' ) 227 228 null $S1 229 set $S2, "" 230 $S1 = bors $S1, $S2 231 null $S3 232 is( $S1, $S3, 'bors NULL string' ) 233 234 $S2 = bors $S2, $S1 235 is( $S2, $S3, 'bors NULL string' ) 236 237 null $S1 238 set $S2, "def" 239 $S1 = bors $S1, $S2 240 is( $S1, "def", 'bors NULL string' ) 241 242 null $S2 243 $S1 = bors $S1, $S2 244 is( $S1, "def", 'bors NULL string' ) 245 246 null $S1 247 null $S2 248 bors $S3, $S1, $S2 249 null $S4 250 is( $S3, $S4, 'bors NULL string' ) 251 252 set $S1, "" 253 bors $S3, $S1, $S2 254 is( $S3, $S4, 'bors NULL string' ) 255 256 bors $S3, $S2, $S1 257 is( $S3, $S4, 'bors NULL string' ) 258 259 set $S1, "def" 260 bors $S3, $S1, $S2 261 is( $S3, "def", 'bors NULL string' ) 262 263 bors $S3, $S2, $S1 264 is( $S3, "def", 'bors NULL string' ) 265.end 266 267.sub bors_2 268 set $S1, "abc" 269 set $S2, "EE" 270 $S1 = bors $S1, $S2 271 is( $S1, "egc", 'bors 2' ) 272 is( $S2, "EE", 'bors 2' ) 273 274 $P0 = box "abc" 275 bors $P0, $S2 276 is( $P0, "egc", 'bors_p_s' ) 277 is( $S2, "EE", 'bors_p_s' ) 278 279 $P0 = box "abc" 280 bors $P0, "EE" 281 is( $P0, "egc", 'bors_p_sc' ) 282.end 283 284.sub bors_3 285 set $S1, "abc" 286 set $S2, "EE" 287 bors $S0, $S1, $S2 288 is( $S0, "egc", 'bors 3' ) 289 is( $S1, "abc", 'bors 3' ) 290 is( $S2, "EE", 'bors 3' ) 291 292 set $S0, "abc" 293 bors $S0, "EE", $S0 294 is( $S0, "egc", 'bors_s_sc_s' ) 295 296 bors $S0, "abc", "EE" 297 is( $S0, "egc", 'bors_s_sc_sc' ) 298 299 new $P0, ['String'] 300 box $P1, "abc" 301 set $S0, "EE" 302 bors $P0, $P1, $S0 303 is( $P0, "egc", 'bors_p_p_s' ) 304 is( $P1, "abc", 'bors_p_p_s' ) 305 is( $S0, "EE", 'bors_p_p_s' ) 306 307 set $P0, "" 308 box $P1, "abc" 309 bors $P0, $P1, "EE" 310 is( $P0, "egc", 'bors_p_p_sc' ) 311 is( $P1, "abc", 'bors_p_p_sc' ) 312.end 313 314.sub bors_cow 315 set $S1, "foo" 316 substr $S2, $S1, 0, 3 317 $S1 = bors $S1, "bar" 318 is( $S2, "foo", 'bors COW' ) 319.end 320 321.sub shl_1 322 $P0 = new ['Integer'] 323 $P0 = 1 324 $I0 = 1 325 shl $P0, $I0 326 is( $P0, 2, 'shl_p_i' ) 327.end 328 329.sub shl_2 330 $P0 = new ['Integer'] 331 $P0 = 1 332 shl $P0, 2 333 is( $P0, 4, 'shl_p_ic' ) 334 335 $P0 = 1 336 337 $P1 = new ['Integer'] 338 $P1 = 2 339 shl $P0, $P1 340 is( $P0, 4, 'shl_p_p' ) 341.end 342 343.sub shl_3 344 $P0 = new ['Integer'] 345 $P0 = 1 346 347 $P1 = new ['Integer'] 348 349 $P1 = shl $P0, 2 350 is( $P1, 4, 'shl_p_p_ic' ) 351 352 $I0 = 3 353 $P1 = shl $P0, $I0 354 is( $P1, 8, 'shl_p_p_i' ) 355 356 $P2 = new ['Integer'] 357 $P2 = 4 358 359 $P1 = shl $P0, $P2 360 is( $P1, 16, 'shl_p_p_p' ) 361.end 362 363.sub shr_1 364 $P0 = new ['Integer'] 365 $P0 = 16 366 shr $P0, 2 367 is( $P0, 4, 'shr_p_ic' ) 368 369 $P0 = 16 370 371 $I0 = 3 372 shr $P0, $I0 373 is( $P0, 2, 'shr_p_i' ) 374 375 $P0 = 16 376 377 $P1 = new ['Integer'] 378 $P1 = 4 379 shr $P0, $P1 380 is( $P0, 1, 'shr_p_p' ) 381.end 382 383.sub shr_2 384 $P0 = new ['Integer'] 385 $P0 = 16 386 387 $P1 = new ['Integer'] 388 389 $P1 = shr $P0, 2 390 is( $P1, 4, 'shr_p_p_ic' ) 391 392 $I0 = 3 393 $P1 = shr $P0, $I0 394 is( $P1, 2, 'shr_p_p_i' ) 395 396 $P2 = new ['Integer'] 397 $P2 = 4 398 399 $P1 = shr $P0, $P2 400 is( $P1, 1, 'shr_p_p_p' ) 401.end 402 403.sub lsr_1 404 $P0 = new ["Integer"] 405 $P1 = new ["Integer"] 406 $I0 = 1 407 $P0 = 4 408 $P1 = 8 409 410 lsr_p_i $P0, $I0 411 is($P0, 2, "lsr_p_i") 412 413 lsr_p_ic $P0, 1 414 is($P0, 1, "lsr_p_ic") 415 416 lsr_p_p $P1, $P0 417 is($P1, 4, "lsr_p_p") 418 419 $I0 = 1 420 lsr_p_p_i $P1, $P1, $I0 421 is($P1, 2, "lsr_p_p_i") 422 423 lsr_p_p_ic $P1, $P1, 1 424 is($P1, 1, "lsr_p_p_ic") 425 426 $P1 = 4 427 lsr_p_p_p $P1, $P1, $P0 428 is($P1, 2, "lsr_p_p_p") 429.end 430 431.sub bxor_1 432 $P0 = box 3 433 $I0 = 3 434 bxor $P0, $I0 435 is( $P0, 0, 'bxor_p_i' ) 436 437 $P0 = box 3 438 bxor $P0, 3 439 is( $P0, 0, 'bxor_p_ic' ) 440 441 $P0 = box 3 442 bxor $P0, $P0 443 is( $P0, 0, 'bxor_p_p' ) 444 445 $P0 = box 3 446 bxor $P0, $P0, $I0 447 is( $P0, 0, 'bxor_p_p_i' ) 448 449 $P0 = box 3 450 bxor $P0, $P0, 3 451 is( $P0, 0, 'bxor_p_p_ic' ) 452 453 $P0 = box 3 454 bxor $P0, $P0, $P0 455 is( $P0, 0, 'bxor_p_p_p' ) 456.end 457 458.sub bxors_null_string 459 null $S1 460 null $S2 461 $S1 = bxors $S1, $S2 462 null $S3 463 is( $S1, $S3, 'bxors NULL string' ) 464 465 null $S1 466 set $S2, "" 467 $S1 = bxors $S1, $S2 468 null $S3 469 is( $S1, $S3, 'bxors NULL string' ) 470 471 $S2 = bxors $S2, $S1 472 is( $S2, $S3, 'bxors NULL string' ) 473 474 null $S1 475 set $S2, "abc" 476 $S1 = bxors $S1, $S2 477 is( $S1, "abc", 'bxors NULL string' ) 478 479 null $S2 480 $S1 = bxors $S1, $S2 481 is( $S1, "abc", 'bxors NULL string' ) 482 483 null $S1 484 null $S2 485 bxors $S3, $S1, $S2 486 null $S4 487 is( $S3, $S4, 'bxors NULL string' ) 488 489 set $S1, "" 490 bxors $S3, $S1, $S2 491 is( $S3, $S4, 'bxors NULL string' ) 492 493 bxors $S3, $S2, $S1 494 is( $S3, $S4, 'bxors NULL string' ) 495 496 set $S1, "abc" 497 bxors $S3, $S1, $S2 498 is( $S3, "abc", 'bxors NULL string' ) 499 500 bxors $S3, $S2, $S1 501 is( $S3, "abc", 'bxors NULL string' ) 502.end 503 504.sub bxors_2 505 set $S1, "a2c" 506 set $S2, "Dw" 507 $S1 = bxors $S1, $S2 508 is( $S1, "%Ec", 'bxors 2' ) 509 is( $S2, "Dw", 'bxors 2' ) 510 511 set $S1, "abc" 512 set $S2, " X" 513 $S1 = bxors $S1, $S2 514 is( $S1, "ABCX", 'bxors 2' ) 515 is( $S2, " X", 'bxors 2' ) 516 517 box $P0, "a2c" 518 set $S0, "Dw" 519 bxors $P0, $S0 520 is( $P0, "%Ec", 'bxors 2' ) 521 is( $S0, "Dw", 'bxors 2' ) 522 523 box $P0, "a2c" 524 bxors $P0, "Dw" 525 is( $P0, "%Ec", 'bxors 2' ) 526.end 527 528.sub bxors_3 529 set $S1, "a2c" 530 set $S2, "Dw" 531 bxors $S0, $S1, $S2 532 is( $S0, "%Ec", 'bxors 3' ) 533 is( $S1, "a2c", 'bxors 3' ) 534 is( $S2, "Dw", 'bxors 3' ) 535 536 set $S1, "abc" 537 set $S2, " Y" 538 bxors $S0, $S1, $S2 539 is( $S0, "ABCY", 'bxors 3' ) 540 is( $S1, "abc", 'bxors 3' ) 541 is( $S2, " Y", 'bxors 3' ) 542 543 set $S0, "abc" 544 bxors $S0, " Y", $S0 545 is( $S0, "ABCY", 'bxors 3' ) 546 547 bxors $S0, "abc", " Y" 548 is( $S0, "ABCY", 'bxors 3' ) 549 550 box $P0, "abc" 551 set $S0, " Y" 552 bxors $P0, $P0, $S0 553 is( $P0, "ABCY", 'bxors 3' ) 554 is( $S0, " Y", 'bxors 3' ) 555 556 box $P0, "abc" 557 bxors $P0, $P0, " Y" 558 is( $P0, "ABCY", 'bxors 3' ) 559.end 560 561.sub bxors_cow 562 set $S1, "foo" 563 substr $S2, $S1, 0, 3 564 $S1 = bxors $S1, "bar" 565 is( $S2, "foo", 'bxors COW' ) 566.end 567 568.sub bnot_1 569 $I0 = 10 570 bnot $I0 571 is($I0, -11, "bnot_i") 572 573 $I0 = bnot 11 574 is($I0, -12, "bnot_i_ic") 575 576 $P0 = new ["Integer"] 577 $P0 = 12 578 bnot $P0 579 is($P0, -13, "bnot_p") 580.end 581 582.sub bnots_null_string 583 null $S1 584 null $S2 585 bnots $S1, $S2 586 null $S3 587 is( $S1, $S3, 'bnots NULL string' ) 588 589 null $S1 590 set $S2, "" 591 bnots $S1, $S2 592 null $S3 593 is( $S1, $S3, 'bnots NULL string' ) 594 595 bnots $S2, $S1 596 is( $S2, $S3, 'bnots NULL string' ) 597.end 598 599# This was the previous test used for t/native_pbc/string.t 600.sub bnots_2 601 skip( 4, "No unicode yet" ) 602 # getstdout $P0 603 # push $P0, "utf8" 604 # set $S1, "a2c" 605 # bnots $S2, $S1 606 # is( $S1, "a2c", 'bnots 2' ) 607 # is( $S2, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' ) 608 # 609 # bnots $S1, $S1 610 # is( $S1, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' ) 611 # 612 # bnots $S1, $S1 613 # is( $S1, "a2c", 'bnots 2' ) 614.end 615 616.sub bnots_cow 617 set $S1, "foo" 618 substr $S2, $S1, 0, 3 619 bnots $S1, $S1 620 is( $S2, "foo", 'bnots COW' ) 621.end 622 623.sub rot_1 624 # Test basic rotation, really just a shift 625 $I0 = 0 626 $I1 = 10 # 10 rot 1 should be 20 (just a shift) 627 $I2 = 1 628 rot_i_i_i_ic $I0, $I1, $I2, 32 629 is ($I0, 20, "rot_i_i_i_ic") 630 631 # Reverse the rotation, shift the other way 632 $I2 = -1 633 rot_i_i_i_ic $I0, $I0, $I2, 32 634 is ($I0, 10, "rot_i_i_i_ic reverse") 635 636 $I0 = 0 637 $I1 = -1 638 rot_i_ic_i_ic $I0, 20, $I1, 32 639 is ($I0, 10, "rot_i_ic_i_ic") 640 641 $I0 = 0 642 rot_i_ic_ic_ic $I0, 20, 1, 32 643 is ($I0, 40, "rot_i_ic_ic_ic") 644 645 rot_i_ic_ic_ic $I0, 27, -3, 32 646 is($I0, 1610612739, "rot_i_ic_ic_ic") 647.end 648 649# Local Variables: 650# mode: pir 651# fill-column: 100 652# End: 653# vim: expandtab shiftwidth=4 ft=pir: 654