Annotation of OpenXM_contrib/gmp/demos/perl/test.pl, Revision 1.1
1.1 ! ohara 1: # GMP perl module tests
! 2:
! 3: # Copyright 2001 Free Software Foundation, Inc.
! 4: #
! 5: # This file is part of the GNU MP Library.
! 6: #
! 7: # The GNU MP Library is free software; you can redistribute it and/or modify
! 8: # it under the terms of the GNU Lesser General Public License as published
! 9: # by the Free Software Foundation; either version 2.1 of the License, or (at
! 10: # your option) any later version.
! 11: #
! 12: # The GNU MP Library is distributed in the hope that it will be useful, but
! 13: # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! 14: # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
! 15: # License for more details.
! 16: #
! 17: # You should have received a copy of the GNU Lesser General Public License
! 18: # along with the GNU MP Library; see the file COPYING.LIB. If not, write to
! 19: # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
! 20: # MA 02111-1307, USA.
! 21:
! 22:
! 23: # These tests aim to exercise the many possible combinations of operands
! 24: # etc, and to run all functions at least once, which if nothing else will
! 25: # check everything intended is in the :all list.
! 26: #
! 27: # Use the following in .emacs to match test failure messages.
! 28: #
! 29: # ;; perl "Test" module error messages
! 30: # (eval-after-load "compile"
! 31: # '(add-to-list
! 32: # 'compilation-error-regexp-alist
! 33: # '("^.*Failed test [0-9]+ in \\([^ ]+\\) at line \\([0-9]+\\)" 1 2)))
! 34:
! 35:
! 36: use strict;
! 37: use Test;
! 38:
! 39: BEGIN {
! 40: plan tests => 123,
! 41: onfail => sub { print "there were failures\n" },
! 42: }
! 43:
! 44: use GMP qw(:all);
! 45: use GMP::Mpz qw(:all);
! 46: use GMP::Mpq qw(:all);
! 47: use GMP::Mpf qw(:all);
! 48: use GMP::Rand qw(:all);
! 49:
! 50: use GMP::Mpz qw(:constants);
! 51: use GMP::Mpz qw(:noconstants);
! 52: use GMP::Mpq qw(:constants);
! 53: use GMP::Mpq qw(:noconstants);
! 54: use GMP::Mpf qw(:constants);
! 55: use GMP::Mpf qw(:noconstants);
! 56:
! 57: use GMP qw(version);
! 58: print '$GMP::VERSION ',$GMP::VERSION,' GMP::version() ',version(),"\n";
! 59:
! 60: # force to a string, not a PVIV
! 61: sub str {
! 62: my $s = "@_[0]" . "";
! 63: return $s;
! 64: }
! 65:
! 66: foreach my $name ('mpz', 'mpq', 'mpf') {
! 67: print "$name\n";
! 68: my $mpx = eval("\\&$name");
! 69:
! 70: ok (&$mpx() == 0);
! 71:
! 72: foreach my $x (0, 1, -1, 123, -123) {
! 73: foreach my $y ($x, ""."$x", substr("$x",0), 0.0+$x,
! 74: mpz($x), mpq($x), mpf($x)) {
! 75: ok (&$mpx($x) == $x);
! 76: }
! 77: }
! 78:
! 79: ok (&$mpx(substr("11",0,1)) == 1);
! 80:
! 81: ok (&$mpx(0) < 1);
! 82: ok (&$mpx(0) > -1);
! 83:
! 84: ok (&$mpx(0) != 1);
! 85: ok (&$mpx(0) != -1);
! 86: ok (&$mpx(1) != 0);
! 87: ok (&$mpx(1) != -1);
! 88: ok (&$mpx(-1) != 0);
! 89: ok (&$mpx(-1) != 1);
! 90:
! 91: ok (&$mpx(0) + 1 == 1);
! 92: ok (&$mpx(-1) + 1 == 0);
! 93: ok (1 + &$mpx(0) == 1);
! 94: ok (1 + &$mpx(-1) == 0);
! 95:
! 96: ok (&$mpx(0) - 1 == -1);
! 97: ok (&$mpx(1) - 1 == 0);
! 98: ok (1 - &$mpx(0) == 1);
! 99: ok (1 - &$mpx(1) == 0);
! 100:
! 101: ok (&$mpx(2) * 3 == 6);
! 102:
! 103: ok (&$mpx(6) / 2 == 3);
! 104: ok (&$mpx(-6) / 2 == -3);
! 105: ok (&$mpx(6) / -2 == -3);
! 106: ok (&$mpx(-6) / -2 == 3);
! 107:
! 108: ok (abs(&$mpx(0)) == 0);
! 109: ok (abs(&$mpx(1)) == 1);
! 110: ok (abs(&$mpx(-1)) == 1);
! 111: { my $x = &$mpx(-123); $x = abs($x); ok ($x == 123); }
! 112: { my $x = &$mpx(-1); $x = abs($x); ok ($x == 1); }
! 113: { my $x = &$mpx(0); $x = abs($x); ok ($x == 0); }
! 114: { my $x = &$mpx(1); $x = abs($x); ok ($x == 1); }
! 115: { my $x = &$mpx(123); $x = abs($x); ok ($x == 123); }
! 116:
! 117:
! 118: foreach my $x (-123, -1, 0, 1, 123) {
! 119: foreach my $xv ($x, "$x", substr("$x",0), $x+0.0,
! 120: mpz($x), mpq($x), mpf($x)) {
! 121: my $xm = &$mpx($xv);
! 122: if ($xm) {
! 123: ok ($x);
! 124: } else {
! 125: ok (not $x);
! 126: }
! 127: if (not $xm) {
! 128: ok (not $x);
! 129: } else {
! 130: ok ($x);
! 131: }
! 132: if (! $xm) {
! 133: ok (not $x);
! 134: } else {
! 135: ok ($x);
! 136: }
! 137: }
! 138: }
! 139:
! 140: ok (- &$mpx(0) == 0);
! 141: ok (- &$mpx(1) == -1);
! 142: ok (- &$mpx(-1) == 1);
! 143:
! 144: {
! 145: my $a = &$mpx(0); my $b = $a;
! 146: $a = &$mpx(1);
! 147: ok ($a == 1);
! 148: ok ($b == 0);
! 149: }
! 150: {
! 151: my $a = &$mpx(0); my $b = $a;
! 152: $a++;
! 153: ok ($a == 1);
! 154: ok ($b == 0);
! 155: }
! 156: {
! 157: my $a = &$mpx(0); my $b = $a;
! 158: $a--;
! 159: ok ($a == -1);
! 160: ok ($b == 0);
! 161: }
! 162: {
! 163: my $a = &$mpx(0); my $b = $a;
! 164: $a++;
! 165: ok ($a == 1);
! 166: ok ($b == 0);
! 167: }
! 168:
! 169: { my $a = &$mpx(0); ok ($a++ == 0); }
! 170: { my $a = &$mpx(0); ok ($a-- == 0); }
! 171: { my $a = &$mpx(0); ok (++$a == 1); }
! 172: { my $a = &$mpx(0); ok (--$a == -1); }
! 173:
! 174: { my $x = &$mpx(0); ok("$x" eq "0"); }
! 175: { my $x = &$mpx(123); ok("$x" eq "123"); }
! 176: { my $x = &$mpx(-123); ok("$x" eq "-123"); }
! 177:
! 178: ok (&$mpx(0) ** 1 == 0);
! 179: ok (&$mpx(1) ** 1 == 1);
! 180: ok (&$mpx(2) ** 0 == 1);
! 181: ok (&$mpx(2) ** 1 == 2);
! 182: ok (&$mpx(2) ** 2 == 4);
! 183: ok (&$mpx(2) ** 3 == 8);
! 184: ok (&$mpx(2) ** 4 == 16);
! 185:
! 186: ok (&$mpx(0) ** &$mpx(1) == 0);
! 187: ok (&$mpx(1) ** &$mpx(1) == 1);
! 188: ok (&$mpx(2) ** &$mpx(0) == 1);
! 189: ok (&$mpx(2) ** &$mpx(1) == 2);
! 190: ok (&$mpx(2) ** &$mpx(2) == 4);
! 191: ok (&$mpx(2) ** &$mpx(3) == 8);
! 192: ok (&$mpx(2) ** &$mpx(4) == 16);
! 193:
! 194: { my $a = &$mpx(7); $a += 1; ok ($a == 8); }
! 195: { my $a = &$mpx(7); $a -= 1; ok ($a == 6); }
! 196: { my $a = &$mpx(7); $a *= 3; ok ($a == 21); }
! 197: { my $a = &$mpx(21); $a /= 3; ok ($a == 7); }
! 198: { my $a = &$mpx(7); $a <<= 1; ok ($a == 14); }
! 199: { my $a = &$mpx(32); $a >>= 1; ok ($a == 16); }
! 200: { my $a = &$mpx(3); $a **= 4; ok ($a == 81); }
! 201:
! 202: ok (! &$mpx("-9999999999999999999999999999999999999999999")->fits_slong_p());
! 203: ok ( &$mpx(-123)->fits_slong_p());
! 204: ok ( &$mpx(0)->fits_slong_p());
! 205: ok ( &$mpx(123)->fits_slong_p());
! 206: ok (! &$mpx("9999999999999999999999999999999999999999999")->fits_slong_p());
! 207:
! 208: ok (&$mpx(-123)->sgn() == -1);
! 209: ok (&$mpx(-1) ->sgn() == -1);
! 210: ok (&$mpx(0) ->sgn() == 0);
! 211: ok (&$mpx(1) ->sgn() == 1);
! 212: ok (&$mpx(123) ->sgn() == 1);
! 213: }
! 214:
! 215: foreach my $x (-123, -1, 0, 1, 123) {
! 216: foreach my $xv ($x, "$x", substr("$x",0), $x+0.0,
! 217: mpz($x), mpq($x), mpf($x)) {
! 218:
! 219: ok (GMP::get_d($xv) == $x);
! 220: ok (GMP::get_si($xv) == $x);
! 221: ok (GMP::integer_p($xv) == 1);
! 222: ok (GMP::sgn($xv) == ($x <=> 0));
! 223:
! 224: foreach my $y (-123, -1, 0, 1, 123) {
! 225: foreach my $yv ($y, "$y", 0.0+$y, mpz($y), mpq($y), mpf($y)) {
! 226:
! 227: ok (($xv <=> $yv) == ($x <=> $y));
! 228: }
! 229: }
! 230: }
! 231: }
! 232:
! 233: foreach my $xpair ([-123,"-7b"], [-1,"-1"], [0,"0"], [1,"1"], [123,"7b"]) {
! 234: my $x = $$xpair[0];
! 235: my $xhex = $$xpair[1];
! 236:
! 237: foreach my $xv ($x, "$x", substr("$x",0),
! 238: mpz($x), mpq($x)) {
! 239:
! 240: ok (get_str($xv) eq "$x");
! 241: ok (get_str($xv,10) eq "$x");
! 242:
! 243: ok (get_str($xv,16) == $xhex);
! 244: $xhex =~ tr [a-z] [A-Z];
! 245: ok (get_str($xv,-16) == $xhex);
! 246: }
! 247: }
! 248:
! 249: ok (GMP::get_str(mpq(5/8)) eq "5/8");
! 250: ok (GMP::get_str(mpq(-5/8)) eq "-5/8");
! 251: ok (GMP::get_str(mpq(255/256),16) eq "ff/100");
! 252: ok (GMP::get_str(mpq(255/256),-16) eq "FF/100");
! 253: ok (GMP::get_str(mpq(-255/256),16) eq "-ff/100");
! 254: ok (GMP::get_str(mpq(-255/256),-16) eq "-FF/100");
! 255:
! 256: foreach my $x (1.5, mpf(1.5)) {
! 257: { my ($s,$e) = get_str($x, 10);
! 258: ok ($s eq '15');
! 259: ok ($e == 1); }
! 260: }
! 261: foreach my $x (-1.5, mpf(-1.5)) {
! 262: { my ($s,$e) = get_str($x, 10);
! 263: ok ($s eq '-15');
! 264: ok ($e == 1); }
! 265: }
! 266: foreach my $x (1.5, mpf(1.5)) {
! 267: { my ($s,$e) = get_str($x, 16);
! 268: ok ($s eq '18');
! 269: ok ($e == 1); }
! 270: }
! 271: foreach my $x (-1.5, mpf(-1.5)) {
! 272: { my ($s,$e) = get_str($x, 16);
! 273: ok ($s eq '-18');
! 274: ok ($e == 1); }
! 275: }
! 276: foreach my $x (65536.0, mpf(65536.0)) {
! 277: { my ($s,$e) = get_str($x, 16);
! 278: ok ($s eq '1');
! 279: ok ($e == 5); }
! 280: }
! 281: foreach my $x (1.625, mpf(1.625)) {
! 282: { my ($s,$e) = get_str($x, 16);
! 283: ok ($s eq '1a');
! 284: ok ($e == 1); }
! 285: }
! 286: foreach my $x (1.625, mpf(1.625)) {
! 287: { my ($s,$e) = get_str($x, -16);
! 288: ok ($s eq '1A');
! 289: ok ($e == 1); }
! 290: }
! 291: foreach my $f (255.0, mpf(255)) {
! 292: my ($s, $e) = get_str(255.0,16,0);
! 293: ok ($s eq "ff");
! 294: ok ($e == 2);
! 295: }
! 296: foreach my $f (255.0, mpf(255)) {
! 297: my ($s, $e) = get_str(255.0,-16,0);
! 298: ok ($s eq "FF");
! 299: ok ($e == 2);
! 300: }
! 301: foreach my $f (-255.0, mpf(-255)) {
! 302: my ($s, $e) = get_str(-255.0,16,0);
! 303: ok ($s eq "-ff");
! 304: ok ($e == 2);
! 305: }
! 306: foreach my $f (-255.0, mpf(-255)) {
! 307: my ($s, $e) = get_str(-255.0,-16,0);
! 308: ok ($s eq "-FF");
! 309: ok ($e == 2);
! 310: }
! 311:
! 312:
! 313: ok ( GMP::integer_p (mpq(1)));
! 314: ok (! GMP::integer_p (mpq(1,2)));
! 315: ok ( GMP::integer_p (mpf(1.0)));
! 316: ok (! GMP::integer_p (mpf(1.5)));
! 317:
! 318:
! 319: ok (mpz(-8) % 3 == -2);
! 320: ok (mpz(-7) % 3 == -1);
! 321: ok (mpz(-6) % 3 == 0);
! 322: ok (mpz(6) % 3 == 0);
! 323: ok (mpz(7) % 3 == 1);
! 324: ok (mpz(8) % 3 == 2);
! 325:
! 326: { my $a = mpz(24); $a %= 7; ok ($a == 3); }
! 327:
! 328: ok ((mpz(3) & 1) == 1);
! 329: ok ((mpz(3) & 4) == 0);
! 330: ok ((mpz(3) | 1) == 3);
! 331: ok ((mpz(3) | 4) == 7);
! 332: ok ((mpz(3) ^ 1) == 2);
! 333: ok ((mpz(3) ^ 4) == 7);
! 334: ok ((mpz("0xAA") | mpz("0x55")) == mpz("0xFF"));
! 335:
! 336: { my $a = mpz(3); $a &= 1; ok ($a == 1); }
! 337: { my $a = mpz(3); $a &= 4; ok ($a == 0); }
! 338: { my $a = mpz(3); $a |= 1; ok ($a == 3); }
! 339: { my $a = mpz(3); $a |= 4; ok ($a == 7); }
! 340: { my $a = mpz(3); $a ^= 1; ok ($a == 2); }
! 341: { my $a = mpz(3); $a ^= 4; ok ($a == 7); }
! 342:
! 343: ok (~ mpz(0) == -1);
! 344: ok (~ mpz(1) == -2);
! 345: ok (~ mpz(-2) == 1);
! 346: ok (~ mpz(0xFF) == -0x100);
! 347: ok (~ mpz(-0x100) == 0xFF);
! 348:
! 349:
! 350: # mpz functions
! 351:
! 352: ok (bin(2,0) == 1);
! 353: ok (bin(2,1) == 2);
! 354: ok (bin(2,2) == 1);
! 355:
! 356: ok (bin(3,0) == 1);
! 357: ok (bin(3,1) == 3);
! 358: ok (bin(3,2) == 3);
! 359: ok (bin(3,3) == 1);
! 360:
! 361: { my ($q, $r);
! 362: ($q, $r) = cdiv (16, 3);
! 363: ok ($q == 6);
! 364: ok ($r == -2);
! 365: ($q, $r) = cdiv (16, -3);
! 366: ok ($q == -5);
! 367: ok ($r == 1);
! 368: ($q, $r) = cdiv (-16, 3);
! 369: ok ($q == -5);
! 370: ok ($r == -1);
! 371: ($q, $r) = cdiv (-16, -3);
! 372: ok ($q == 6);
! 373: ok ($r == 2);
! 374: }
! 375: { my ($q, $r);
! 376: ($q, $r) = fdiv (16, 3);
! 377: ok ($q == 5);
! 378: ok ($r == 1);
! 379: ($q, $r) = fdiv (16, -3);
! 380: ok ($q == -6);
! 381: ok ($r == -2);
! 382: ($q, $r) = fdiv (-16, 3);
! 383: ok ($q == -6);
! 384: ok ($r == 2);
! 385: ($q, $r) = fdiv (-16, -3);
! 386: ok ($q == 5);
! 387: ok ($r == -1);
! 388: }
! 389:
! 390: { my ($q, $r);
! 391: ($q, $r) = tdiv (16, 3);
! 392: ok ($q == 5);
! 393: ok ($r == 1);
! 394: ($q, $r) = tdiv (16, -3);
! 395: ok ($q == -5);
! 396: ok ($r == 1);
! 397: ($q, $r) = tdiv (-16, 3);
! 398: ok ($q == -5);
! 399: ok ($r == -1);
! 400: ($q, $r) = tdiv (-16, -3);
! 401: ok ($q == 5);
! 402: ok ($r == -1);
! 403: }
! 404:
! 405: { my ($q, $r);
! 406: ($q, $r) = cdiv_2exp (23, 2);
! 407: ok ($q == 6);
! 408: ok ($r == -1);
! 409: ($q, $r) = cdiv_2exp (-23, 2);
! 410: ok ($q == -5);
! 411: ok ($r == -3);
! 412: }
! 413: { my ($q, $r);
! 414: ($q, $r) = fdiv_2exp (23, 2);
! 415: ok ($q == 5);
! 416: ok ($r == 3);
! 417: ($q, $r) = fdiv_2exp (-23, 2);
! 418: ok ($q == -6);
! 419: ok ($r == 1);
! 420: }
! 421:
! 422: { my ($q, $r);
! 423: ($q, $r) = tdiv_2exp (23, 2);
! 424: ok ($q == 5);
! 425: ok ($r == 3);
! 426: ($q, $r) = tdiv_2exp (-23, 2);
! 427: ok ($q == -5);
! 428: ok ($r == -3);
! 429: }
! 430:
! 431: {
! 432: my $a = 3;
! 433: my $b = $a;
! 434: ok ($b == 3);
! 435: clrbit ($a, 0);
! 436: print "a==2\n";
! 437: ok ($a == 2);
! 438: print "b==3\n";
! 439: ok ($b == 3);
! 440: print "b=a\n";
! 441: $b = $a;
! 442: print "b==2\n";
! 443: ok ($b == 2);
! 444: print "done\n";
! 445: }
! 446: {
! 447: my $a = 0;
! 448: my $b = $a;
! 449: ok ($b == 0);
! 450: setbit ($a, 0);
! 451: ok ($a == 1);
! 452: ok ($b == 0);
! 453: $b = $a;
! 454: ok ($b == 1);
! 455: }
! 456:
! 457: ok ( congruent_p (21, 0, 7));
! 458: ok (! congruent_p (21, 1, 7));
! 459: ok ( congruent_p (21, 5, 8));
! 460: ok (! congruent_p (21, 6, 8));
! 461:
! 462: ok ( congruent_2exp_p (20, 0, 2));
! 463: ok (! congruent_2exp_p (21, 0, 2));
! 464: ok (! congruent_2exp_p (20, 1, 2));
! 465:
! 466: ok (divexact(27,3) == 9);
! 467: ok (divexact(27,-3) == -9);
! 468: ok (divexact(-27,3) == -9);
! 469: ok (divexact(-27,-3) == 9);
! 470:
! 471: ok ( divisible_p (21, 7));
! 472: ok (! divisible_p (21, 8));
! 473:
! 474: ok ( divisible_2exp_p (20, 2));
! 475: ok (! divisible_2exp_p (21, 2));
! 476:
! 477: ok (! even_p(mpz(-3)));
! 478: ok ( even_p(mpz(-2)));
! 479: ok (! even_p(mpz(-1)));
! 480: ok ( even_p(mpz(0)));
! 481: ok (! even_p(mpz(1)));
! 482: ok ( even_p(mpz(2)));
! 483: ok (! even_p(mpz(3)));
! 484:
! 485: ok (fac(0) == 1);
! 486: ok (fac(1) == 1);
! 487: ok (fac(2) == 2);
! 488: ok (fac(3) == 6);
! 489: ok (fac(4) == 24);
! 490: ok (fac(5) == 120);
! 491:
! 492: ok (fib(0) == 0);
! 493: ok (fib(1) == 1);
! 494: ok (fib(2) == 1);
! 495: ok (fib(3) == 2);
! 496: ok (fib(4) == 3);
! 497: ok (fib(5) == 5);
! 498: ok (fib(6) == 8);
! 499:
! 500: { my ($a, $b) = fib2(0); ok($a==0); ok($b==1); }
! 501: { my ($a, $b) = fib2(1); ok($a==1); ok($b==0); }
! 502: { my ($a, $b) = fib2(2); ok($a==1); ok($b==1); }
! 503: { my ($a, $b) = fib2(3); ok($a==2); ok($b==1); }
! 504: { my ($a, $b) = fib2(4); ok($a==3); ok($b==2); }
! 505: { my ($a, $b) = fib2(5); ok($a==5); ok($b==3); }
! 506: { my ($a, $b) = fib2(6); ok($a==8); ok($b==5); }
! 507:
! 508: ok (gcd (21) == 21);
! 509: ok (gcd (21,15) == 3);
! 510: ok (gcd (21,15,30,57) == 3);
! 511: ok (gcd (21,-15) == 3);
! 512: ok (gcd (-21,15) == 3);
! 513: ok (gcd (-21,-15) == 3);
! 514:
! 515: {
! 516: my ($g, $x, $y) = gcdext (3,5);
! 517: ok ($g == 1);
! 518: ok ($x == 2);
! 519: ok ($y == -1);
! 520: }
! 521:
! 522: ok (hamdist(5,7) == 1);
! 523:
! 524: ok (invert(1,123) == 1);
! 525: ok (invert(6,7) == 6);
! 526: ok (! defined invert(2,8));
! 527:
! 528: foreach my $i ([ 1, 19, 1 ],
! 529: [ 4, 19, 1 ],
! 530: [ 5, 19, 1 ],
! 531: [ 6, 19, 1 ],
! 532: [ 7, 19, 1 ],
! 533: [ 9, 19, 1 ],
! 534: [ 11, 19, 1 ],
! 535: [ 16, 19, 1 ],
! 536: [ 17, 19, 1 ],
! 537: [ 2, 19, -1 ],
! 538: [ 3, 19, -1 ],
! 539: [ 8, 19, -1 ],
! 540: [ 10, 19, -1 ],
! 541: [ 12, 19, -1 ],
! 542: [ 13, 19, -1 ],
! 543: [ 14, 19, -1 ],
! 544: [ 15, 19, -1 ],
! 545: [ 18, 19, -1 ]) {
! 546: foreach my $fun (\&jacobi, \&kronecker) {
! 547: ok (&$fun ($$i[0], $$i[1]) == $$i[2]);
! 548:
! 549: ok (&$fun ($$i[0], str($$i[1])) == $$i[2]);
! 550: ok (&$fun (str($$i[0]), $$i[1]) == $$i[2]);
! 551: ok (&$fun (str($$i[0]), str($$i[1])) == $$i[2]);
! 552:
! 553: ok (&$fun ($$i[0], mpz($$i[1])) == $$i[2]);
! 554: ok (&$fun (mpz($$i[0]), $$i[1]) == $$i[2]);
! 555: ok (&$fun (mpz($$i[0]), mpz($$i[1])) == $$i[2]);
! 556: }
! 557: }
! 558:
! 559: ok (lcm (2) == 2);
! 560: ok (lcm (0) == 0);
! 561: ok (lcm (0,0) == 0);
! 562: ok (lcm (0,0,0) == 0);
! 563: ok (lcm (0,0,0,0) == 0);
! 564: ok (lcm (2,0) == 0);
! 565: ok (lcm (-2,0) == 0);
! 566: ok (lcm (2,3) == 6);
! 567: ok (lcm (2,3,4) == 12);
! 568: ok (lcm (2,-3) == 6);
! 569: ok (lcm (-2,3) == 6);
! 570: ok (lcm (-2,-3) == 6);
! 571: ok (lcm (mpz(2)**512,1) == mpz(2)**512);
! 572: ok (lcm (mpz(2)**512,-1) == mpz(2)**512);
! 573: ok (lcm (-mpz(2)**512,1) == mpz(2)**512);
! 574: ok (lcm (-mpz(2)**512,-1) == mpz(2)**512);
! 575: ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512);
! 576: ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
! 577: ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512);
! 578: ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
! 579:
! 580: ok (lucnum(0) == 2);
! 581: ok (lucnum(1) == 1);
! 582: ok (lucnum(2) == 3);
! 583: ok (lucnum(3) == 4);
! 584: ok (lucnum(4) == 7);
! 585: ok (lucnum(5) == 11);
! 586: ok (lucnum(6) == 18);
! 587:
! 588: { my ($a, $b) = lucnum2(0); ok($a==2); ok($b==-1); }
! 589: { my ($a, $b) = lucnum2(1); ok($a==1); ok($b==2); }
! 590: { my ($a, $b) = lucnum2(2); ok($a==3); ok($b==1); }
! 591: { my ($a, $b) = lucnum2(3); ok($a==4); ok($b==3); }
! 592: { my ($a, $b) = lucnum2(4); ok($a==7); ok($b==4); }
! 593: { my ($a, $b) = lucnum2(5); ok($a==11); ok($b==7); }
! 594: { my ($a, $b) = lucnum2(6); ok($a==18); ok($b==11); }
! 595:
! 596: ok (nextprime(2) == 3);
! 597: ok (nextprime(3) == 5);
! 598: ok (nextprime(5) == 7);
! 599: ok (nextprime(7) == 11);
! 600: ok (nextprime(11) == 13);
! 601:
! 602: ok ( odd_p(mpz(-3)));
! 603: ok (! odd_p(mpz(-2)));
! 604: ok ( odd_p(mpz(-1)));
! 605: ok (! odd_p(mpz(0)));
! 606: ok ( odd_p(mpz(1)));
! 607: ok (! odd_p(mpz(2)));
! 608: ok ( odd_p(mpz(3)));
! 609:
! 610: # ok ( perfect_power_p(mpz(-27)));
! 611: # ok (! perfect_power_p(mpz(-9)));
! 612: # ok (! perfect_power_p(mpz(-1)));
! 613: ok ( perfect_power_p(mpz(0)));
! 614: ok ( perfect_power_p(mpz(1)));
! 615: ok (! perfect_power_p(mpz(2)));
! 616: ok (! perfect_power_p(mpz(3)));
! 617: ok ( perfect_power_p(mpz(4)));
! 618: ok ( perfect_power_p(mpz(9)));
! 619: ok ( perfect_power_p(mpz(27)));
! 620: ok ( perfect_power_p(mpz(81)));
! 621:
! 622: ok (! perfect_square_p(mpz(-9)));
! 623: ok (! perfect_square_p(mpz(-1)));
! 624: ok ( perfect_square_p(mpz(0)));
! 625: ok ( perfect_square_p(mpz(1)));
! 626: ok (! perfect_square_p(mpz(2)));
! 627: ok (! perfect_square_p(mpz(3)));
! 628: ok ( perfect_square_p(mpz(4)));
! 629: ok ( perfect_square_p(mpz(9)));
! 630: ok (! perfect_square_p(mpz(27)));
! 631: ok ( perfect_square_p(mpz(81)));
! 632:
! 633: ok (popcount(7) == 3);
! 634:
! 635: ok (powm (3,2,8) == 1);
! 636:
! 637: ok ( probab_prime_p(89,1));
! 638: ok (! probab_prime_p(81,1));
! 639:
! 640: {
! 641: my $z = mpz(123);
! 642: realloc ($z, 512);
! 643: }
! 644:
! 645: {
! 646: my ($rem, $mult);
! 647: ($rem, $mult) = remove(12,3);
! 648: ok ($rem == 4);
! 649: ok ($mult == 1);
! 650: ($rem, $mult) = remove(12,2);
! 651: ok ($rem == 3);
! 652: ok ($mult == 2);
! 653: }
! 654:
! 655: ok (root(0,2) == 0);
! 656: ok (root(8,3) == 2);
! 657: ok (root(-8,3) == -2);
! 658: ok (root(81,4) == 3);
! 659: ok (root(243,5) == 3);
! 660:
! 661: { my ($r,$e);
! 662: ($r, $e) = roote(0,2);
! 663: ok ($r == 0);
! 664: ok ($e);
! 665: ($r, $e) = roote(81,4);
! 666: ok ($r == 3);
! 667: ok ($e);
! 668: ($r, $e) = roote(85,4);
! 669: ok ($r == 3);
! 670: ok (! $e);
! 671: }
! 672:
! 673: {
! 674: my $ulong_max = ~ 0;
! 675: ok (scan0 (0, 0) == 0);
! 676: ok (scan0 (1, 0) == 1);
! 677: ok (scan0 (3, 0) == 2);
! 678: ok (scan0 (-1, 0) == $ulong_max);
! 679: ok (scan0 (-2, 1) == $ulong_max);
! 680:
! 681: ok (scan1 (1, 0) == 0);
! 682: ok (scan1 (2, 0) == 1);
! 683: ok (scan1 (4, 0) == 2);
! 684: ok (scan1 (0, 0) == $ulong_max);
! 685: ok (scan1 (3, 2) == $ulong_max);
! 686: }
! 687:
! 688: ok (sizeinbase(1,10) == 1);
! 689: ok (sizeinbase(100,10) == 3);
! 690: ok (sizeinbase(9999,10) == 5);
! 691:
! 692: foreach my $name ('mpz', 'mpf') {
! 693: print "$name\n";
! 694: my $mpx = eval("\\&$name");
! 695: ok (sqrt(&$mpx(0)) == 0);
! 696: ok (sqrt(&$mpx(1)) == 1);
! 697: ok (sqrt(&$mpx(4)) == 2);
! 698: ok (sqrt(&$mpx(81)) == 9);
! 699: }
! 700:
! 701: {
! 702: my ($root, $rem) = sqrtrem(mpz(0));
! 703: ok ($root == 0);
! 704: ok ($rem == 0);
! 705: }
! 706: {
! 707: my ($root, $rem) = sqrtrem(mpz(1));
! 708: ok ($root == 1);
! 709: ok ($rem == 0);
! 710: }
! 711: {
! 712: my ($root, $rem) = sqrtrem(mpz(2));
! 713: ok ($root == 1);
! 714: ok ($rem == 1);
! 715: }
! 716: {
! 717: my ($root, $rem) = sqrtrem(mpz(9));
! 718: ok ($root == 3);
! 719: ok ($rem == 0);
! 720: }
! 721: {
! 722: my ($root, $rem) = sqrtrem(mpz(35));
! 723: ok ($root == 5);
! 724: ok ($rem == 10);
! 725: }
! 726: {
! 727: my ($root, $rem) = sqrtrem(mpz(0));
! 728: ok ($root == 0);
! 729: ok ($rem == 0);
! 730: }
! 731:
! 732: ok (tstbit (6, 0) == 0);
! 733: ok (tstbit (6, 1) == 1);
! 734: ok (tstbit (6, 2) == 1);
! 735: ok (tstbit (6, 3) == 0);
! 736:
! 737:
! 738: # mpq functions
! 739:
! 740: ok (mpq('3/2') == mpq(3,2));
! 741: ok (mpq('3/1') == mpq(3,1));
! 742: ok (mpq('-3/2') == mpq(-3,2));
! 743: ok (mpq('-3/1') == mpq(-3,1));
! 744: ok (mpq('0x3') == mpq(3,1));
! 745: ok (mpq('0b111') == mpq(7,1));
! 746: ok (mpq('0b0') == mpq(0,1));
! 747:
! 748: ok (mpq(3,2) > 1);
! 749: ok (mpq(3,2) < 2);
! 750:
! 751: ok (mpq(1,2)+mpq(1,3) == mpq(5,6));
! 752: ok (mpq(1,2)+mpq(-1,3) == mpq(1,6));
! 753: ok (mpq(-1,2)+mpq(1,3) == mpq(-1,6));
! 754: ok (mpq(-1,2)+mpq(-1,3) == mpq(-5,6));
! 755:
! 756: ok (mpq(1,2)-mpq(1,3) == mpq(1,6));
! 757: ok (mpq(1,2)-mpq(-1,3) == mpq(5,6));
! 758: ok (mpq(-1,2)-mpq(1,3) == mpq(-5,6));
! 759: ok (mpq(-1,2)-mpq(-1,3) == mpq(-1,6));
! 760:
! 761: {
! 762: my $q = mpq(21,15); canonicalize($q);
! 763: ok (num($q) == 7);
! 764: ok (den($q) == 5);
! 765: }
! 766:
! 767: { my $q = mpq(5,7); ok("$q" eq "5/7"); }
! 768: { my $q = mpq(-5,7); ok("$q" eq "-5/7"); }
! 769:
! 770:
! 771: # mpf functions
! 772:
! 773: ok (mpf(-1.5) == -1.5);
! 774: ok (mpf(-1.0) == -1.0);
! 775: ok (mpf(-0.5) == -0.5);
! 776: ok (mpf(0) == 0);
! 777: ok (mpf(0.5) == 0.5);
! 778: ok (mpf(1.0) == 1.0);
! 779: ok (mpf(1.5) == 1.5);
! 780:
! 781: ok (mpf("-1.5") == -1.5);
! 782: ok (mpf("-1.0") == -1.0);
! 783: ok (mpf("-0.5") == -0.5);
! 784: ok (mpf("0") == 0);
! 785: ok (mpf("0.5") == 0.5);
! 786: ok (mpf("1.0") == 1.0);
! 787: ok (mpf("1.5") == 1.5);
! 788:
! 789: { my $f = mpf(0.25); ok("$f" eq "0.25"); }
! 790: { my $f = mpf(-0.25); ok("$f" eq "-0.25"); }
! 791: { my $f = mpf(1.25); ok("$f" eq "1.25"); }
! 792: { my $f = mpf(-1.25); ok("$f" eq "-1.25"); }
! 793: { my $f = mpf(1000000); ok("$f" eq "1000000"); }
! 794: { my $f = mpf(-1000000); ok("$f" eq "-1000000"); }
! 795:
! 796: ok (floor(mpf(-7.5)) == -8.0);
! 797: ok (ceil (mpf(-7.5)) == -7.0);
! 798: ok (trunc(mpf(-7.5)) == -7.0);
! 799: ok (floor(mpf(7.5)) == 7.0);
! 800: ok (ceil (mpf(7.5)) == 8.0);
! 801: ok (trunc(mpf(7.5)) == 7.0);
! 802:
! 803: set_default_prec(128);
! 804: ok ( mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1));
! 805: ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128));
! 806:
! 807: {
! 808: set_default_prec(128);
! 809: my $p = get_default_prec();
! 810: set_default_prec($p);
! 811: ok (get_default_prec() == $p);
! 812: }
! 813:
! 814: ok (reldiff (2,4) == 1);
! 815: ok (reldiff (4,2) == 0.5);
! 816:
! 817: {
! 818: my $x = mpf(1.0, 512);
! 819: my $y = $x;
! 820: my $yprec = get_prec ($y);
! 821: set_prec ($x, 1024);
! 822: ok (get_prec ($y) == $yprec);
! 823:
! 824: my $xprec = get_prec ($x);
! 825: set_prec ($x, $xprec);
! 826: ok (get_prec ($x) == $xprec);
! 827: }
! 828:
! 829:
! 830: # random functions
! 831:
! 832: { my $r = randstate(); ok (defined $r); }
! 833: { my $r = randstate('lc_2exp', 1, 2, 3); ok (defined $r); }
! 834: { my $r = randstate('lc_2exp_size', 64); ok (defined $r); }
! 835: { my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); }
! 836: {
! 837: my $r = randstate();
! 838: $r->seed(123);
! 839: $r->seed(time());
! 840: mpf_urandomb($r,1024);
! 841: mpz_urandomb($r,1024);
! 842: mpz_rrandomb($r,1024);
! 843: mpz_urandomm($r,mpz(3)**100);
! 844: }
! 845:
! 846:
! 847: # overloaded constants
! 848:
! 849: if ($^V > 5.00503) {
! 850: if (! do 'test2.pl') {
! 851: die "Cannot run test2.pl\n";
! 852: }
! 853: }
! 854:
! 855:
! 856: # printf functions
! 857:
! 858: {
! 859: GMP::printf ("hello world\n");
! 860:
! 861: sub via_printf {
! 862: my $s;
! 863: open TEMP, ">test.tmp" or die;
! 864: GMP::printf TEMP @_;
! 865: close TEMP or die;
! 866: open TEMP, "<test.tmp" or die;
! 867: read (TEMP, $s, 1024);
! 868: close TEMP or die;
! 869: unlink 'test.tmp';
! 870: return $s;
! 871: }
! 872:
! 873: my $z = mpz(123);
! 874: my $q = mpq(15,16);
! 875: my $f = mpf(1.5);
! 876:
! 877: foreach my $name ('via_printf', 'sprintf') {
! 878: print "$name\n";
! 879: my $mpx = eval("\\&$name");
! 880:
! 881: ok (&$mpx ("%d", $z) eq '123');
! 882: ok (&$mpx ("%d %d %d", 456, $z, 789) eq '456 123 789');
! 883: ok (&$mpx ("%d", $q) eq '15/16');
! 884: ok (&$mpx ("%f", $f) eq '1.500000');
! 885: ok (&$mpx ("%.2f", $f) eq '1.50');
! 886:
! 887: ok (&$mpx ("%*d", 6, 123) eq ' 123');
! 888: ok (&$mpx ("%*d", 6, $z) eq ' 123');
! 889: ok (&$mpx ("%*d", 6, $q) eq ' 15/16');
! 890:
! 891: ok (&$mpx ("%x", 123) eq '7b');
! 892: ok (&$mpx ("%x", $z) eq '7b');
! 893: ok (&$mpx ("%X", 123) eq '7B');
! 894: ok (&$mpx ("%X", $z) eq '7B');
! 895: ok (&$mpx ("%#x", 123) eq '0x7b');
! 896: ok (&$mpx ("%#x", $z) eq '0x7b');
! 897: ok (&$mpx ("%#X", 123) eq '0X7B');
! 898: ok (&$mpx ("%#X", $z) eq '0X7B');
! 899:
! 900: ok (&$mpx ("%x", $q) eq 'f/10');
! 901: ok (&$mpx ("%X", $q) eq 'F/10');
! 902: ok (&$mpx ("%#x", $q) eq '0xf/0x10');
! 903: ok (&$mpx ("%#X", $q) eq '0XF/0X10');
! 904:
! 905: ok (&$mpx ("%*.*f", 10, 3, 1.25) eq ' 1.250');
! 906: ok (&$mpx ("%*.*f", 10, 3, $f) eq ' 1.500');
! 907: }
! 908: }
! 909:
! 910: # Local variables:
! 911: # perl-indent-level: 2
! 912: # End:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / gmp / demos / perl