1#!/usr/bin/perl -w 2 3# GMP perl module tests 4 5# Copyright 2001-2003 Free Software Foundation, Inc. 6# 7# This file is part of the GNU MP Library. 8# 9# The GNU MP Library is free software; you can redistribute it and/or modify 10# it under the terms of either: 11# 12# * the GNU Lesser General Public License as published by the Free 13# Software Foundation; either version 3 of the License, or (at your 14# option) any later version. 15# 16# or 17# 18# * the GNU General Public License as published by the Free Software 19# Foundation; either version 2 of the License, or (at your option) any 20# later version. 21# 22# or both in parallel, as here. 23# 24# The GNU MP Library is distributed in the hope that it will be useful, but 25# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 26# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 27# for more details. 28# 29# You should have received copies of the GNU General Public License and the 30# GNU Lesser General Public License along with the GNU MP Library. If not, 31# see https://www.gnu.org/licenses/. 32 33 34# These tests aim to exercise the many possible combinations of operands 35# etc, and to run all functions at least once, which if nothing else will 36# check everything intended is in the :all list. 37# 38# Use the following in .emacs to match test failure messages. 39# 40# ;; perl "Test" module error messages 41# (eval-after-load "compile" 42# '(add-to-list 43# 'compilation-error-regexp-alist 44# '("^.*Failed test [0-9]+ in \\([^ ]+\\) at line \\([0-9]+\\)" 1 2))) 45 46 47use strict; 48use Test; 49 50BEGIN { 51 plan tests => 123, 52 onfail => sub { print "there were failures\n" }, 53} 54 55use GMP qw(:all); 56use GMP::Mpz qw(:all); 57use GMP::Mpq qw(:all); 58use GMP::Mpf qw(:all); 59use GMP::Rand qw(:all); 60 61use GMP::Mpz qw(:constants); 62use GMP::Mpz qw(:noconstants); 63use GMP::Mpq qw(:constants); 64use GMP::Mpq qw(:noconstants); 65use GMP::Mpf qw(:constants); 66use GMP::Mpf qw(:noconstants); 67 68package Mytie; 69use Exporter; 70use vars qw($val $fetched $stored); 71$val = 0; 72$fetched = 0; 73$stored = 0; 74sub TIESCALAR { 75 my ($class, $newval) = @_; 76 my $var = 'mytie dummy refed var'; 77 $val = $newval; 78 $fetched = 0; 79 $stored = 0; 80 return bless \$var, $class; 81} 82sub FETCH { 83 my ($self) = @_; 84 $fetched++; 85 return $val; 86} 87sub STORE { 88 my ($self, $newval) = @_; 89 $val = $newval; 90 $stored++; 91} 92package main; 93 94# check Mytie does what it should 95{ tie my $t, 'Mytie', 123; 96 ok ($Mytie::val == 123); 97 $Mytie::val = 456; 98 ok ($t == 456); 99 $t = 789; 100 ok ($Mytie::val == 789); 101} 102 103 104# Usage: str(x) 105# Return x forced to a string, not a PVIV. 106# 107sub str { 108 my $s = "$_[0]" . ""; 109 return $s; 110} 111 112my $ivnv_2p128 = 65536.0 * 65536.0 * 65536.0 * 65536.0 113 * 65536.0 * 65536.0 * 65536.0 * 65536.0; 114kill (0, $ivnv_2p128); 115my $str_2p128 = '340282366920938463463374607431768211456'; 116 117my $uv_max = ~ 0; 118my $uv_max_str = ~ 0; 119$uv_max_str = "$uv_max_str"; 120$uv_max_str = "" . "$uv_max_str"; 121 122 123#------------------------------------------------------------------------------ 124# GMP::version 125 126use GMP qw(version); 127print '$GMP::VERSION ',$GMP::VERSION,' GMP::version() ',version(),"\n"; 128 129 130#------------------------------------------------------------------------------ 131# GMP::Mpz::new 132 133ok (mpz(0) == 0); 134ok (mpz('0') == 0); 135ok (mpz(substr('101',1,1)) == 0); 136ok (mpz(0.0) == 0); 137ok (mpz(mpz(0)) == 0); 138ok (mpz(mpq(0)) == 0); 139ok (mpz(mpf(0)) == 0); 140 141{ tie my $t, 'Mytie', 0; 142 ok (mpz($t) == 0); 143 ok ($Mytie::fetched > 0); 144} 145{ tie my $t, 'Mytie', '0'; 146 ok (mpz($t) == 0); 147 ok ($Mytie::fetched > 0); 148} 149{ tie my $t, 'Mytie', substr('101',1,1); ok (mpz($t) == 0); } 150{ tie my $t, 'Mytie', 0.0; ok (mpz($t) == 0); } 151{ tie my $t, 'Mytie', mpz(0); ok (mpz($t) == 0); } 152{ tie my $t, 'Mytie', mpq(0); ok (mpz($t) == 0); } 153{ tie my $t, 'Mytie', mpf(0); ok (mpz($t) == 0); } 154 155ok (mpz(-123) == -123); 156ok (mpz('-123') == -123); 157ok (mpz(substr('1-1231',1,4)) == -123); 158ok (mpz(-123.0) == -123); 159ok (mpz(mpz(-123)) == -123); 160ok (mpz(mpq(-123)) == -123); 161ok (mpz(mpf(-123)) == -123); 162 163{ tie my $t, 'Mytie', -123; ok (mpz($t) == -123); } 164{ tie my $t, 'Mytie', '-123'; ok (mpz($t) == -123); } 165{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpz($t) == -123); } 166{ tie my $t, 'Mytie', -123.0; ok (mpz($t) == -123); } 167{ tie my $t, 'Mytie', mpz(-123); ok (mpz($t) == -123); } 168{ tie my $t, 'Mytie', mpq(-123); ok (mpz($t) == -123); } 169{ tie my $t, 'Mytie', mpf(-123); ok (mpz($t) == -123); } 170 171ok (mpz($ivnv_2p128) == $str_2p128); 172{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpz($t) == $str_2p128); } 173 174ok (mpz($uv_max) > 0); 175ok (mpz($uv_max) == mpz($uv_max_str)); 176{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) > 0); } 177{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) == mpz($uv_max_str)); } 178 179{ my $s = '999999999999999999999999999999'; 180 kill (0, $s); 181 ok (mpz($s) == '999999999999999999999999999999'); 182 tie my $t, 'Mytie', $s; 183 ok (mpz($t) == '999999999999999999999999999999'); 184} 185 186#------------------------------------------------------------------------------ 187# GMP::Mpz::overload_abs 188 189ok (abs(mpz(0)) == 0); 190ok (abs(mpz(123)) == 123); 191ok (abs(mpz(-123)) == 123); 192 193{ my $x = mpz(-123); $x = abs($x); ok ($x == 123); } 194{ my $x = mpz(0); $x = abs($x); ok ($x == 0); } 195{ my $x = mpz(123); $x = abs($x); ok ($x == 123); } 196 197{ tie my $t, 'Mytie', mpz(0); ok (abs($t) == 0); } 198{ tie my $t, 'Mytie', mpz(123); ok (abs($t) == 123); } 199{ tie my $t, 'Mytie', mpz(-123); ok (abs($t) == 123); } 200 201#------------------------------------------------------------------------------ 202# GMP::Mpz::overload_add 203 204ok (mpz(0) + 1 == 1); 205ok (mpz(-1) + 1 == 0); 206ok (1 + mpz(0) == 1); 207ok (1 + mpz(-1) == 0); 208 209#------------------------------------------------------------------------------ 210# GMP::Mpz::overload_addeq 211 212{ my $a = mpz(7); $a += 1; ok ($a == 8); } 213{ my $a = mpz(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } 214 215#------------------------------------------------------------------------------ 216# GMP::Mpz::overload_and 217 218ok ((mpz(3) & 1) == 1); 219ok ((mpz(3) & 4) == 0); 220 221{ my $a = mpz(3); $a &= 1; ok ($a == 1); } 222{ my $a = mpz(3); $a &= 4; ok ($a == 0); } 223 224#------------------------------------------------------------------------------ 225# GMP::Mpz::overload_bool 226 227if (mpz(0)) { ok (0); } else { ok (1); } 228if (mpz(123)) { ok (1); } else { ok (0); } 229 230#------------------------------------------------------------------------------ 231# GMP::Mpz::overload_com 232 233ok (~ mpz(0) == -1); 234ok (~ mpz(1) == -2); 235ok (~ mpz(-2) == 1); 236ok (~ mpz(0xFF) == -0x100); 237ok (~ mpz(-0x100) == 0xFF); 238 239#------------------------------------------------------------------------------ 240# GMP::Mpz::overload_dec 241 242{ my $a = mpz(0); ok ($a-- == 0); ok ($a == -1); } 243{ my $a = mpz(0); ok (--$a == -1); } 244 245{ my $a = mpz(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } 246 247#------------------------------------------------------------------------------ 248# GMP::Mpz::overload_div 249 250ok (mpz(6) / 2 == 3); 251ok (mpz(-6) / 2 == -3); 252ok (mpz(6) / -2 == -3); 253ok (mpz(-6) / -2 == 3); 254 255#------------------------------------------------------------------------------ 256# GMP::Mpz::overload_diveq 257 258{ my $a = mpz(21); $a /= 3; ok ($a == 7); } 259{ my $a = mpz(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } 260 261#------------------------------------------------------------------------------ 262# GMP::Mpz::overload_eq 263 264{ my $a = mpz(0); 265 my $b = $a; 266 $a = mpz(1); 267 ok ($a == 1); 268 ok ($b == 0); } 269 270#------------------------------------------------------------------------------ 271# GMP::Mpz::overload_inc 272 273{ my $a = mpz(0); ok ($a++ == 0); ok ($a == 1); } 274{ my $a = mpz(0); ok (++$a == 1); } 275 276{ my $a = mpz(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } 277 278#------------------------------------------------------------------------------ 279# GMP::Mpz::overload_ior 280 281ok ((mpz(3) | 1) == 3); 282ok ((mpz(3) | 4) == 7); 283 284{ my $a = mpz(3); $a |= 1; ok ($a == 3); } 285{ my $a = mpz(3); $a |= 4; ok ($a == 7); } 286 287ok ((mpz("0xAA") | mpz("0x55")) == mpz("0xFF")); 288 289#------------------------------------------------------------------------------ 290# GMP::Mpz::overload_lshift 291 292{ my $a = mpz(7) << 1; ok ($a == 14); } 293 294#------------------------------------------------------------------------------ 295# GMP::Mpz::overload_lshifteq 296 297{ my $a = mpz(7); $a <<= 1; ok ($a == 14); } 298{ my $a = mpz(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } 299 300#------------------------------------------------------------------------------ 301# GMP::Mpz::overload_mul 302 303ok (mpz(2) * 3 == 6); 304 305#------------------------------------------------------------------------------ 306# GMP::Mpz::overload_muleq 307 308{ my $a = mpz(7); $a *= 3; ok ($a == 21); } 309{ my $a = mpz(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } 310 311#------------------------------------------------------------------------------ 312# GMP::Mpz::overload_neg 313 314ok (- mpz(0) == 0); 315ok (- mpz(123) == -123); 316ok (- mpz(-123) == 123); 317 318#------------------------------------------------------------------------------ 319# GMP::Mpz::overload_not 320 321if (not mpz(0)) { ok (1); } else { ok (0); } 322if (not mpz(123)) { ok (0); } else { ok (1); } 323 324ok ((! mpz(0)) == 1); 325ok ((! mpz(123)) == 0); 326 327#------------------------------------------------------------------------------ 328# GMP::Mpz::overload_pow 329 330ok (mpz(0) ** 1 == 0); 331ok (mpz(1) ** 1 == 1); 332ok (mpz(2) ** 0 == 1); 333ok (mpz(2) ** 1 == 2); 334ok (mpz(2) ** 2 == 4); 335ok (mpz(2) ** 3 == 8); 336ok (mpz(2) ** 4 == 16); 337 338ok (mpz(0) ** mpz(1) == 0); 339ok (mpz(1) ** mpz(1) == 1); 340ok (mpz(2) ** mpz(0) == 1); 341ok (mpz(2) ** mpz(1) == 2); 342ok (mpz(2) ** mpz(2) == 4); 343ok (mpz(2) ** mpz(3) == 8); 344ok (mpz(2) ** mpz(4) == 16); 345 346#------------------------------------------------------------------------------ 347# GMP::Mpz::overload_poweq 348 349{ my $a = mpz(3); $a **= 4; ok ($a == 81); } 350{ my $a = mpz(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } 351 352#------------------------------------------------------------------------------ 353# GMP::Mpz::overload_rem 354 355ok (mpz(-8) % 3 == -2); 356ok (mpz(-7) % 3 == -1); 357ok (mpz(-6) % 3 == 0); 358ok (mpz(6) % 3 == 0); 359ok (mpz(7) % 3 == 1); 360ok (mpz(8) % 3 == 2); 361 362{ my $a = mpz(24); $a %= 7; ok ($a == 3); } 363 364#------------------------------------------------------------------------------ 365# GMP::Mpz::overload_rshift 366 367{ my $a = mpz(32) >> 1; ok ($a == 16); } 368 369#------------------------------------------------------------------------------ 370# GMP::Mpz::overload_rshifteq 371 372{ my $a = mpz(32); $a >>= 1; ok ($a == 16); } 373{ my $a = mpz(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } 374 375#------------------------------------------------------------------------------ 376# GMP::Mpz::overload_spaceship 377 378ok (mpz(0) < 1); 379ok (mpz(0) > -1); 380 381ok (mpz(0) != 1); 382ok (mpz(0) != -1); 383ok (mpz(1) != 0); 384ok (mpz(1) != -1); 385ok (mpz(-1) != 0); 386ok (mpz(-1) != 1); 387 388ok (mpz(0) < 1.0); 389ok (mpz(0) < '1'); 390ok (mpz(0) < substr('-1',1,1)); 391ok (mpz(0) < mpz(1)); 392ok (mpz(0) < mpq(1)); 393ok (mpz(0) < mpf(1)); 394ok (mpz(0) < $uv_max); 395 396#------------------------------------------------------------------------------ 397# GMP::Mpz::overload_sqrt 398 399ok (sqrt(mpz(0)) == 0); 400ok (sqrt(mpz(1)) == 1); 401ok (sqrt(mpz(4)) == 2); 402ok (sqrt(mpz(81)) == 9); 403 404#------------------------------------------------------------------------------ 405# GMP::Mpz::overload_string 406 407{ my $x = mpz(0); ok("$x" eq "0"); } 408{ my $x = mpz(123); ok("$x" eq "123"); } 409{ my $x = mpz(-123); ok("$x" eq "-123"); } 410 411#------------------------------------------------------------------------------ 412# GMP::Mpz::overload_sub 413 414ok (mpz(0) - 1 == -1); 415ok (mpz(1) - 1 == 0); 416ok (1 - mpz(0) == 1); 417ok (1 - mpz(1) == 0); 418 419#------------------------------------------------------------------------------ 420# GMP::Mpz::overload_subeq 421 422{ my $a = mpz(7); $a -= 1; ok ($a == 6); } 423{ my $a = mpz(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } 424 425#------------------------------------------------------------------------------ 426# GMP::Mpz::overload_xor 427 428ok ((mpz(3) ^ 1) == 2); 429ok ((mpz(3) ^ 4) == 7); 430 431{ my $a = mpz(3); $a ^= 1; ok ($a == 2); } 432{ my $a = mpz(3); $a ^= 4; ok ($a == 7); } 433 434 435#------------------------------------------------------------------------------ 436# GMP::Mpz::bin 437 438ok (bin(2,0) == 1); 439ok (bin(2,1) == 2); 440ok (bin(2,2) == 1); 441 442ok (bin(3,0) == 1); 443ok (bin(3,1) == 3); 444ok (bin(3,2) == 3); 445ok (bin(3,3) == 1); 446 447 448#------------------------------------------------------------------------------ 449# GMP::Mpz::cdiv 450 451{ my ($q, $r); 452 ($q, $r) = cdiv (16, 3); 453 ok ($q == 6); 454 ok ($r == -2); 455 ($q, $r) = cdiv (16, -3); 456 ok ($q == -5); 457 ok ($r == 1); 458 ($q, $r) = cdiv (-16, 3); 459 ok ($q == -5); 460 ok ($r == -1); 461 ($q, $r) = cdiv (-16, -3); 462 ok ($q == 6); 463 ok ($r == 2); 464} 465 466 467#------------------------------------------------------------------------------ 468# GMP::Mpz::cdiv_2exp 469 470{ my ($q, $r); 471 ($q, $r) = cdiv_2exp (23, 2); 472 ok ($q == 6); 473 ok ($r == -1); 474 ($q, $r) = cdiv_2exp (-23, 2); 475 ok ($q == -5); 476 ok ($r == -3); 477} 478 479 480#------------------------------------------------------------------------------ 481# GMP::Mpz::clrbit 482 483{ my $a = mpz(3); clrbit ($a, 1); ok ($a == 1); 484 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 485{ my $a = mpz(3); clrbit ($a, 2); ok ($a == 3); 486 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 487 488{ my $a = 3; clrbit ($a, 1); ok ($a == 1); 489 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 490{ my $a = 3; clrbit ($a, 2); ok ($a == 3); 491 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 492 493# mutate only given variable 494{ my $a = mpz(3); 495 my $b = $a; 496 clrbit ($a, 0); 497 ok ($a == 2); 498 ok ($b == 3); 499} 500{ my $a = 3; 501 my $b = $a; 502 clrbit ($a, 0); 503 ok ($a == 2); 504 ok ($b == 3); 505} 506 507{ tie my $a, 'Mytie', mpz(3); 508 clrbit ($a, 1); 509 ok ($Mytie::fetched > 0); # used fetch 510 ok ($Mytie::stored > 0); # used store 511 ok ($a == 1); # expected result 512 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 513 ok (tied($a)); # still tied 514} 515{ tie my $a, 'Mytie', 3; 516 clrbit ($a, 1); 517 ok ($Mytie::fetched > 0); # used fetch 518 ok ($Mytie::stored > 0); # used store 519 ok ($a == 1); # expected result 520 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 521 ok (tied($a)); # still tied 522} 523 524{ my $b = mpz(3); 525 tie my $a, 'Mytie', $b; 526 clrbit ($a, 0); 527 ok ($a == 2); 528 ok ($b == 3); 529 ok (tied($a)); 530} 531{ my $b = 3; 532 tie my $a, 'Mytie', $b; 533 clrbit ($a, 0); 534 ok ($a == 2); 535 ok ($b == 3); 536 ok (tied($a)); 537} 538 539#------------------------------------------------------------------------------ 540# GMP::Mpz::combit 541 542{ my $a = mpz(3); combit ($a, 1); ok ($a == 1); 543 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 544{ my $a = mpz(3); combit ($a, 2); ok ($a == 7); 545 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 546 547{ my $a = 3; combit ($a, 1); ok ($a == 1); 548 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 549{ my $a = 3; combit ($a, 2); ok ($a == 7); 550 ok (UNIVERSAL::isa($a,"GMP::Mpz")); } 551 552# mutate only given variable 553{ my $a = mpz(3); 554 my $b = $a; 555 combit ($a, 0); 556 ok ($a == 2); 557 ok ($b == 3); 558} 559{ my $a = 3; 560 my $b = $a; 561 combit ($a, 0); 562 ok ($a == 2); 563 ok ($b == 3); 564} 565 566{ tie my $a, 'Mytie', mpz(3); 567 combit ($a, 2); 568 ok ($Mytie::fetched > 0); # used fetch 569 ok ($Mytie::stored > 0); # used store 570 ok ($a == 7); # expected result 571 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 572 ok (tied($a)); # still tied 573} 574{ tie my $a, 'Mytie', 3; 575 combit ($a, 2); 576 ok ($Mytie::fetched > 0); # used fetch 577 ok ($Mytie::stored > 0); # used store 578 ok ($a == 7); # expected result 579 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 580 ok (tied($a)); # still tied 581} 582 583{ my $b = mpz(3); 584 tie my $a, 'Mytie', $b; 585 combit ($a, 0); 586 ok ($a == 2); 587 ok ($b == 3); 588 ok (tied($a)); 589} 590{ my $b = 3; 591 tie my $a, 'Mytie', $b; 592 combit ($a, 0); 593 ok ($a == 2); 594 ok ($b == 3); 595 ok (tied($a)); 596} 597 598#------------------------------------------------------------------------------ 599# GMP::Mpz::congruent_p 600 601ok ( congruent_p (21, 0, 7)); 602ok (! congruent_p (21, 1, 7)); 603ok ( congruent_p (21, 5, 8)); 604ok (! congruent_p (21, 6, 8)); 605 606 607#------------------------------------------------------------------------------ 608# GMP::Mpz::congruent_2exp_p 609 610ok ( congruent_2exp_p (20, 0, 2)); 611ok (! congruent_2exp_p (21, 0, 2)); 612ok (! congruent_2exp_p (20, 1, 2)); 613 614#------------------------------------------------------------------------------ 615# GMP::Mpz::divexact 616 617ok (divexact(27,3) == 9); 618ok (divexact(27,-3) == -9); 619ok (divexact(-27,3) == -9); 620ok (divexact(-27,-3) == 9); 621 622#------------------------------------------------------------------------------ 623# GMP::Mpz::divisible_p 624 625ok ( divisible_p (21, 7)); 626ok (! divisible_p (21, 8)); 627 628#------------------------------------------------------------------------------ 629# GMP::Mpz::divisible_2exp_p 630 631ok ( divisible_2exp_p (20, 2)); 632ok (! divisible_2exp_p (21, 2)); 633 634#------------------------------------------------------------------------------ 635# GMP::Mpz::even_p 636 637ok (! even_p(mpz(-3))); 638ok ( even_p(mpz(-2))); 639ok (! even_p(mpz(-1))); 640ok ( even_p(mpz(0))); 641ok (! even_p(mpz(1))); 642ok ( even_p(mpz(2))); 643ok (! even_p(mpz(3))); 644 645#------------------------------------------------------------------------------ 646# GMP::Mpz::export 647 648{ my $s = mpz_export (1, 2, 1, 0, "0x61626364"); 649 ok ($s eq 'abcd'); } 650{ my $s = mpz_export (-1, 2, 1, 0, "0x61626364"); 651 ok ($s eq 'cdab'); } 652{ my $s = mpz_export (1, 2, -1, 0, "0x61626364"); 653 ok ($s eq 'badc'); } 654{ my $s = mpz_export (-1, 2, -1, 0, "0x61626364"); 655 ok ($s eq 'dcba'); } 656 657#------------------------------------------------------------------------------ 658# GMP::Mpz::fac 659 660ok (fac(0) == 1); 661ok (fac(1) == 1); 662ok (fac(2) == 2); 663ok (fac(3) == 6); 664ok (fac(4) == 24); 665ok (fac(5) == 120); 666 667#------------------------------------------------------------------------------ 668# GMP::Mpz::fdiv 669 670{ my ($q, $r); 671 ($q, $r) = fdiv (16, 3); 672 ok ($q == 5); 673 ok ($r == 1); 674 ($q, $r) = fdiv (16, -3); 675 ok ($q == -6); 676 ok ($r == -2); 677 ($q, $r) = fdiv (-16, 3); 678 ok ($q == -6); 679 ok ($r == 2); 680 ($q, $r) = fdiv (-16, -3); 681 ok ($q == 5); 682 ok ($r == -1); 683} 684 685#------------------------------------------------------------------------------ 686# GMP::Mpz::fdiv_2exp 687 688{ my ($q, $r); 689 ($q, $r) = fdiv_2exp (23, 2); 690 ok ($q == 5); 691 ok ($r == 3); 692 ($q, $r) = fdiv_2exp (-23, 2); 693 ok ($q == -6); 694 ok ($r == 1); 695} 696 697#------------------------------------------------------------------------------ 698# GMP::Mpz::fib 699 700ok (fib(0) == 0); 701ok (fib(1) == 1); 702ok (fib(2) == 1); 703ok (fib(3) == 2); 704ok (fib(4) == 3); 705ok (fib(5) == 5); 706ok (fib(6) == 8); 707 708#------------------------------------------------------------------------------ 709# GMP::Mpz::fib2 710 711{ my ($a, $b) = fib2(0); ok($a==0); ok($b==1); } 712{ my ($a, $b) = fib2(1); ok($a==1); ok($b==0); } 713{ my ($a, $b) = fib2(2); ok($a==1); ok($b==1); } 714{ my ($a, $b) = fib2(3); ok($a==2); ok($b==1); } 715{ my ($a, $b) = fib2(4); ok($a==3); ok($b==2); } 716{ my ($a, $b) = fib2(5); ok($a==5); ok($b==3); } 717{ my ($a, $b) = fib2(6); ok($a==8); ok($b==5); } 718 719#------------------------------------------------------------------------------ 720# GMP::Mpz::gcd 721 722ok (gcd (21) == 21); 723ok (gcd (21,15) == 3); 724ok (gcd (21,15,30,57) == 3); 725ok (gcd (21,-15) == 3); 726ok (gcd (-21,15) == 3); 727ok (gcd (-21,-15) == 3); 728 729#------------------------------------------------------------------------------ 730# GMP::Mpz::gcdext 731 732{ 733 my ($g, $x, $y) = gcdext (3,5); 734 ok ($g == 1); 735 ok ($x == 2); 736 ok ($y == -1); 737} 738 739#------------------------------------------------------------------------------ 740# GMP::Mpz::hamdist 741 742ok (hamdist(5,7) == 1); 743 744#------------------------------------------------------------------------------ 745# GMP::Mpz::import 746 747{ my $z = mpz_import (1, 2, 1, 0, 'abcd'); 748 ok ($z == 0x61626364); } 749{ my $z = mpz_import (-1, 2, 1, 0, 'abcd'); 750 ok ($z == 0x63646162); } 751{ my $z = mpz_import (1, 2, -1, 0, 'abcd'); 752 ok ($z == 0x62616463); } 753{ my $z = mpz_import (-1, 2, -1, 0, 'abcd'); 754 ok ($z == 0x64636261); } 755 756#------------------------------------------------------------------------------ 757# GMP::Mpz::invert 758 759ok (invert(1,123) == 1); 760ok (invert(6,7) == 6); 761ok (! defined invert(2,8)); 762 763#------------------------------------------------------------------------------ 764# GMP::Mpz::jacobi, GMP::Mpz::kronecker 765 766foreach my $i ([ 1, 19, 1 ], 767 [ 4, 19, 1 ], 768 [ 5, 19, 1 ], 769 [ 6, 19, 1 ], 770 [ 7, 19, 1 ], 771 [ 9, 19, 1 ], 772 [ 11, 19, 1 ], 773 [ 16, 19, 1 ], 774 [ 17, 19, 1 ], 775 [ 2, 19, -1 ], 776 [ 3, 19, -1 ], 777 [ 8, 19, -1 ], 778 [ 10, 19, -1 ], 779 [ 12, 19, -1 ], 780 [ 13, 19, -1 ], 781 [ 14, 19, -1 ], 782 [ 15, 19, -1 ], 783 [ 18, 19, -1 ]) { 784 foreach my $fun (\&jacobi, \&kronecker) { 785 ok (&$fun ($$i[0], $$i[1]) == $$i[2]); 786 787 ok (&$fun ($$i[0], str($$i[1])) == $$i[2]); 788 ok (&$fun (str($$i[0]), $$i[1]) == $$i[2]); 789 ok (&$fun (str($$i[0]), str($$i[1])) == $$i[2]); 790 791 ok (&$fun ($$i[0], mpz($$i[1])) == $$i[2]); 792 ok (&$fun (mpz($$i[0]), $$i[1]) == $$i[2]); 793 ok (&$fun (mpz($$i[0]), mpz($$i[1])) == $$i[2]); 794 } 795} 796 797#------------------------------------------------------------------------------ 798# GMP::Mpz::lcm 799 800ok (lcm (2) == 2); 801ok (lcm (0) == 0); 802ok (lcm (0,0) == 0); 803ok (lcm (0,0,0) == 0); 804ok (lcm (0,0,0,0) == 0); 805ok (lcm (2,0) == 0); 806ok (lcm (-2,0) == 0); 807ok (lcm (2,3) == 6); 808ok (lcm (2,3,4) == 12); 809ok (lcm (2,-3) == 6); 810ok (lcm (-2,3) == 6); 811ok (lcm (-2,-3) == 6); 812ok (lcm (mpz(2)**512,1) == mpz(2)**512); 813ok (lcm (mpz(2)**512,-1) == mpz(2)**512); 814ok (lcm (-mpz(2)**512,1) == mpz(2)**512); 815ok (lcm (-mpz(2)**512,-1) == mpz(2)**512); 816ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512); 817ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512); 818ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512); 819ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512); 820 821#------------------------------------------------------------------------------ 822# GMP::Mpz::lucnum 823 824ok (lucnum(0) == 2); 825ok (lucnum(1) == 1); 826ok (lucnum(2) == 3); 827ok (lucnum(3) == 4); 828ok (lucnum(4) == 7); 829ok (lucnum(5) == 11); 830ok (lucnum(6) == 18); 831 832#------------------------------------------------------------------------------ 833# GMP::Mpz::lucnum2 834 835{ my ($a, $b) = lucnum2(0); ok($a==2); ok($b==-1); } 836{ my ($a, $b) = lucnum2(1); ok($a==1); ok($b==2); } 837{ my ($a, $b) = lucnum2(2); ok($a==3); ok($b==1); } 838{ my ($a, $b) = lucnum2(3); ok($a==4); ok($b==3); } 839{ my ($a, $b) = lucnum2(4); ok($a==7); ok($b==4); } 840{ my ($a, $b) = lucnum2(5); ok($a==11); ok($b==7); } 841{ my ($a, $b) = lucnum2(6); ok($a==18); ok($b==11); } 842 843#------------------------------------------------------------------------------ 844# GMP::Mpz::nextprime 845 846ok (nextprime(2) == 3); 847ok (nextprime(3) == 5); 848ok (nextprime(5) == 7); 849ok (nextprime(7) == 11); 850ok (nextprime(11) == 13); 851 852#------------------------------------------------------------------------------ 853# GMP::Mpz::perfect_power_p 854 855# ok ( perfect_power_p(mpz(-27))); 856# ok (! perfect_power_p(mpz(-9))); 857# ok (! perfect_power_p(mpz(-1))); 858ok ( perfect_power_p(mpz(0))); 859ok ( perfect_power_p(mpz(1))); 860ok (! perfect_power_p(mpz(2))); 861ok (! perfect_power_p(mpz(3))); 862ok ( perfect_power_p(mpz(4))); 863ok ( perfect_power_p(mpz(9))); 864ok ( perfect_power_p(mpz(27))); 865ok ( perfect_power_p(mpz(81))); 866 867#------------------------------------------------------------------------------ 868# GMP::Mpz::perfect_square_p 869 870ok (! perfect_square_p(mpz(-9))); 871ok (! perfect_square_p(mpz(-1))); 872ok ( perfect_square_p(mpz(0))); 873ok ( perfect_square_p(mpz(1))); 874ok (! perfect_square_p(mpz(2))); 875ok (! perfect_square_p(mpz(3))); 876ok ( perfect_square_p(mpz(4))); 877ok ( perfect_square_p(mpz(9))); 878ok (! perfect_square_p(mpz(27))); 879ok ( perfect_square_p(mpz(81))); 880 881#------------------------------------------------------------------------------ 882# GMP::Mpz::popcount 883 884ok (popcount(7) == 3); 885 886#------------------------------------------------------------------------------ 887# GMP::Mpz::powm 888 889ok (powm (3,2,8) == 1); 890 891#------------------------------------------------------------------------------ 892# GMP::Mpz::probab_prime_p 893 894ok ( probab_prime_p(89,1)); 895ok (! probab_prime_p(81,1)); 896 897#------------------------------------------------------------------------------ 898# GMP::Mpz::realloc 899 900{ my $z = mpz(123); 901 realloc ($z, 512); } 902 903#------------------------------------------------------------------------------ 904# GMP::Mpz::remove 905 906{ 907 my ($rem, $mult); 908 ($rem, $mult) = remove(12,3); 909 ok ($rem == 4); 910 ok ($mult == 1); 911 ($rem, $mult) = remove(12,2); 912 ok ($rem == 3); 913 ok ($mult == 2); 914} 915 916#------------------------------------------------------------------------------ 917# GMP::Mpz::root 918 919ok (root(0,2) == 0); 920ok (root(8,3) == 2); 921ok (root(-8,3) == -2); 922ok (root(81,4) == 3); 923ok (root(243,5) == 3); 924 925#------------------------------------------------------------------------------ 926# GMP::Mpz::roote 927 928{ my ($r,$e); 929 ($r, $e) = roote(0,2); 930 ok ($r == 0); 931 ok ($e); 932 ($r, $e) = roote(81,4); 933 ok ($r == 3); 934 ok ($e); 935 ($r, $e) = roote(85,4); 936 ok ($r == 3); 937 ok (! $e); 938} 939 940#------------------------------------------------------------------------------ 941# GMP::Mpz::rootrem 942 943{ my ($root, $rem) = rootrem (mpz(0), 1); 944 ok ($root == 0); ok ($rem == 0); } 945{ my ($root, $rem) = rootrem (mpz(0), 2); 946 ok ($root == 0); ok ($rem == 0); } 947{ my ($root, $rem) = rootrem (mpz(64), 2); 948 ok ($root == 8); ok ($rem == 0); } 949{ my ($root, $rem) = rootrem (mpz(64), 3); 950 ok ($root == 4); ok ($rem == 0); } 951{ my ($root, $rem) = rootrem (mpz(65), 3); 952 ok ($root == 4); ok ($rem == 1); } 953 954#------------------------------------------------------------------------------ 955# GMP::Mpz::scan0 956 957ok (scan0 (0, 0) == 0); 958ok (scan0 (1, 0) == 1); 959ok (scan0 (3, 0) == 2); 960ok (scan0 (-1, 0) == ~0); 961ok (scan0 (-2, 1) == ~0); 962 963#------------------------------------------------------------------------------ 964# GMP::Mpz::scan1 965 966ok (scan1 (1, 0) == 0); 967ok (scan1 (2, 0) == 1); 968ok (scan1 (4, 0) == 2); 969ok (scan1 (0, 0) == ~0); 970ok (scan1 (3, 2) == ~0); 971 972#------------------------------------------------------------------------------ 973# GMP::Mpz::setbit 974 975{ my $a = mpz(3); setbit ($a, 1); ok ($a == 3); } 976{ my $a = mpz(3); setbit ($a, 2); ok ($a == 7); } 977 978{ my $a = 3; setbit ($a, 1); ok ($a == 3); } 979{ my $a = 3; setbit ($a, 2); ok ($a == 7); } 980 981# mutate only given variable 982{ my $a = mpz(0); 983 my $b = $a; 984 setbit ($a, 0); 985 ok ($a == 1); 986 ok ($b == 0); 987} 988{ my $a = 0; 989 my $b = $a; 990 setbit ($a, 0); 991 ok ($a == 1); 992 ok ($b == 0); 993} 994 995{ tie my $a, 'Mytie', mpz(3); 996 setbit ($a, 2); 997 ok ($Mytie::fetched > 0); # used fetch 998 ok ($Mytie::stored > 0); # used store 999 ok ($a == 7); # expected result 1000 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 1001 ok (tied($a)); # still tied 1002} 1003{ tie my $a, 'Mytie', 3; 1004 setbit ($a, 2); 1005 ok ($Mytie::fetched > 0); # used fetch 1006 ok ($Mytie::stored > 0); # used store 1007 ok ($a == 7); # expected result 1008 ok (UNIVERSAL::isa($a,"GMP::Mpz")); 1009 ok (tied($a)); # still tied 1010} 1011 1012{ my $b = mpz(2); 1013 tie my $a, 'Mytie', $b; 1014 setbit ($a, 0); 1015 ok ($a == 3); 1016 ok ($b == 2); 1017 ok (tied($a)); 1018} 1019{ my $b = 2; 1020 tie my $a, 'Mytie', $b; 1021 setbit ($a, 0); 1022 ok ($a == 3); 1023 ok ($b == 2); 1024 ok (tied($a)); 1025} 1026 1027#------------------------------------------------------------------------------ 1028# GMP::Mpz::sizeinbase 1029 1030ok (sizeinbase(1,10) == 1); 1031ok (sizeinbase(100,10) == 3); 1032ok (sizeinbase(9999,10) == 5); 1033 1034#------------------------------------------------------------------------------ 1035# GMP::Mpz::sqrtrem 1036 1037{ 1038 my ($root, $rem) = sqrtrem(mpz(0)); 1039 ok ($root == 0); 1040 ok ($rem == 0); 1041} 1042{ 1043 my ($root, $rem) = sqrtrem(mpz(1)); 1044 ok ($root == 1); 1045 ok ($rem == 0); 1046} 1047{ 1048 my ($root, $rem) = sqrtrem(mpz(2)); 1049 ok ($root == 1); 1050 ok ($rem == 1); 1051} 1052{ 1053 my ($root, $rem) = sqrtrem(mpz(9)); 1054 ok ($root == 3); 1055 ok ($rem == 0); 1056} 1057{ 1058 my ($root, $rem) = sqrtrem(mpz(35)); 1059 ok ($root == 5); 1060 ok ($rem == 10); 1061} 1062{ 1063 my ($root, $rem) = sqrtrem(mpz(0)); 1064 ok ($root == 0); 1065 ok ($rem == 0); 1066} 1067 1068#------------------------------------------------------------------------------ 1069# GMP::Mpz::tdiv 1070 1071{ my ($q, $r); 1072 ($q, $r) = tdiv (16, 3); 1073 ok ($q == 5); 1074 ok ($r == 1); 1075 ($q, $r) = tdiv (16, -3); 1076 ok ($q == -5); 1077 ok ($r == 1); 1078 ($q, $r) = tdiv (-16, 3); 1079 ok ($q == -5); 1080 ok ($r == -1); 1081 ($q, $r) = tdiv (-16, -3); 1082 ok ($q == 5); 1083 ok ($r == -1); 1084} 1085 1086#------------------------------------------------------------------------------ 1087# GMP::Mpz::tdiv_2exp 1088 1089{ my ($q, $r); 1090 ($q, $r) = tdiv_2exp (23, 2); 1091 ok ($q == 5); 1092 ok ($r == 3); 1093 ($q, $r) = tdiv_2exp (-23, 2); 1094 ok ($q == -5); 1095 ok ($r == -3); 1096} 1097 1098#------------------------------------------------------------------------------ 1099# GMP::Mpz::tstbit 1100 1101ok (tstbit (6, 0) == 0); 1102ok (tstbit (6, 1) == 1); 1103ok (tstbit (6, 2) == 1); 1104ok (tstbit (6, 3) == 0); 1105 1106 1107 1108 1109#------------------------------------------------------------------------------ 1110# GMP::Mpq 1111 1112#------------------------------------------------------------------------------ 1113# GMP::Mpq::new 1114 1115ok (mpq(0) == 0); 1116ok (mpq('0') == 0); 1117ok (mpq(substr('101',1,1)) == 0); 1118ok (mpq(0.0) == 0); 1119ok (mpq(mpz(0)) == 0); 1120ok (mpq(mpq(0)) == 0); 1121ok (mpq(mpf(0)) == 0); 1122 1123{ tie my $t, 'Mytie', 0; ok (mpq($t) == 0); } 1124{ tie my $t, 'Mytie', '0'; ok (mpq($t) == 0); } 1125{ tie my $t, 'Mytie', substr('101',1,1); ok (mpq($t) == 0); } 1126{ tie my $t, 'Mytie', 0.0; ok (mpq($t) == 0); } 1127{ tie my $t, 'Mytie', mpz(0); ok (mpq($t) == 0); } 1128{ tie my $t, 'Mytie', mpq(0); ok (mpq($t) == 0); } 1129{ tie my $t, 'Mytie', mpf(0); ok (mpq($t) == 0); } 1130 1131ok (mpq(-123) == -123); 1132ok (mpq('-123') == -123); 1133ok (mpq(substr('1-1231',1,4)) == -123); 1134ok (mpq(-123.0) == -123); 1135ok (mpq(mpz(-123)) == -123); 1136ok (mpq(mpq(-123)) == -123); 1137ok (mpq(mpf(-123)) == -123); 1138 1139{ tie my $t, 'Mytie', -123; ok (mpq($t) == -123); } 1140{ tie my $t, 'Mytie', '-123'; ok (mpq($t) == -123); } 1141{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpq($t) == -123); } 1142{ tie my $t, 'Mytie', -123.0; ok (mpq($t) == -123); } 1143{ tie my $t, 'Mytie', mpz(-123); ok (mpq($t) == -123); } 1144{ tie my $t, 'Mytie', mpq(-123); ok (mpq($t) == -123); } 1145{ tie my $t, 'Mytie', mpf(-123); ok (mpq($t) == -123); } 1146 1147ok (mpq($ivnv_2p128) == $str_2p128); 1148{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpq($t) == $str_2p128); } 1149 1150ok (mpq('3/2') == mpq(3,2)); 1151ok (mpq('3/1') == mpq(3,1)); 1152ok (mpq('-3/2') == mpq(-3,2)); 1153ok (mpq('-3/1') == mpq(-3,1)); 1154ok (mpq('0x3') == mpq(3,1)); 1155ok (mpq('0b111') == mpq(7,1)); 1156ok (mpq('0b0') == mpq(0,1)); 1157 1158ok (mpq($uv_max) > 0); 1159ok (mpq($uv_max) == mpq($uv_max_str)); 1160{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) > 0); } 1161{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) == mpq($uv_max_str)); } 1162 1163{ my $x = 123.5; 1164 kill (0, $x); 1165 ok (mpq($x) == 123.5); 1166 tie my $t, 'Mytie', $x; 1167 ok (mpq($t) == 123.5); 1168} 1169 1170#------------------------------------------------------------------------------ 1171# GMP::Mpq::overload_abs 1172 1173ok (abs(mpq(0)) == 0); 1174ok (abs(mpq(123)) == 123); 1175ok (abs(mpq(-123)) == 123); 1176 1177{ my $x = mpq(-123); $x = abs($x); ok ($x == 123); } 1178{ my $x = mpq(0); $x = abs($x); ok ($x == 0); } 1179{ my $x = mpq(123); $x = abs($x); ok ($x == 123); } 1180 1181{ tie my $t, 'Mytie', mpq(0); ok (abs($t) == 0); } 1182{ tie my $t, 'Mytie', mpq(123); ok (abs($t) == 123); } 1183{ tie my $t, 'Mytie', mpq(-123); ok (abs($t) == 123); } 1184 1185#------------------------------------------------------------------------------ 1186# GMP::Mpq::overload_add 1187 1188ok (mpq(0) + 1 == 1); 1189ok (mpq(-1) + 1 == 0); 1190ok (1 + mpq(0) == 1); 1191ok (1 + mpq(-1) == 0); 1192 1193ok (mpq(1,2)+mpq(1,3) == mpq(5,6)); 1194ok (mpq(1,2)+mpq(-1,3) == mpq(1,6)); 1195ok (mpq(-1,2)+mpq(1,3) == mpq(-1,6)); 1196ok (mpq(-1,2)+mpq(-1,3) == mpq(-5,6)); 1197 1198#------------------------------------------------------------------------------ 1199# GMP::Mpq::overload_addeq 1200 1201{ my $a = mpq(7); $a += 1; ok ($a == 8); } 1202{ my $a = mpq(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } 1203 1204#------------------------------------------------------------------------------ 1205# GMP::Mpq::overload_bool 1206 1207if (mpq(0)) { ok (0); } else { ok (1); } 1208if (mpq(123)) { ok (1); } else { ok (0); } 1209 1210#------------------------------------------------------------------------------ 1211# GMP::Mpq::overload_dec 1212 1213{ my $a = mpq(0); ok ($a-- == 0); ok ($a == -1); } 1214{ my $a = mpq(0); ok (--$a == -1); } 1215 1216{ my $a = mpq(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } 1217 1218#------------------------------------------------------------------------------ 1219# GMP::Mpq::overload_div 1220 1221ok (mpq(6) / 2 == 3); 1222ok (mpq(-6) / 2 == -3); 1223ok (mpq(6) / -2 == -3); 1224ok (mpq(-6) / -2 == 3); 1225 1226#------------------------------------------------------------------------------ 1227# GMP::Mpq::overload_diveq 1228 1229{ my $a = mpq(21); $a /= 3; ok ($a == 7); } 1230{ my $a = mpq(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } 1231 1232#------------------------------------------------------------------------------ 1233# GMP::Mpq::overload_eq 1234 1235{ my $a = mpq(0); 1236 my $b = $a; 1237 $a = mpq(1); 1238 ok ($a == 1); 1239 ok ($b == 0); } 1240 1241#------------------------------------------------------------------------------ 1242# GMP::Mpq::overload_inc 1243 1244{ my $a = mpq(0); ok ($a++ == 0); ok ($a == 1); } 1245{ my $a = mpq(0); ok (++$a == 1); } 1246 1247{ my $a = mpq(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } 1248 1249#------------------------------------------------------------------------------ 1250# GMP::Mpq::overload_lshift 1251 1252{ my $a = mpq(7) << 1; ok ($a == 14); } 1253 1254#------------------------------------------------------------------------------ 1255# GMP::Mpq::overload_lshifteq 1256 1257{ my $a = mpq(7); $a <<= 1; ok ($a == 14); } 1258{ my $a = mpq(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } 1259 1260#------------------------------------------------------------------------------ 1261# GMP::Mpq::overload_mul 1262 1263ok (mpq(2) * 3 == 6); 1264 1265#------------------------------------------------------------------------------ 1266# GMP::Mpq::overload_muleq 1267 1268{ my $a = mpq(7); $a *= 3; ok ($a == 21); } 1269{ my $a = mpq(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } 1270 1271#------------------------------------------------------------------------------ 1272# GMP::Mpq::overload_neg 1273 1274ok (- mpq(0) == 0); 1275ok (- mpq(123) == -123); 1276ok (- mpq(-123) == 123); 1277 1278#------------------------------------------------------------------------------ 1279# GMP::Mpq::overload_not 1280 1281if (not mpq(0)) { ok (1); } else { ok (0); } 1282if (not mpq(123)) { ok (0); } else { ok (1); } 1283 1284ok ((! mpq(0)) == 1); 1285ok ((! mpq(123)) == 0); 1286 1287#------------------------------------------------------------------------------ 1288# GMP::Mpq::overload_pow 1289 1290ok (mpq(0) ** 1 == 0); 1291ok (mpq(1) ** 1 == 1); 1292ok (mpq(2) ** 0 == 1); 1293ok (mpq(2) ** 1 == 2); 1294ok (mpq(2) ** 2 == 4); 1295ok (mpq(2) ** 3 == 8); 1296ok (mpq(2) ** 4 == 16); 1297 1298ok (mpq(0) ** mpq(1) == 0); 1299ok (mpq(1) ** mpq(1) == 1); 1300ok (mpq(2) ** mpq(0) == 1); 1301ok (mpq(2) ** mpq(1) == 2); 1302ok (mpq(2) ** mpq(2) == 4); 1303ok (mpq(2) ** mpq(3) == 8); 1304ok (mpq(2) ** mpq(4) == 16); 1305 1306#------------------------------------------------------------------------------ 1307# GMP::Mpq::overload_poweq 1308 1309{ my $a = mpq(3); $a **= 4; ok ($a == 81); } 1310{ my $a = mpq(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } 1311 1312#------------------------------------------------------------------------------ 1313# GMP::Mpq::overload_rshift 1314 1315{ my $a = mpq(32) >> 1; ok ($a == 16); } 1316 1317#------------------------------------------------------------------------------ 1318# GMP::Mpq::overload_rshifteq 1319 1320{ my $a = mpq(32); $a >>= 1; ok ($a == 16); } 1321{ my $a = mpq(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } 1322 1323#------------------------------------------------------------------------------ 1324# GMP::Mpq::overload_spaceship 1325 1326ok (mpq(0) < 1); 1327ok (mpq(0) > -1); 1328 1329ok (mpq(0) != 1); 1330ok (mpq(0) != -1); 1331ok (mpq(1) != 0); 1332ok (mpq(1) != -1); 1333ok (mpq(-1) != 0); 1334ok (mpq(-1) != 1); 1335 1336ok (mpq(3,2) > 1); 1337ok (mpq(3,2) < 2); 1338 1339ok (mpq(0) < 1.0); 1340ok (mpq(0) < '1'); 1341ok (mpq(0) < substr('-1',1,1)); 1342ok (mpq(0) < mpz(1)); 1343ok (mpq(0) < mpq(1)); 1344ok (mpq(0) < mpf(1)); 1345ok (mpq(0) < $uv_max); 1346 1347#------------------------------------------------------------------------------ 1348# GMP::Mpq::overload_string 1349 1350{ my $x = mpq(0); ok("$x" eq "0"); } 1351{ my $x = mpq(123); ok("$x" eq "123"); } 1352{ my $x = mpq(-123); ok("$x" eq "-123"); } 1353 1354{ my $q = mpq(5,7); ok("$q" eq "5/7"); } 1355{ my $q = mpq(-5,7); ok("$q" eq "-5/7"); } 1356 1357#------------------------------------------------------------------------------ 1358# GMP::Mpq::overload_sub 1359 1360ok (mpq(0) - 1 == -1); 1361ok (mpq(1) - 1 == 0); 1362ok (1 - mpq(0) == 1); 1363ok (1 - mpq(1) == 0); 1364 1365ok (mpq(1,2)-mpq(1,3) == mpq(1,6)); 1366ok (mpq(1,2)-mpq(-1,3) == mpq(5,6)); 1367ok (mpq(-1,2)-mpq(1,3) == mpq(-5,6)); 1368ok (mpq(-1,2)-mpq(-1,3) == mpq(-1,6)); 1369 1370#------------------------------------------------------------------------------ 1371# GMP::Mpq::overload_subeq 1372 1373{ my $a = mpq(7); $a -= 1; ok ($a == 6); } 1374{ my $a = mpq(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } 1375 1376#------------------------------------------------------------------------------ 1377# GMP::Mpq::canonicalize 1378 1379{ my $q = mpq(21,15); canonicalize($q); 1380 ok (num($q) == 7); 1381 ok (den($q) == 5); 1382} 1383 1384#------------------------------------------------------------------------------ 1385# GMP::Mpq::den 1386 1387{ my $q = mpq(5,9); ok (den($q) == 9); } 1388 1389#------------------------------------------------------------------------------ 1390# GMP::Mpq::num 1391 1392{ my $q = mpq(5,9); ok (num($q) == 5); } 1393 1394 1395 1396 1397#------------------------------------------------------------------------------ 1398# GMP::Mpf 1399 1400#------------------------------------------------------------------------------ 1401# GMP::Mpf::new 1402 1403ok (mpf(0) == 0); 1404ok (mpf('0') == 0); 1405ok (mpf(substr('101',1,1)) == 0); 1406ok (mpf(0.0) == 0); 1407ok (mpf(mpz(0)) == 0); 1408ok (mpf(mpq(0)) == 0); 1409ok (mpf(mpf(0)) == 0); 1410 1411{ tie my $t, 'Mytie', 0; ok (mpf($t) == 0); } 1412{ tie my $t, 'Mytie', '0'; ok (mpf($t) == 0); } 1413{ tie my $t, 'Mytie', substr('101',1,1); ok (mpf($t) == 0); } 1414{ tie my $t, 'Mytie', 0.0; ok (mpf($t) == 0); } 1415{ tie my $t, 'Mytie', mpz(0); ok (mpf($t) == 0); } 1416{ tie my $t, 'Mytie', mpq(0); ok (mpf($t) == 0); } 1417{ tie my $t, 'Mytie', mpf(0); ok (mpf($t) == 0); } 1418 1419ok (mpf(-123) == -123); 1420ok (mpf('-123') == -123); 1421ok (mpf(substr('1-1231',1,4)) == -123); 1422ok (mpf(-123.0) == -123); 1423ok (mpf(mpz(-123)) == -123); 1424ok (mpf(mpq(-123)) == -123); 1425ok (mpf(mpf(-123)) == -123); 1426 1427{ tie my $t, 'Mytie', -123; ok (mpf($t) == -123); } 1428{ tie my $t, 'Mytie', '-123'; ok (mpf($t) == -123); } 1429{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpf($t) == -123); } 1430{ tie my $t, 'Mytie', -123.0; ok (mpf($t) == -123); } 1431{ tie my $t, 'Mytie', mpz(-123); ok (mpf($t) == -123); } 1432{ tie my $t, 'Mytie', mpq(-123); ok (mpf($t) == -123); } 1433{ tie my $t, 'Mytie', mpf(-123); ok (mpf($t) == -123); } 1434 1435ok (mpf($ivnv_2p128) == $str_2p128); 1436{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpf($t) == $str_2p128); } 1437 1438ok (mpf(-1.5) == -1.5); 1439ok (mpf(-1.0) == -1.0); 1440ok (mpf(-0.5) == -0.5); 1441ok (mpf(0) == 0); 1442ok (mpf(0.5) == 0.5); 1443ok (mpf(1.0) == 1.0); 1444ok (mpf(1.5) == 1.5); 1445 1446ok (mpf("-1.5") == -1.5); 1447ok (mpf("-1.0") == -1.0); 1448ok (mpf("-0.5") == -0.5); 1449ok (mpf("0") == 0); 1450ok (mpf("0.5") == 0.5); 1451ok (mpf("1.0") == 1.0); 1452ok (mpf("1.5") == 1.5); 1453 1454ok (mpf($uv_max) > 0); 1455ok (mpf($uv_max) == mpf($uv_max_str)); 1456{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) > 0); } 1457{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) == mpf($uv_max_str)); } 1458 1459{ my $x = 123.5; 1460 kill (0, $x); 1461 ok (mpf($x) == 123.5); 1462 tie my $t, 'Mytie', $x; 1463 ok (mpf($t) == 123.5); 1464} 1465 1466#------------------------------------------------------------------------------ 1467# GMP::Mpf::overload_abs 1468 1469ok (abs(mpf(0)) == 0); 1470ok (abs(mpf(123)) == 123); 1471ok (abs(mpf(-123)) == 123); 1472 1473{ my $x = mpf(-123); $x = abs($x); ok ($x == 123); } 1474{ my $x = mpf(0); $x = abs($x); ok ($x == 0); } 1475{ my $x = mpf(123); $x = abs($x); ok ($x == 123); } 1476 1477{ tie my $t, 'Mytie', mpf(0); ok (abs($t) == 0); } 1478{ tie my $t, 'Mytie', mpf(123); ok (abs($t) == 123); } 1479{ tie my $t, 'Mytie', mpf(-123); ok (abs($t) == 123); } 1480 1481#------------------------------------------------------------------------------ 1482# GMP::Mpf::overload_add 1483 1484ok (mpf(0) + 1 == 1); 1485ok (mpf(-1) + 1 == 0); 1486ok (1 + mpf(0) == 1); 1487ok (1 + mpf(-1) == 0); 1488 1489#------------------------------------------------------------------------------ 1490# GMP::Mpf::overload_addeq 1491 1492{ my $a = mpf(7); $a += 1; ok ($a == 8); } 1493{ my $a = mpf(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); } 1494 1495#------------------------------------------------------------------------------ 1496# GMP::Mpf::overload_bool 1497 1498if (mpf(0)) { ok (0); } else { ok (1); } 1499if (mpf(123)) { ok (1); } else { ok (0); } 1500 1501#------------------------------------------------------------------------------ 1502# GMP::Mpf::overload_dec 1503 1504{ my $a = mpf(0); ok ($a-- == 0); ok ($a == -1); } 1505{ my $a = mpf(0); ok (--$a == -1); } 1506 1507{ my $a = mpf(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); } 1508 1509#------------------------------------------------------------------------------ 1510# GMP::Mpf::overload_div 1511 1512ok (mpf(6) / 2 == 3); 1513ok (mpf(-6) / 2 == -3); 1514ok (mpf(6) / -2 == -3); 1515ok (mpf(-6) / -2 == 3); 1516 1517#------------------------------------------------------------------------------ 1518# GMP::Mpf::overload_diveq 1519 1520{ my $a = mpf(21); $a /= 3; ok ($a == 7); } 1521{ my $a = mpf(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); } 1522 1523#------------------------------------------------------------------------------ 1524# GMP::Mpf::overload_eq 1525 1526{ my $a = mpf(0); 1527 my $b = $a; 1528 $a = mpf(1); 1529 ok ($a == 1); 1530 ok ($b == 0); } 1531 1532#------------------------------------------------------------------------------ 1533# GMP::Mpf::overload_inc 1534 1535{ my $a = mpf(0); ok ($a++ == 0); ok ($a == 1); } 1536{ my $a = mpf(0); ok (++$a == 1); } 1537 1538{ my $a = mpf(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); } 1539 1540#------------------------------------------------------------------------------ 1541# GMP::Mpf::overload_lshift 1542 1543{ my $a = mpf(7) << 1; ok ($a == 14); } 1544 1545#------------------------------------------------------------------------------ 1546# GMP::Mpf::overload_lshifteq 1547 1548{ my $a = mpf(7); $a <<= 1; ok ($a == 14); } 1549{ my $a = mpf(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); } 1550 1551#------------------------------------------------------------------------------ 1552# GMP::Mpf::overload_mul 1553 1554ok (mpf(2) * 3 == 6); 1555 1556#------------------------------------------------------------------------------ 1557# GMP::Mpf::overload_muleq 1558 1559{ my $a = mpf(7); $a *= 3; ok ($a == 21); } 1560{ my $a = mpf(7); my $b = $a; $a *= 3; ok ($a == 21); ok ($b == 7); } 1561 1562#------------------------------------------------------------------------------ 1563# GMP::Mpf::overload_neg 1564 1565ok (- mpf(0) == 0); 1566ok (- mpf(123) == -123); 1567ok (- mpf(-123) == 123); 1568 1569#------------------------------------------------------------------------------ 1570# GMP::Mpf::overload_not 1571 1572if (not mpf(0)) { ok (1); } else { ok (0); } 1573if (not mpf(123)) { ok (0); } else { ok (1); } 1574 1575ok ((! mpf(0)) == 1); 1576ok ((! mpf(123)) == 0); 1577 1578#------------------------------------------------------------------------------ 1579# GMP::Mpf::overload_pow 1580 1581ok (mpf(0) ** 1 == 0); 1582ok (mpf(1) ** 1 == 1); 1583ok (mpf(2) ** 0 == 1); 1584ok (mpf(2) ** 1 == 2); 1585ok (mpf(2) ** 2 == 4); 1586ok (mpf(2) ** 3 == 8); 1587ok (mpf(2) ** 4 == 16); 1588 1589ok (mpf(0) ** mpf(1) == 0); 1590ok (mpf(1) ** mpf(1) == 1); 1591ok (mpf(2) ** mpf(0) == 1); 1592ok (mpf(2) ** mpf(1) == 2); 1593ok (mpf(2) ** mpf(2) == 4); 1594ok (mpf(2) ** mpf(3) == 8); 1595ok (mpf(2) ** mpf(4) == 16); 1596 1597#------------------------------------------------------------------------------ 1598# GMP::Mpf::overload_poweq 1599 1600{ my $a = mpf(3); $a **= 4; ok ($a == 81); } 1601{ my $a = mpf(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); } 1602 1603#------------------------------------------------------------------------------ 1604# GMP::Mpf::overload_rshift 1605 1606{ my $a = mpf(32) >> 1; ok ($a == 16); } 1607 1608#------------------------------------------------------------------------------ 1609# GMP::Mpf::overload_rshifteq 1610 1611{ my $a = mpf(32); $a >>= 1; ok ($a == 16); } 1612{ my $a = mpf(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); } 1613 1614#------------------------------------------------------------------------------ 1615# GMP::Mpf::overload_sqrt 1616 1617ok (sqrt(mpf(0)) == 0); 1618ok (sqrt(mpf(1)) == 1); 1619ok (sqrt(mpf(4)) == 2); 1620ok (sqrt(mpf(81)) == 9); 1621 1622ok (sqrt(mpf(0.25)) == 0.5); 1623 1624#------------------------------------------------------------------------------ 1625# GMP::Mpf::overload_spaceship 1626 1627ok (mpf(0) < 1); 1628ok (mpf(0) > -1); 1629 1630ok (mpf(0) != 1); 1631ok (mpf(0) != -1); 1632ok (mpf(1) != 0); 1633ok (mpf(1) != -1); 1634ok (mpf(-1) != 0); 1635ok (mpf(-1) != 1); 1636 1637ok (mpf(0) < 1.0); 1638ok (mpf(0) < '1'); 1639ok (mpf(0) < substr('-1',1,1)); 1640ok (mpf(0) < mpz(1)); 1641ok (mpf(0) < mpq(1)); 1642ok (mpf(0) < mpf(1)); 1643ok (mpf(0) < $uv_max); 1644 1645#------------------------------------------------------------------------------ 1646# GMP::Mpf::overload_string 1647 1648{ my $x = mpf(0); ok ("$x" eq "0"); } 1649{ my $x = mpf(123); ok ("$x" eq "123"); } 1650{ my $x = mpf(-123); ok ("$x" eq "-123"); } 1651 1652{ my $f = mpf(0.25); ok ("$f" eq "0.25"); } 1653{ my $f = mpf(-0.25); ok ("$f" eq "-0.25"); } 1654{ my $f = mpf(1.25); ok ("$f" eq "1.25"); } 1655{ my $f = mpf(-1.25); ok ("$f" eq "-1.25"); } 1656{ my $f = mpf(1000000); ok ("$f" eq "1000000"); } 1657{ my $f = mpf(-1000000); ok ("$f" eq "-1000000"); } 1658 1659#------------------------------------------------------------------------------ 1660# GMP::Mpf::overload_sub 1661 1662ok (mpf(0) - 1 == -1); 1663ok (mpf(1) - 1 == 0); 1664ok (1 - mpf(0) == 1); 1665ok (1 - mpf(1) == 0); 1666 1667#------------------------------------------------------------------------------ 1668# GMP::Mpf::overload_subeq 1669 1670{ my $a = mpf(7); $a -= 1; ok ($a == 6); } 1671{ my $a = mpf(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); } 1672 1673 1674#------------------------------------------------------------------------------ 1675# GMP::Mpf::ceil 1676 1677ok (ceil (mpf(-7.5)) == -7.0); 1678ok (ceil (mpf(7.5)) == 8.0); 1679 1680#------------------------------------------------------------------------------ 1681# GMP::Mpf::floor 1682 1683ok (floor(mpf(-7.5)) == -8.0); 1684ok (floor(mpf(7.5)) == 7.0); 1685 1686#------------------------------------------------------------------------------ 1687# GMP::Mpf::mpf_eq 1688 1689{ my $old_prec = get_default_prec(); 1690 set_default_prec(128); 1691 1692 ok ( mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1)); 1693 ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128)); 1694 1695 set_default_prec($old_prec); 1696} 1697 1698#------------------------------------------------------------------------------ 1699# GMP::Mpf::get_default_prec 1700 1701get_default_prec(); 1702 1703#------------------------------------------------------------------------------ 1704# GMP::Mpf::get_prec 1705 1706{ my $x = mpf(1.0, 512); 1707 ok (get_prec ($x) == 512); 1708} 1709 1710#------------------------------------------------------------------------------ 1711# GMP::Mpf::reldiff 1712 1713ok (reldiff (2,4) == 1); 1714ok (reldiff (4,2) == 0.5); 1715 1716#------------------------------------------------------------------------------ 1717# GMP::Mpf::set_default_prec 1718 1719{ my $old_prec = get_default_prec(); 1720 1721 set_default_prec(512); 1722 ok (get_default_prec () == 512); 1723 1724 set_default_prec($old_prec); 1725} 1726 1727#------------------------------------------------------------------------------ 1728# GMP::Mpf::set_prec 1729 1730{ my $x = mpf(1.0, 512); 1731 my $y = $x; 1732 set_prec ($x, 1024); 1733 ok (get_prec ($x) == 1024); 1734 ok (get_prec ($y) == 512); 1735} 1736 1737#------------------------------------------------------------------------------ 1738# GMP::Mpf::trunc 1739 1740ok (trunc(mpf(-7.5)) == -7.0); 1741ok (trunc(mpf(7.5)) == 7.0); 1742 1743 1744 1745#------------------------------------------------------------------------------ 1746# GMP::Rand 1747 1748#------------------------------------------------------------------------------ 1749# GMP::Rand::new 1750 1751{ my $r = randstate(); ok (defined $r); } 1752{ my $r = randstate('lc_2exp', 1, 2, 3); ok (defined $r); } 1753{ my $r = randstate('lc_2exp_size', 64); ok (defined $r); } 1754{ my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); } 1755{ my $r = randstate('mt'); ok (defined $r); } 1756 1757{ # copying a randstate results in same sequence 1758 my $r1 = randstate('lc_2exp_size', 64); 1759 $r1->seed(123); 1760 my $r2 = randstate($r1); 1761 for (1 .. 20) { 1762 my $z1 = mpz_urandomb($r1, 20); 1763 my $z2 = mpz_urandomb($r2, 20); 1764 ok ($z1 == $z2); 1765 } 1766} 1767 1768#------------------------------------------------------------------------------ 1769# GMP::Rand::seed 1770 1771{ my $r = randstate(); 1772 $r->seed(123); 1773 $r->seed(time()); 1774} 1775 1776#------------------------------------------------------------------------------ 1777# GMP::Rand::mpf_urandomb 1778 1779{ my $r = randstate(); 1780 my $f = mpf_urandomb($r,1024); 1781 ok (UNIVERSAL::isa($f,"GMP::Mpf")); } 1782 1783#------------------------------------------------------------------------------ 1784# GMP::Rand::mpz_urandomb 1785 1786{ my $r = randstate(); 1787 my $z = mpz_urandomb($r, 1024); 1788 ok (UNIVERSAL::isa($z,"GMP::Mpz")); } 1789 1790#------------------------------------------------------------------------------ 1791# GMP::Rand::mpz_rrandomb 1792 1793{ my $r = randstate(); 1794 my $z = mpz_rrandomb($r, 1024); 1795 ok (UNIVERSAL::isa($z,"GMP::Mpz")); } 1796 1797#------------------------------------------------------------------------------ 1798# GMP::Rand::mpz_urandomm 1799 1800{ my $r = randstate(); 1801 my $z = mpz_urandomm($r, mpz(3)**100); 1802 ok (UNIVERSAL::isa($z,"GMP::Mpz")); } 1803 1804#------------------------------------------------------------------------------ 1805# GMP::Rand::mpz_urandomb_ui 1806 1807{ my $r = randstate(); 1808 foreach (1 .. 20) { 1809 my $u = gmp_urandomb_ui($r,8); 1810 ok ($u >= 0); 1811 ok ($u < 256); 1812 } 1813} 1814 1815#------------------------------------------------------------------------------ 1816# GMP::Rand::mpz_urandomm_ui 1817 1818{ my $r = randstate(); 1819 foreach (1 .. 20) { 1820 my $u = gmp_urandomm_ui($r,8); 1821 ok ($u >= 0); 1822 ok ($u < 8); 1823 } 1824} 1825 1826 1827 1828 1829#------------------------------------------------------------------------------ 1830# GMP module 1831 1832#------------------------------------------------------------------------------ 1833# GMP::fits_slong_p 1834 1835ok (GMP::fits_slong_p(0)); 1836 1837# in perl 5.005 uv_max is only 32-bits on a 64-bit system, so won't exceed a 1838# long 1839# ok (! GMP::fits_slong_p($uv_max)); 1840 1841ok (GMP::fits_slong_p(0.0)); 1842 1843ok (GMP::fits_slong_p('0')); 1844 1845ok (GMP::fits_slong_p(substr('999999999999999999999999999999',1,1))); 1846 1847ok (! mpz("-9999999999999999999999999999999999999999999")->fits_slong_p()); 1848ok ( mpz(-123)->fits_slong_p()); 1849ok ( mpz(0)->fits_slong_p()); 1850ok ( mpz(123)->fits_slong_p()); 1851ok (! mpz("9999999999999999999999999999999999999999999")->fits_slong_p()); 1852 1853ok (! mpq("-9999999999999999999999999999999999999999999")->fits_slong_p()); 1854ok ( mpq(-123)->fits_slong_p()); 1855ok ( mpq(0)->fits_slong_p()); 1856ok ( mpq(123)->fits_slong_p()); 1857ok (! mpq("9999999999999999999999999999999999999999999")->fits_slong_p()); 1858 1859ok (! mpf("-9999999999999999999999999999999999999999999")->fits_slong_p()); 1860ok ( mpf(-123)->fits_slong_p()); 1861ok ( mpf(0)->fits_slong_p()); 1862ok ( mpf(123)->fits_slong_p()); 1863ok (! mpf("9999999999999999999999999999999999999999999")->fits_slong_p()); 1864 1865#------------------------------------------------------------------------------ 1866# GMP::get_d 1867 1868ok (GMP::get_d(123) == 123.0); 1869 1870ok (GMP::get_d($uv_max) > 0); 1871 1872ok (GMP::get_d(123.0) == 123.0); 1873 1874ok (GMP::get_d('123') == 123.0); 1875 1876ok (GMP::get_d(mpz(123)) == 123.0); 1877 1878ok (GMP::get_d(mpq(123)) == 123.0); 1879 1880ok (GMP::get_d(mpf(123)) == 123.0); 1881 1882#------------------------------------------------------------------------------ 1883# GMP::get_d_2exp 1884 1885{ my ($dbl, $exp) = get_d_2exp (0); 1886 ok ($dbl == 0); ok ($exp == 0); } 1887{ my ($dbl, $exp) = get_d_2exp (1); 1888 ok ($dbl == 0.5); ok ($exp == 1); } 1889 1890{ my ($dbl, $exp) = get_d_2exp ($uv_max); 1891 ok ($dbl > 0.0); ok ($exp > 0); } 1892 1893{ my ($dbl, $exp) = get_d_2exp (0.5); 1894 ok ($dbl == 0.5); ok ($exp == 0); } 1895{ my ($dbl, $exp) = get_d_2exp (0.25); 1896 ok ($dbl == 0.5); ok ($exp == -1); } 1897 1898{ my ($dbl, $exp) = get_d_2exp ("1.0"); 1899 ok ($dbl == 0.5); ok ($exp == 1); } 1900 1901{ my ($dbl, $exp) = get_d_2exp (mpz ("256")); 1902 ok ($dbl == 0.5); ok ($exp == 9); } 1903 1904{ my ($dbl, $exp) = get_d_2exp (mpq ("1/16")); 1905 ok ($dbl == 0.5); ok ($exp == -3); } 1906 1907{ my ($dbl, $exp) = get_d_2exp (mpf ("1.5")); 1908 ok ($dbl == 0.75); ok ($exp == 1); } 1909{ my ($dbl, $exp) = get_d_2exp (mpf ("3.0")); 1910 ok ($dbl == 0.75); ok ($exp == 2); } 1911 1912#------------------------------------------------------------------------------ 1913# GMP::get_str 1914 1915ok (get_str(-123) eq '-123'); 1916ok (get_str('-123') eq '-123'); 1917ok (get_str(substr('x-123x',1,4)) eq '-123'); 1918ok (get_str(mpz(-123)) eq '-123'); 1919ok (get_str(mpq(-123)) eq '-123'); 1920 1921ok (get_str(-123,10) eq '-123'); 1922ok (get_str('-123',10) eq '-123'); 1923ok (get_str(substr('x-123x',1,4),10) eq '-123'); 1924ok (get_str(mpz(-123),10) eq '-123'); 1925ok (get_str(mpq(-123),10) eq '-123'); 1926 1927ok (get_str(-123,16) eq '-7b'); 1928ok (get_str('-123',16) eq '-7b'); 1929ok (get_str(substr('x-123x',1,4),16) eq '-7b'); 1930ok (get_str(mpz(-123),16) eq '-7b'); 1931ok (get_str(mpq(-123),16) eq '-7b'); 1932 1933ok (get_str(-123,-16) eq '-7B'); 1934ok (get_str('-123',-16) eq '-7B'); 1935ok (get_str(substr('x-123x',1,4),-16) eq '-7B'); 1936ok (get_str(mpz(-123),-16) eq '-7B'); 1937ok (get_str(mpq(-123),-16) eq '-7B'); 1938 1939# is a float in past versions of perl without UV type 1940{ my ($str, $exp) = get_str($uv_max); 1941 ok ($str eq $uv_max_str); } 1942 1943ok (get_str(mpq(5/8)) eq "5/8"); 1944ok (get_str(mpq(-5/8)) eq "-5/8"); 1945ok (get_str(mpq(255/256),16) eq "ff/100"); 1946ok (get_str(mpq(255/256),-16) eq "FF/100"); 1947ok (get_str(mpq(-255/256),16) eq "-ff/100"); 1948ok (get_str(mpq(-255/256),-16) eq "-FF/100"); 1949 1950{ my ($s,$e) = get_str(1.5, 10); ok ($s eq '15'); ok ($e == 1); } 1951{ my ($s,$e) = get_str(mpf(1.5), 10); ok ($s eq '15'); ok ($e == 1); } 1952 1953{ my ($s,$e) = get_str(-1.5, 10); ok ($s eq '-15'); ok ($e == 1); } 1954{ my ($s,$e) = get_str(mpf(-1.5), 10); ok ($s eq '-15'); ok ($e == 1); } 1955 1956{ my ($s,$e) = get_str(1.5, 16); ok ($s eq '18'); ok ($e == 1); } 1957{ my ($s,$e) = get_str(mpf(1.5), 16); ok ($s eq '18'); ok ($e == 1); } 1958 1959{ my ($s,$e) = get_str(-1.5, 16); ok ($s eq '-18'); ok ($e == 1); } 1960{ my ($s,$e) = get_str(mpf(-1.5), 16); ok ($s eq '-18'); ok ($e == 1); } 1961 1962{ my ($s,$e) = get_str(65536.0, 16); ok ($s eq '1'); ok ($e == 5); } 1963{ my ($s,$e) = get_str(mpf(65536.0), 16); ok ($s eq '1'); ok ($e == 5); } 1964 1965{ my ($s,$e) = get_str(1.625, 16); ok ($s eq '1a'); ok ($e == 1); } 1966{ my ($s,$e) = get_str(mpf(1.625), 16); ok ($s eq '1a'); ok ($e == 1); } 1967 1968{ my ($s,$e) = get_str(1.625, -16); ok ($s eq '1A'); ok ($e == 1); } 1969{ my ($s,$e) = get_str(mpf(1.625), -16); ok ($s eq '1A'); ok ($e == 1); } 1970 1971{ my ($s, $e) = get_str(255.0,16,0); ok ($s eq "ff"); ok ($e == 2); } 1972{ my ($s, $e) = get_str(mpf(255.0),16,0); ok ($s eq "ff"); ok ($e == 2); } 1973 1974{ my ($s, $e) = get_str(255.0,-16,0); ok ($s eq "FF"); ok ($e == 2); } 1975{ my ($s, $e) = get_str(mpf(255.0),-16,0); ok ($s eq "FF"); ok ($e == 2); } 1976 1977#------------------------------------------------------------------------------ 1978# GMP::get_si 1979 1980ok (GMP::get_si(123) == 123.0); 1981 1982# better not assume anything about the relatives sizes of long and UV 1983ok (GMP::get_si($uv_max) != 0); 1984 1985ok (GMP::get_si(123.0) == 123.0); 1986 1987ok (GMP::get_si('123') == 123.0); 1988 1989ok (GMP::get_si(mpz(123)) == 123.0); 1990 1991ok (GMP::get_si(mpq(123)) == 123.0); 1992 1993ok (GMP::get_si(mpf(123)) == 123.0); 1994 1995#------------------------------------------------------------------------------ 1996# GMP::integer_p 1997 1998ok ( GMP::integer_p (0)); 1999ok ( GMP::integer_p (123)); 2000ok ( GMP::integer_p (-123)); 2001 2002ok ( GMP::integer_p ($uv_max)); 2003 2004ok ( GMP::integer_p (0.0)); 2005ok ( GMP::integer_p (123.0)); 2006ok ( GMP::integer_p (-123.0)); 2007ok (! GMP::integer_p (0.5)); 2008ok (! GMP::integer_p (123.5)); 2009ok (! GMP::integer_p (-123.5)); 2010 2011ok ( GMP::integer_p ('0')); 2012ok ( GMP::integer_p ('123')); 2013ok ( GMP::integer_p ('-123')); 2014ok (! GMP::integer_p ('0.5')); 2015ok (! GMP::integer_p ('123.5')); 2016ok (! GMP::integer_p ('-123.5')); 2017ok (! GMP::integer_p ('5/8')); 2018 2019ok ( GMP::integer_p (mpz(1))); 2020 2021ok ( GMP::integer_p (mpq(1))); 2022ok (! GMP::integer_p (mpq(1,2))); 2023 2024ok ( GMP::integer_p (mpf(1.0))); 2025ok (! GMP::integer_p (mpf(1.5))); 2026 2027#------------------------------------------------------------------------------ 2028# GMP::odd_p 2029 2030ok (! odd_p(0)); 2031ok ( odd_p(1)); 2032ok (! odd_p(2)); 2033 2034ok ( odd_p($uv_max)); 2035 2036ok ( odd_p(mpz(-3))); 2037ok (! odd_p(mpz(-2))); 2038ok ( odd_p(mpz(-1))); 2039ok (! odd_p(mpz(0))); 2040ok ( odd_p(mpz(1))); 2041ok (! odd_p(mpz(2))); 2042ok ( odd_p(mpz(3))); 2043 2044#------------------------------------------------------------------------------ 2045# GMP::printf 2046 2047GMP::printf ("hello world\n"); 2048 2049sub via_printf { 2050 my $s; 2051 open TEMP, ">test.tmp" or die; 2052 GMP::printf TEMP @_; 2053 close TEMP or die; 2054 open TEMP, "<test.tmp" or die; 2055 read (TEMP, $s, 1024); 2056 close TEMP or die; 2057 unlink 'test.tmp'; 2058 return $s; 2059} 2060 2061ok (sprintf ("%d", mpz(123)) eq '123'); 2062ok (sprintf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789'); 2063ok (sprintf ("%d", mpq(15,16)) eq '15/16'); 2064ok (sprintf ("%f", mpf(1.5)) eq '1.500000'); 2065ok (sprintf ("%.2f", mpf(1.5)) eq '1.50'); 2066 2067ok (sprintf ("%*d", 6, 123) eq ' 123'); 2068ok (sprintf ("%*d", 6, mpz(123)) eq ' 123'); 2069ok (sprintf ("%*d", 6, mpq(15,16)) eq ' 15/16'); 2070 2071ok (sprintf ("%x", 123) eq '7b'); 2072ok (sprintf ("%x", mpz(123)) eq '7b'); 2073ok (sprintf ("%X", 123) eq '7B'); 2074ok (sprintf ("%X", mpz(123)) eq '7B'); 2075ok (sprintf ("%#x", 123) eq '0x7b'); 2076ok (sprintf ("%#x", mpz(123)) eq '0x7b'); 2077ok (sprintf ("%#X", 123) eq '0X7B'); 2078ok (sprintf ("%#X", mpz(123)) eq '0X7B'); 2079 2080ok (sprintf ("%x", mpq(15,16)) eq 'f/10'); 2081ok (sprintf ("%X", mpq(15,16)) eq 'F/10'); 2082ok (sprintf ("%#x", mpq(15,16)) eq '0xf/0x10'); 2083ok (sprintf ("%#X", mpq(15,16)) eq '0XF/0X10'); 2084 2085ok (sprintf ("%*.*f", 10, 3, 1.25) eq ' 1.250'); 2086ok (sprintf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500'); 2087 2088ok (via_printf ("%d", mpz(123)) eq '123'); 2089ok (via_printf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789'); 2090ok (via_printf ("%d", mpq(15,16)) eq '15/16'); 2091ok (via_printf ("%f", mpf(1.5)) eq '1.500000'); 2092ok (via_printf ("%.2f", mpf(1.5)) eq '1.50'); 2093 2094ok (via_printf ("%*d", 6, 123) eq ' 123'); 2095ok (via_printf ("%*d", 6, mpz(123)) eq ' 123'); 2096ok (via_printf ("%*d", 6, mpq(15,16)) eq ' 15/16'); 2097 2098ok (via_printf ("%x", 123) eq '7b'); 2099ok (via_printf ("%x", mpz(123)) eq '7b'); 2100ok (via_printf ("%X", 123) eq '7B'); 2101ok (via_printf ("%X", mpz(123)) eq '7B'); 2102ok (via_printf ("%#x", 123) eq '0x7b'); 2103ok (via_printf ("%#x", mpz(123)) eq '0x7b'); 2104ok (via_printf ("%#X", 123) eq '0X7B'); 2105ok (via_printf ("%#X", mpz(123)) eq '0X7B'); 2106 2107ok (via_printf ("%x", mpq(15,16)) eq 'f/10'); 2108ok (via_printf ("%X", mpq(15,16)) eq 'F/10'); 2109ok (via_printf ("%#x", mpq(15,16)) eq '0xf/0x10'); 2110ok (via_printf ("%#X", mpq(15,16)) eq '0XF/0X10'); 2111 2112ok (via_printf ("%*.*f", 10, 3, 1.25) eq ' 1.250'); 2113ok (via_printf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500'); 2114 2115#------------------------------------------------------------------------------ 2116# GMP::sgn 2117 2118ok (sgn(-123) == -1); 2119ok (sgn(0) == 0); 2120ok (sgn(123) == 1); 2121 2122ok (sgn($uv_max) == 1); 2123 2124ok (sgn(-123.0) == -1); 2125ok (sgn(0.0) == 0); 2126ok (sgn(123.0) == 1); 2127 2128ok (sgn('-123') == -1); 2129ok (sgn('0') == 0); 2130ok (sgn('123') == 1); 2131ok (sgn('-123.0') == -1); 2132ok (sgn('0.0') == 0); 2133ok (sgn('123.0') == 1); 2134 2135ok (sgn(substr('x-123x',1,4)) == -1); 2136ok (sgn(substr('x0x',1,1)) == 0); 2137ok (sgn(substr('x123x',1,3)) == 1); 2138 2139ok (mpz(-123)->sgn() == -1); 2140ok (mpz(0) ->sgn() == 0); 2141ok (mpz(123) ->sgn() == 1); 2142 2143ok (mpq(-123)->sgn() == -1); 2144ok (mpq(0) ->sgn() == 0); 2145ok (mpq(123) ->sgn() == 1); 2146 2147ok (mpf(-123)->sgn() == -1); 2148ok (mpf(0) ->sgn() == 0); 2149ok (mpf(123) ->sgn() == 1); 2150 2151 2152 2153#------------------------------------------------------------------------------ 2154# overloaded constants 2155 2156if ($] > 5.00503) { 2157 if (! do 'test2.pl') { 2158 die "Cannot run test2.pl\n"; 2159 } 2160} 2161 2162 2163 2164 2165#------------------------------------------------------------------------------ 2166# $# stuff 2167# 2168# For some reason "local $#" doesn't leave $# back at its default undefined 2169# state when exiting the block. 2170 2171{ local $# = 'hi %.0f there'; 2172 my $f = mpf(123); 2173 ok ("$f" eq 'hi 123 there'); } 2174 2175 2176 2177# Local variables: 2178# perl-indent-level: 2 2179# End: 2180