Annotation of OpenXM_contrib/gmp/demos/perl/test.pl, Revision 1.1.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