开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数值算法/人工智能 > 数学计算 > 查看源码
test.pl
资源名称：gmp-5.0.1.tar.gz　[点击查看]
上传用户：qaz666999
上传日期：2022-08-06
资源大小：2570k
文件大小：58k
源码类别：

数学计算

开发平台：

Unix_Linux

test.pl：源码内容
  1. #!/usr/bin/perl -w
  3. # GMP perl module tests
  5. # Copyright 2001, 2002, 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 the GNU Lesser General Public License as published
  11. # by the Free Software Foundation; either version 3 of the License, or (at
  12. # your option) any later version.
  13. #
  14. # The GNU MP Library is distributed in the hope that it will be useful, but
  15. # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  16. # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  17. # License for more details.
  18. #
  19. # You should have received a copy of the GNU Lesser General Public License
  20. # along with the GNU MP Library.  If not, see http://www.gnu.org/licenses/.
  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)))
  36. use strict;
  37. use Test;
  39. BEGIN {
  40.   plan tests => 123,
  41.   onfail => sub { print "there were failuresn" },
  42. }
  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);
  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);
  57. package Mytie;
  58. use Exporter;
  59. use vars  qw($val $fetched $stored);
  60. $val = 0;
  61. $fetched = 0;
  62. $stored = 0;
  63. sub TIESCALAR {
  64.   my ($class, $newval) = @_;
  65.   my $var = 'mytie dummy refed var';
  66.   $val = $newval;
  67.   $fetched = 0;
  68.   $stored = 0;
  69.   return bless $var, $class;
  70. }
  71. sub FETCH {
  72.   my ($self) = @_;
  73.   $fetched++;
  74.   return $val;
  75. }
  76. sub STORE {
  77.   my ($self, $newval) = @_;
  78.   $val = $newval;
  79.   $stored++;
  80. }
  81. package main;
  83. # check Mytie does what it should
  84. { tie my $t, 'Mytie', 123;
  85.   ok ($Mytie::val == 123);
  86.   $Mytie::val = 456;
  87.   ok ($t == 456);
  88.   $t = 789;
  89.   ok ($Mytie::val == 789);
  90. }
  93. # Usage: str(x)
  94. # Return x forced to a string, not a PVIV.
  95. #
  96. sub str {
  97.   my $s = "$_[0]" . "";
  98.   return $s;
  99. }
  101. my $ivnv_2p128 = 65536.0 * 65536.0 * 65536.0 * 65536.0
  102.                * 65536.0 * 65536.0 * 65536.0 * 65536.0;
  103. kill (0, $ivnv_2p128);
  104. my $str_2p128 = '340282366920938463463374607431768211456';
  106. my $uv_max = ~ 0;
  107. my $uv_max_str = ~ 0;
  108. $uv_max_str = "$uv_max_str";
  109. $uv_max_str = "" . "$uv_max_str";
  112. #------------------------------------------------------------------------------
  113. # GMP::version
  115. use GMP qw(version);
  116. print '$GMP::VERSION ',$GMP::VERSION,' GMP::version() ',version(),"n";
  119. #------------------------------------------------------------------------------
  120. # GMP::Mpz::new
  122. ok (mpz(0) == 0);
  123. ok (mpz('0') == 0);
  124. ok (mpz(substr('101',1,1)) == 0);
  125. ok (mpz(0.0) == 0);
  126. ok (mpz(mpz(0)) == 0);
  127. ok (mpz(mpq(0)) == 0);
  128. ok (mpz(mpf(0)) == 0);
  130. { tie my $t, 'Mytie', 0;
  131.   ok (mpz($t) == 0);
  132.   ok ($Mytie::fetched > 0);
  133. }
  134. { tie my $t, 'Mytie', '0';
  135.   ok (mpz($t) == 0);
  136.   ok ($Mytie::fetched > 0);
  137. }
  138. { tie my $t, 'Mytie', substr('101',1,1); ok (mpz($t) == 0); }
  139. { tie my $t, 'Mytie', 0.0; ok (mpz($t) == 0); }
  140. { tie my $t, 'Mytie', mpz(0); ok (mpz($t) == 0); }
  141. { tie my $t, 'Mytie', mpq(0); ok (mpz($t) == 0); }
  142. { tie my $t, 'Mytie', mpf(0); ok (mpz($t) == 0); }
  144. ok (mpz(-123) == -123);
  145. ok (mpz('-123') == -123);
  146. ok (mpz(substr('1-1231',1,4)) == -123);
  147. ok (mpz(-123.0) == -123);
  148. ok (mpz(mpz(-123)) == -123);
  149. ok (mpz(mpq(-123)) == -123);
  150. ok (mpz(mpf(-123)) == -123);
  152. { tie my $t, 'Mytie', -123; ok (mpz($t) == -123); }
  153. { tie my $t, 'Mytie', '-123'; ok (mpz($t) == -123); }
  154. { tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpz($t) == -123); }
  155. { tie my $t, 'Mytie', -123.0; ok (mpz($t) == -123); }
  156. { tie my $t, 'Mytie', mpz(-123); ok (mpz($t) == -123); }
  157. { tie my $t, 'Mytie', mpq(-123); ok (mpz($t) == -123); }
  158. { tie my $t, 'Mytie', mpf(-123); ok (mpz($t) == -123); }
  160. ok (mpz($ivnv_2p128) == $str_2p128);
  161. { tie my $t, 'Mytie', $ivnv_2p128; ok (mpz($t) == $str_2p128); }
  163. ok (mpz($uv_max) > 0);
  164. ok (mpz($uv_max) == mpz($uv_max_str));
  165. { tie my $t, 'Mytie', $uv_max; ok (mpz($t) > 0); }
  166. { tie my $t, 'Mytie', $uv_max; ok (mpz($t) == mpz($uv_max_str)); }
  168. { my $s = '999999999999999999999999999999';
  169.   kill (0, $s);
  170.   ok (mpz($s) == '999999999999999999999999999999');
  171.   tie my $t, 'Mytie', $s;
  172.   ok (mpz($t) == '999999999999999999999999999999');
  173. }
  175. #------------------------------------------------------------------------------
  176. # GMP::Mpz::overload_abs
  178. ok (abs(mpz(0)) == 0);
  179. ok (abs(mpz(123)) == 123);
  180. ok (abs(mpz(-123)) == 123);
  182. { my $x = mpz(-123); $x = abs($x); ok ($x == 123); }
  183. { my $x = mpz(0);    $x = abs($x); ok ($x == 0);   }
  184. { my $x = mpz(123);  $x = abs($x); ok ($x == 123); }
  186. { tie my $t, 'Mytie', mpz(0); ok (abs($t) == 0); }
  187. { tie my $t, 'Mytie', mpz(123); ok (abs($t) == 123); }
  188. { tie my $t, 'Mytie', mpz(-123); ok (abs($t) == 123); }
  190. #------------------------------------------------------------------------------
  191. # GMP::Mpz::overload_add
  193. ok (mpz(0) + 1 == 1);
  194. ok (mpz(-1) + 1 == 0);
  195. ok (1 + mpz(0) == 1);
  196. ok (1 + mpz(-1) == 0);
  198. #------------------------------------------------------------------------------
  199. # GMP::Mpz::overload_addeq
  201. { my $a = mpz(7); $a += 1; ok ($a == 8); }
  202. { my $a = mpz(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
  204. #------------------------------------------------------------------------------
  205. # GMP::Mpz::overload_and
  207. ok ((mpz(3) & 1) == 1);
  208. ok ((mpz(3) & 4) == 0);
  210. { my $a = mpz(3); $a &= 1; ok ($a == 1); }
  211. { my $a = mpz(3); $a &= 4; ok ($a == 0); }
  213. #------------------------------------------------------------------------------
  214. # GMP::Mpz::overload_bool
  216. if (mpz(0))   { ok (0); } else { ok (1); }
  217. if (mpz(123)) { ok (1); } else { ok (0); }
  219. #------------------------------------------------------------------------------
  220. # GMP::Mpz::overload_com
  222. ok (~ mpz(0) == -1);
  223. ok (~ mpz(1) == -2);
  224. ok (~ mpz(-2) == 1);
  225. ok (~ mpz(0xFF) == -0x100);
  226. ok (~ mpz(-0x100) == 0xFF);
  228. #------------------------------------------------------------------------------
  229. # GMP::Mpz::overload_dec
  231. { my $a = mpz(0); ok ($a-- == 0); ok ($a == -1); }
  232. { my $a = mpz(0); ok (--$a == -1); }
  234. { my $a = mpz(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
  236. #------------------------------------------------------------------------------
  237. # GMP::Mpz::overload_div
  239. ok (mpz(6) / 2 == 3);
  240. ok (mpz(-6) / 2 == -3);
  241. ok (mpz(6) / -2 == -3);
  242. ok (mpz(-6) / -2 == 3);
  244. #------------------------------------------------------------------------------
  245. # GMP::Mpz::overload_diveq
  247. { my $a = mpz(21); $a /= 3; ok ($a == 7); }
  248. { my $a = mpz(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
  250. #------------------------------------------------------------------------------
  251. # GMP::Mpz::overload_eq
  253. { my $a = mpz(0);
  254.   my $b = $a;
  255.   $a = mpz(1);
  256.   ok ($a == 1);
  257.   ok ($b == 0); }
  259. #------------------------------------------------------------------------------
  260. # GMP::Mpz::overload_inc
  262. { my $a = mpz(0); ok ($a++ == 0); ok ($a == 1); }
  263. { my $a = mpz(0); ok (++$a == 1); }
  265. { my $a = mpz(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
  267. #------------------------------------------------------------------------------
  268. # GMP::Mpz::overload_ior
  270. ok ((mpz(3) | 1) == 3);
  271. ok ((mpz(3) | 4) == 7);
  273. { my $a = mpz(3); $a |= 1; ok ($a == 3); }
  274. { my $a = mpz(3); $a |= 4; ok ($a == 7); }
  276. ok ((mpz("0xAA") | mpz("0x55")) == mpz("0xFF"));
  278. #------------------------------------------------------------------------------
  279. # GMP::Mpz::overload_lshift
  281. { my $a = mpz(7) << 1; ok ($a == 14); }
  283. #------------------------------------------------------------------------------
  284. # GMP::Mpz::overload_lshifteq
  286. { my $a = mpz(7); $a <<= 1; ok ($a == 14); }
  287. { my $a = mpz(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
  289. #------------------------------------------------------------------------------
  290. # GMP::Mpz::overload_mul
  292. ok (mpz(2) * 3 == 6);
  294. #------------------------------------------------------------------------------
  295. # GMP::Mpz::overload_muleq
  297. { my $a = mpz(7); $a *= 3;  ok ($a == 21); }
  298. { my $a = mpz(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
  300. #------------------------------------------------------------------------------
  301. # GMP::Mpz::overload_neg
  303. ok (- mpz(0) == 0);
  304. ok (- mpz(123) == -123);
  305. ok (- mpz(-123) == 123);
  307. #------------------------------------------------------------------------------
  308. # GMP::Mpz::overload_not
  310. if (not mpz(0))   { ok (1); } else { ok (0); }
  311. if (not mpz(123)) { ok (0); } else { ok (1); }
  313. ok ((! mpz(0)) == 1);
  314. ok ((! mpz(123)) == 0);
  316. #------------------------------------------------------------------------------
  317. # GMP::Mpz::overload_pow
  319. ok (mpz(0) ** 1 == 0);
  320. ok (mpz(1) ** 1 == 1);
  321. ok (mpz(2) ** 0 == 1);
  322. ok (mpz(2) ** 1 == 2);
  323. ok (mpz(2) ** 2 == 4);
  324. ok (mpz(2) ** 3 == 8);
  325. ok (mpz(2) ** 4 == 16);
  327. ok (mpz(0) ** mpz(1) == 0);
  328. ok (mpz(1) ** mpz(1) == 1);
  329. ok (mpz(2) ** mpz(0) == 1);
  330. ok (mpz(2) ** mpz(1) == 2);
  331. ok (mpz(2) ** mpz(2) == 4);
  332. ok (mpz(2) ** mpz(3) == 8);
  333. ok (mpz(2) ** mpz(4) == 16);
  335. #------------------------------------------------------------------------------
  336. # GMP::Mpz::overload_poweq
  338. { my $a = mpz(3); $a **= 4; ok ($a == 81); }
  339. { my $a = mpz(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
  341. #------------------------------------------------------------------------------
  342. # GMP::Mpz::overload_rem
  344. ok (mpz(-8) % 3 == -2);
  345. ok (mpz(-7) % 3 == -1);
  346. ok (mpz(-6) % 3 == 0);
  347. ok (mpz(6) % 3 == 0);
  348. ok (mpz(7) % 3 == 1);
  349. ok (mpz(8) % 3 == 2);
  351. { my $a = mpz(24); $a %= 7; ok ($a == 3); }
  353. #------------------------------------------------------------------------------
  354. # GMP::Mpz::overload_rshift
  356. { my $a = mpz(32) >> 1; ok ($a == 16); }
  358. #------------------------------------------------------------------------------
  359. # GMP::Mpz::overload_rshifteq
  361. { my $a = mpz(32); $a >>= 1; ok ($a == 16); }
  362. { my $a = mpz(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
  364. #------------------------------------------------------------------------------
  365. # GMP::Mpz::overload_spaceship
  367. ok (mpz(0) < 1);
  368. ok (mpz(0) > -1);
  370. ok (mpz(0) != 1);
  371. ok (mpz(0) != -1);
  372. ok (mpz(1) != 0);
  373. ok (mpz(1) != -1);
  374. ok (mpz(-1) != 0);
  375. ok (mpz(-1) != 1);
  377. ok (mpz(0) < 1.0);
  378. ok (mpz(0) < '1');
  379. ok (mpz(0) < substr('-1',1,1));
  380. ok (mpz(0) < mpz(1));
  381. ok (mpz(0) < mpq(1));
  382. ok (mpz(0) < mpf(1));
  383. ok (mpz(0) < $uv_max);
  385. #------------------------------------------------------------------------------
  386. # GMP::Mpz::overload_sqrt
  388. ok (sqrt(mpz(0)) == 0);
  389. ok (sqrt(mpz(1)) == 1);
  390. ok (sqrt(mpz(4)) == 2);
  391. ok (sqrt(mpz(81)) == 9);
  393. #------------------------------------------------------------------------------
  394. # GMP::Mpz::overload_string
  396. { my $x = mpz(0);    ok("$x" eq "0"); }
  397. { my $x = mpz(123);  ok("$x" eq "123"); }
  398. { my $x = mpz(-123); ok("$x" eq "-123"); }
  400. #------------------------------------------------------------------------------
  401. # GMP::Mpz::overload_sub
  403. ok (mpz(0) - 1 == -1);
  404. ok (mpz(1) - 1 == 0);
  405. ok (1 - mpz(0) == 1);
  406. ok (1 - mpz(1) == 0);
  408. #------------------------------------------------------------------------------
  409. # GMP::Mpz::overload_subeq
  411. { my $a = mpz(7); $a -= 1; ok ($a == 6); }
  412. { my $a = mpz(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
  414. #------------------------------------------------------------------------------
  415. # GMP::Mpz::overload_xor
  417. ok ((mpz(3) ^ 1) == 2);
  418. ok ((mpz(3) ^ 4) == 7);
  420. { my $a = mpz(3); $a ^= 1; ok ($a == 2); }
  421. { my $a = mpz(3); $a ^= 4; ok ($a == 7); }
  424. #------------------------------------------------------------------------------
  425. # GMP::Mpz::bin
  427. ok (bin(2,0) == 1);
  428. ok (bin(2,1) == 2);
  429. ok (bin(2,2) == 1);
  431. ok (bin(3,0) == 1);
  432. ok (bin(3,1) == 3);
  433. ok (bin(3,2) == 3);
  434. ok (bin(3,3) == 1);
  437. #------------------------------------------------------------------------------
  438. # GMP::Mpz::cdiv
  440. { my ($q, $r);
  441.   ($q, $r) = cdiv (16, 3);
  442.   ok ($q == 6);
  443.   ok ($r == -2);
  444.   ($q, $r) = cdiv (16, -3);
  445.   ok ($q == -5);
  446.   ok ($r == 1);
  447.   ($q, $r) = cdiv (-16, 3);
  448.   ok ($q == -5);
  449.   ok ($r == -1);
  450.   ($q, $r) = cdiv (-16, -3);
  451.   ok ($q == 6);
  452.   ok ($r == 2);
  453. }
  456. #------------------------------------------------------------------------------
  457. # GMP::Mpz::cdiv_2exp
  459. { my ($q, $r);
  460.   ($q, $r) = cdiv_2exp (23, 2);
  461.   ok ($q == 6);
  462.   ok ($r == -1);
  463.   ($q, $r) = cdiv_2exp (-23, 2);
  464.   ok ($q == -5);
  465.   ok ($r == -3);
  466. }
  469. #------------------------------------------------------------------------------
  470. # GMP::Mpz::clrbit
  472. { my $a = mpz(3); clrbit ($a, 1); ok ($a == 1);
  473.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  474. { my $a = mpz(3); clrbit ($a, 2); ok ($a == 3);
  475.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  477. { my $a = 3; clrbit ($a, 1); ok ($a == 1);
  478.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  479. { my $a = 3; clrbit ($a, 2); ok ($a == 3);
  480.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  482. # mutate only given variable
  483. { my $a = mpz(3);
  484.   my $b = $a;
  485.   clrbit ($a, 0);
  486.   ok ($a == 2);
  487.   ok ($b == 3);
  488. }
  489. { my $a = 3;
  490.   my $b = $a;
  491.   clrbit ($a, 0);
  492.   ok ($a == 2);
  493.   ok ($b == 3);
  494. }
  496. { tie my $a, 'Mytie', mpz(3);
  497.   clrbit ($a, 1);
  498.   ok ($Mytie::fetched > 0);    # used fetch
  499.   ok ($Mytie::stored > 0);     # used store
  500.   ok ($a == 1);                # expected result
  501.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  502.   ok (tied($a));               # still tied
  503. }
  504. { tie my $a, 'Mytie', 3;
  505.   clrbit ($a, 1);
  506.   ok ($Mytie::fetched > 0);    # used fetch
  507.   ok ($Mytie::stored > 0);     # used store
  508.   ok ($a == 1);                # expected result
  509.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  510.   ok (tied($a));               # still tied
  511. }
  513. { my $b = mpz(3);
  514.   tie my $a, 'Mytie', $b;
  515.   clrbit ($a, 0);
  516.   ok ($a == 2);
  517.   ok ($b == 3);
  518.   ok (tied($a));
  519. }
  520. { my $b = 3;
  521.   tie my $a, 'Mytie', $b;
  522.   clrbit ($a, 0);
  523.   ok ($a == 2);
  524.   ok ($b == 3);
  525.   ok (tied($a));
  526. }
  528. #------------------------------------------------------------------------------
  529. # GMP::Mpz::combit
  531. { my $a = mpz(3); combit ($a, 1); ok ($a == 1);
  532.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  533. { my $a = mpz(3); combit ($a, 2); ok ($a == 7);
  534.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  536. { my $a = 3; combit ($a, 1); ok ($a == 1);
  537.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  538. { my $a = 3; combit ($a, 2); ok ($a == 7);
  539.   ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
  541. # mutate only given variable
  542. { my $a = mpz(3);
  543.   my $b = $a;
  544.   combit ($a, 0);
  545.   ok ($a == 2);
  546.   ok ($b == 3);
  547. }
  548. { my $a = 3;
  549.   my $b = $a;
  550.   combit ($a, 0);
  551.   ok ($a == 2);
  552.   ok ($b == 3);
  553. }
  555. { tie my $a, 'Mytie', mpz(3);
  556.   combit ($a, 2);
  557.   ok ($Mytie::fetched > 0);    # used fetch
  558.   ok ($Mytie::stored > 0);     # used store
  559.   ok ($a == 7);                # expected result
  560.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  561.   ok (tied($a));               # still tied
  562. }
  563. { tie my $a, 'Mytie', 3;
  564.   combit ($a, 2);
  565.   ok ($Mytie::fetched > 0);    # used fetch
  566.   ok ($Mytie::stored > 0);     # used store
  567.   ok ($a == 7);                # expected result
  568.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  569.   ok (tied($a));               # still tied
  570. }
  572. { my $b = mpz(3);
  573.   tie my $a, 'Mytie', $b;
  574.   combit ($a, 0);
  575.   ok ($a == 2);
  576.   ok ($b == 3);
  577.   ok (tied($a));
  578. }
  579. { my $b = 3;
  580.   tie my $a, 'Mytie', $b;
  581.   combit ($a, 0);
  582.   ok ($a == 2);
  583.   ok ($b == 3);
  584.   ok (tied($a));
  585. }
  587. #------------------------------------------------------------------------------
  588. # GMP::Mpz::congruent_p
  590. ok (  congruent_p (21, 0, 7));
  591. ok (! congruent_p (21, 1, 7));
  592. ok (  congruent_p (21, 5, 8));
  593. ok (! congruent_p (21, 6, 8));
  596. #------------------------------------------------------------------------------
  597. # GMP::Mpz::congruent_2exp_p
  599. ok (  congruent_2exp_p (20, 0, 2));
  600. ok (! congruent_2exp_p (21, 0, 2));
  601. ok (! congruent_2exp_p (20, 1, 2));
  603. #------------------------------------------------------------------------------
  604. # GMP::Mpz::divexact
  606. ok (divexact(27,3) == 9);
  607. ok (divexact(27,-3) == -9);
  608. ok (divexact(-27,3) == -9);
  609. ok (divexact(-27,-3) == 9);
  611. #------------------------------------------------------------------------------
  612. # GMP::Mpz::divisible_p
  614. ok (  divisible_p (21, 7));
  615. ok (! divisible_p (21, 8));
  617. #------------------------------------------------------------------------------
  618. # GMP::Mpz::divisible_2exp_p
  620. ok (  divisible_2exp_p (20, 2));
  621. ok (! divisible_2exp_p (21, 2));
  623. #------------------------------------------------------------------------------
  624. # GMP::Mpz::even_p
  626. ok (! even_p(mpz(-3)));
  627. ok (  even_p(mpz(-2)));
  628. ok (! even_p(mpz(-1)));
  629. ok (  even_p(mpz(0)));
  630. ok (! even_p(mpz(1)));
  631. ok (  even_p(mpz(2)));
  632. ok (! even_p(mpz(3)));
  634. #------------------------------------------------------------------------------
  635. # GMP::Mpz::export
  637. { my $s = mpz_export (1, 2, 1, 0, "0x61626364");
  638.   ok ($s eq 'abcd'); }
  639. { my $s = mpz_export (-1, 2, 1, 0, "0x61626364");
  640.   ok ($s eq 'cdab'); }
  641. { my $s = mpz_export (1, 2, -1, 0, "0x61626364");
  642.   ok ($s eq 'badc'); }
  643. { my $s = mpz_export (-1, 2, -1, 0, "0x61626364");
  644.   ok ($s eq 'dcba'); }
  646. #------------------------------------------------------------------------------
  647. # GMP::Mpz::fac
  649. ok (fac(0) == 1);
  650. ok (fac(1) == 1);
  651. ok (fac(2) == 2);
  652. ok (fac(3) == 6);
  653. ok (fac(4) == 24);
  654. ok (fac(5) == 120);
  656. #------------------------------------------------------------------------------
  657. # GMP::Mpz::fdiv
  659. { my ($q, $r);
  660.   ($q, $r) = fdiv (16, 3);
  661.   ok ($q == 5);
  662.   ok ($r == 1);
  663.   ($q, $r) = fdiv (16, -3);
  664.   ok ($q == -6);
  665.   ok ($r == -2);
  666.   ($q, $r) = fdiv (-16, 3);
  667.   ok ($q == -6);
  668.   ok ($r == 2);
  669.   ($q, $r) = fdiv (-16, -3);
  670.   ok ($q == 5);
  671.   ok ($r == -1);
  672. }
  674. #------------------------------------------------------------------------------
  675. # GMP::Mpz::fdiv_2exp
  677. { my ($q, $r);
  678.   ($q, $r) = fdiv_2exp (23, 2);
  679.   ok ($q == 5);
  680.   ok ($r == 3);
  681.   ($q, $r) = fdiv_2exp (-23, 2);
  682.   ok ($q == -6);
  683.   ok ($r == 1);
  684. }
  686. #------------------------------------------------------------------------------
  687. # GMP::Mpz::fib
  689. ok (fib(0) == 0);
  690. ok (fib(1) == 1);
  691. ok (fib(2) == 1);
  692. ok (fib(3) == 2);
  693. ok (fib(4) == 3);
  694. ok (fib(5) == 5);
  695. ok (fib(6) == 8);
  697. #------------------------------------------------------------------------------
  698. # GMP::Mpz::fib2
  700. { my ($a, $b) = fib2(0); ok($a==0); ok($b==1); }
  701. { my ($a, $b) = fib2(1); ok($a==1); ok($b==0); }
  702. { my ($a, $b) = fib2(2); ok($a==1); ok($b==1); }
  703. { my ($a, $b) = fib2(3); ok($a==2); ok($b==1); }
  704. { my ($a, $b) = fib2(4); ok($a==3); ok($b==2); }
  705. { my ($a, $b) = fib2(5); ok($a==5); ok($b==3); }
  706. { my ($a, $b) = fib2(6); ok($a==8); ok($b==5); }
  708. #------------------------------------------------------------------------------
  709. # GMP::Mpz::gcd
  711. ok (gcd (21) == 21);
  712. ok (gcd (21,15) == 3);
  713. ok (gcd (21,15,30,57) == 3);
  714. ok (gcd (21,-15) == 3);
  715. ok (gcd (-21,15) == 3);
  716. ok (gcd (-21,-15) == 3);
  718. #------------------------------------------------------------------------------
  719. # GMP::Mpz::gcdext
  721. {
  722.   my ($g, $x, $y) = gcdext (3,5);
  723.   ok ($g == 1);
  724.   ok ($x == 2);
  725.   ok ($y == -1);
  726. }
  728. #------------------------------------------------------------------------------
  729. # GMP::Mpz::hamdist
  731. ok (hamdist(5,7) == 1);
  733. #------------------------------------------------------------------------------
  734. # GMP::Mpz::import
  736. { my $z = mpz_import (1, 2, 1, 0, 'abcd');
  737.   ok ($z == 0x61626364); }
  738. { my $z = mpz_import (-1, 2, 1, 0, 'abcd');
  739.   ok ($z == 0x63646162); }
  740. { my $z = mpz_import (1, 2, -1, 0, 'abcd');
  741.   ok ($z == 0x62616463); }
  742. { my $z = mpz_import (-1, 2, -1, 0, 'abcd');
  743.   ok ($z == 0x64636261); }
  745. #------------------------------------------------------------------------------
  746. # GMP::Mpz::invert
  748. ok (invert(1,123) == 1);
  749. ok (invert(6,7) == 6);
  750. ok (! defined invert(2,8));
  752. #------------------------------------------------------------------------------
  753. # GMP::Mpz::jacobi, GMP::Mpz::kronecker
  755. foreach my $i ([  1, 19,  1 ],
  756.        [  4, 19,  1 ],
  757.        [  5, 19,  1 ],
  758.        [  6, 19,  1 ],
  759.        [  7, 19,  1 ],
  760.        [  9, 19,  1 ],
  761.        [ 11, 19,  1 ],
  762.        [ 16, 19,  1 ],
  763.        [ 17, 19,  1 ],
  764.        [  2, 19, -1 ],
  765.        [  3, 19, -1 ],
  766.        [  8, 19, -1 ],
  767.        [ 10, 19, -1 ],
  768.        [ 12, 19, -1 ],
  769.        [ 13, 19, -1 ],
  770.        [ 14, 19, -1 ],
  771.        [ 15, 19, -1 ],
  772.        [ 18, 19, -1 ]) {
  773.   foreach my $fun (&jacobi, &kronecker) {
  774.     ok (&$fun ($$i[0], $$i[1]) == $$i[2]);
  776.     ok (&$fun ($$i[0],      str($$i[1])) == $$i[2]);
  777.     ok (&$fun (str($$i[0]),     $$i[1])  == $$i[2]);
  778.     ok (&$fun (str($$i[0]), str($$i[1])) == $$i[2]);
  780.     ok (&$fun ($$i[0],      mpz($$i[1])) == $$i[2]);
  781.     ok (&$fun (mpz($$i[0]), $$i[1]) == $$i[2]);
  782.     ok (&$fun (mpz($$i[0]), mpz($$i[1])) == $$i[2]);
  783.   }
  784. }
  786. #------------------------------------------------------------------------------
  787. # GMP::Mpz::lcm
  789. ok (lcm (2) == 2);
  790. ok (lcm (0) == 0);
  791. ok (lcm (0,0) == 0);
  792. ok (lcm (0,0,0) == 0);
  793. ok (lcm (0,0,0,0) == 0);
  794. ok (lcm (2,0) == 0);
  795. ok (lcm (-2,0) == 0);
  796. ok (lcm (2,3) == 6);
  797. ok (lcm (2,3,4) == 12);
  798. ok (lcm (2,-3) == 6);
  799. ok (lcm (-2,3) == 6);
  800. ok (lcm (-2,-3) == 6);
  801. ok (lcm (mpz(2)**512,1) == mpz(2)**512);
  802. ok (lcm (mpz(2)**512,-1) == mpz(2)**512);
  803. ok (lcm (-mpz(2)**512,1) == mpz(2)**512);
  804. ok (lcm (-mpz(2)**512,-1) == mpz(2)**512);
  805. ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512);
  806. ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
  807. ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512);
  808. ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
  810. #------------------------------------------------------------------------------
  811. # GMP::Mpz::lucnum
  813. ok (lucnum(0) == 2);
  814. ok (lucnum(1) == 1);
  815. ok (lucnum(2) == 3);
  816. ok (lucnum(3) == 4);
  817. ok (lucnum(4) == 7);
  818. ok (lucnum(5) == 11);
  819. ok (lucnum(6) == 18);
  821. #------------------------------------------------------------------------------
  822. # GMP::Mpz::lucnum2
  824. { my ($a, $b) = lucnum2(0); ok($a==2);  ok($b==-1); }
  825. { my ($a, $b) = lucnum2(1); ok($a==1);  ok($b==2); }
  826. { my ($a, $b) = lucnum2(2); ok($a==3);  ok($b==1); }
  827. { my ($a, $b) = lucnum2(3); ok($a==4);  ok($b==3); }
  828. { my ($a, $b) = lucnum2(4); ok($a==7);  ok($b==4); }
  829. { my ($a, $b) = lucnum2(5); ok($a==11); ok($b==7); }
  830. { my ($a, $b) = lucnum2(6); ok($a==18); ok($b==11); }
  832. #------------------------------------------------------------------------------
  833. # GMP::Mpz::nextprime
  835. ok (nextprime(2) == 3);
  836. ok (nextprime(3) == 5);
  837. ok (nextprime(5) == 7);
  838. ok (nextprime(7) == 11);
  839. ok (nextprime(11) == 13);
  841. #------------------------------------------------------------------------------
  842. # GMP::Mpz::perfect_power_p
  844. # ok (  perfect_power_p(mpz(-27)));
  845. # ok (! perfect_power_p(mpz(-9)));
  846. # ok (! perfect_power_p(mpz(-1)));
  847. ok (  perfect_power_p(mpz(0)));
  848. ok (  perfect_power_p(mpz(1)));
  849. ok (! perfect_power_p(mpz(2)));
  850. ok (! perfect_power_p(mpz(3)));
  851. ok (  perfect_power_p(mpz(4)));
  852. ok (  perfect_power_p(mpz(9)));
  853. ok (  perfect_power_p(mpz(27)));
  854. ok (  perfect_power_p(mpz(81)));
  856. #------------------------------------------------------------------------------
  857. # GMP::Mpz::perfect_square_p
  859. ok (! perfect_square_p(mpz(-9)));
  860. ok (! perfect_square_p(mpz(-1)));
  861. ok (  perfect_square_p(mpz(0)));
  862. ok (  perfect_square_p(mpz(1)));
  863. ok (! perfect_square_p(mpz(2)));
  864. ok (! perfect_square_p(mpz(3)));
  865. ok (  perfect_square_p(mpz(4)));
  866. ok (  perfect_square_p(mpz(9)));
  867. ok (! perfect_square_p(mpz(27)));
  868. ok (  perfect_square_p(mpz(81)));
  870. #------------------------------------------------------------------------------
  871. # GMP::Mpz::popcount
  873. ok (popcount(7) == 3);
  875. #------------------------------------------------------------------------------
  876. # GMP::Mpz::powm
  878. ok (powm (3,2,8) == 1);
  880. #------------------------------------------------------------------------------
  881. # GMP::Mpz::probab_prime_p
  883. ok (  probab_prime_p(89,1));
  884. ok (! probab_prime_p(81,1));
  886. #------------------------------------------------------------------------------
  887. # GMP::Mpz::realloc
  889. { my $z = mpz(123);
  890.   realloc ($z, 512); }
  892. #------------------------------------------------------------------------------
  893. # GMP::Mpz::remove
  895. {
  896.   my ($rem, $mult);
  897.   ($rem, $mult) = remove(12,3);
  898.   ok ($rem == 4);
  899.   ok ($mult == 1);
  900.   ($rem, $mult) = remove(12,2);
  901.   ok ($rem == 3);
  902.   ok ($mult == 2);
  903. }
  905. #------------------------------------------------------------------------------
  906. # GMP::Mpz::root
  908. ok (root(0,2) == 0);
  909. ok (root(8,3) == 2);
  910. ok (root(-8,3) == -2);
  911. ok (root(81,4) == 3);
  912. ok (root(243,5) == 3);
  914. #------------------------------------------------------------------------------
  915. # GMP::Mpz::roote
  917. { my ($r,$e);
  918.   ($r, $e) = roote(0,2);
  919.   ok ($r == 0);
  920.   ok ($e);
  921.   ($r, $e) = roote(81,4);
  922.   ok ($r == 3);
  923.   ok ($e);
  924.   ($r, $e) = roote(85,4);
  925.   ok ($r == 3);
  926.   ok (! $e);
  927. }
  929. #------------------------------------------------------------------------------
  930. # GMP::Mpz::rootrem
  932. { my ($root, $rem) = rootrem (mpz(0), 1);
  933.   ok ($root == 0); ok ($rem == 0); }
  934. { my ($root, $rem) = rootrem (mpz(0), 2);
  935.   ok ($root == 0); ok ($rem == 0); }
  936. { my ($root, $rem) = rootrem (mpz(64), 2);
  937.   ok ($root == 8); ok ($rem == 0); }
  938. { my ($root, $rem) = rootrem (mpz(64), 3);
  939.   ok ($root == 4); ok ($rem == 0); }
  940. { my ($root, $rem) = rootrem (mpz(65), 3);
  941.   ok ($root == 4); ok ($rem == 1); }
  943. #------------------------------------------------------------------------------
  944. # GMP::Mpz::scan0
  946. ok (scan0 (0, 0) == 0);
  947. ok (scan0 (1, 0) == 1);
  948. ok (scan0 (3, 0) == 2);
  949. ok (scan0 (-1, 0) == ~0);
  950. ok (scan0 (-2, 1) == ~0);
  952. #------------------------------------------------------------------------------
  953. # GMP::Mpz::scan1
  955. ok (scan1 (1, 0) == 0);
  956. ok (scan1 (2, 0) == 1);
  957. ok (scan1 (4, 0) == 2);
  958. ok (scan1 (0, 0) == ~0);
  959. ok (scan1 (3, 2) == ~0);
  961. #------------------------------------------------------------------------------
  962. # GMP::Mpz::setbit
  964. { my $a = mpz(3); setbit ($a, 1); ok ($a == 3); }
  965. { my $a = mpz(3); setbit ($a, 2); ok ($a == 7); }
  967. { my $a = 3; setbit ($a, 1); ok ($a == 3); }
  968. { my $a = 3; setbit ($a, 2); ok ($a == 7); }
  970. # mutate only given variable
  971. { my $a = mpz(0);
  972.   my $b = $a;
  973.   setbit ($a, 0);
  974.   ok ($a == 1);
  975.   ok ($b == 0);
  976. }
  977. { my $a = 0;
  978.   my $b = $a;
  979.   setbit ($a, 0);
  980.   ok ($a == 1);
  981.   ok ($b == 0);
  982. }
  984. { tie my $a, 'Mytie', mpz(3);
  985.   setbit ($a, 2);
  986.   ok ($Mytie::fetched > 0);    # used fetch
  987.   ok ($Mytie::stored > 0);     # used store
  988.   ok ($a == 7);                # expected result
  989.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  990.   ok (tied($a));               # still tied
  991. }
  992. { tie my $a, 'Mytie', 3;
  993.   setbit ($a, 2);
  994.   ok ($Mytie::fetched > 0);    # used fetch
  995.   ok ($Mytie::stored > 0);     # used store
  996.   ok ($a == 7);                # expected result
  997.   ok (UNIVERSAL::isa($a,"GMP::Mpz"));
  998.   ok (tied($a));               # still tied
  999. }
  1001. { my $b = mpz(2);
  1002.   tie my $a, 'Mytie', $b;
  1003.   setbit ($a, 0);
  1004.   ok ($a == 3);
  1005.   ok ($b == 2);
  1006.   ok (tied($a));
  1007. }
  1008. { my $b = 2;
  1009.   tie my $a, 'Mytie', $b;
  1010.   setbit ($a, 0);
  1011.   ok ($a == 3);
  1012.   ok ($b == 2);
  1013.   ok (tied($a));
  1014. }
  1016. #------------------------------------------------------------------------------
  1017. # GMP::Mpz::sizeinbase
  1019. ok (sizeinbase(1,10) == 1);
  1020. ok (sizeinbase(100,10) == 3);
  1021. ok (sizeinbase(9999,10) == 5);
  1023. #------------------------------------------------------------------------------
  1024. # GMP::Mpz::sqrtrem
  1026. {
  1027.   my ($root, $rem) = sqrtrem(mpz(0));
  1028.   ok ($root == 0);
  1029.   ok ($rem == 0);
  1030. }
  1031. {
  1032.   my ($root, $rem) = sqrtrem(mpz(1));
  1033.   ok ($root == 1);
  1034.   ok ($rem == 0);
  1035. }
  1036. {
  1037.   my ($root, $rem) = sqrtrem(mpz(2));
  1038.   ok ($root == 1);
  1039.   ok ($rem == 1);
  1040. }
  1041. {
  1042.   my ($root, $rem) = sqrtrem(mpz(9));
  1043.   ok ($root == 3);
  1044.   ok ($rem == 0);
  1045. }
  1046. {
  1047.   my ($root, $rem) = sqrtrem(mpz(35));
  1048.   ok ($root == 5);
  1049.   ok ($rem == 10);
  1050. }
  1051. {
  1052.   my ($root, $rem) = sqrtrem(mpz(0));
  1053.   ok ($root == 0);
  1054.   ok ($rem == 0);
  1055. }
  1057. #------------------------------------------------------------------------------
  1058. # GMP::Mpz::tdiv
  1060. { my ($q, $r);
  1061.   ($q, $r) = tdiv (16, 3);
  1062.   ok ($q == 5);
  1063.   ok ($r == 1);
  1064.   ($q, $r) = tdiv (16, -3);
  1065.   ok ($q == -5);
  1066.   ok ($r == 1);
  1067.   ($q, $r) = tdiv (-16, 3);
  1068.   ok ($q == -5);
  1069.   ok ($r == -1);
  1070.   ($q, $r) = tdiv (-16, -3);
  1071.   ok ($q == 5);
  1072.   ok ($r == -1);
  1073. }
  1075. #------------------------------------------------------------------------------
  1076. # GMP::Mpz::tdiv_2exp
  1078. { my ($q, $r);
  1079.   ($q, $r) = tdiv_2exp (23, 2);
  1080.   ok ($q == 5);
  1081.   ok ($r == 3);
  1082.   ($q, $r) = tdiv_2exp (-23, 2);
  1083.   ok ($q == -5);
  1084.   ok ($r == -3);
  1085. }
  1087. #------------------------------------------------------------------------------
  1088. # GMP::Mpz::tstbit
  1090. ok (tstbit (6, 0) == 0);
  1091. ok (tstbit (6, 1) == 1);
  1092. ok (tstbit (6, 2) == 1);
  1093. ok (tstbit (6, 3) == 0);
  1098. #------------------------------------------------------------------------------
  1099. # GMP::Mpq
  1101. #------------------------------------------------------------------------------
  1102. # GMP::Mpq::new
  1104. ok (mpq(0) == 0);
  1105. ok (mpq('0') == 0);
  1106. ok (mpq(substr('101',1,1)) == 0);
  1107. ok (mpq(0.0) == 0);
  1108. ok (mpq(mpz(0)) == 0);
  1109. ok (mpq(mpq(0)) == 0);
  1110. ok (mpq(mpf(0)) == 0);
  1112. { tie my $t, 'Mytie', 0; ok (mpq($t) == 0); }
  1113. { tie my $t, 'Mytie', '0'; ok (mpq($t) == 0); }
  1114. { tie my $t, 'Mytie', substr('101',1,1); ok (mpq($t) == 0); }
  1115. { tie my $t, 'Mytie', 0.0; ok (mpq($t) == 0); }
  1116. { tie my $t, 'Mytie', mpz(0); ok (mpq($t) == 0); }
  1117. { tie my $t, 'Mytie', mpq(0); ok (mpq($t) == 0); }
  1118. { tie my $t, 'Mytie', mpf(0); ok (mpq($t) == 0); }
  1120. ok (mpq(-123) == -123);
  1121. ok (mpq('-123') == -123);
  1122. ok (mpq(substr('1-1231',1,4)) == -123);
  1123. ok (mpq(-123.0) == -123);
  1124. ok (mpq(mpz(-123)) == -123);
  1125. ok (mpq(mpq(-123)) == -123);
  1126. ok (mpq(mpf(-123)) == -123);
  1128. { tie my $t, 'Mytie', -123; ok (mpq($t) == -123); }
  1129. { tie my $t, 'Mytie', '-123'; ok (mpq($t) == -123); }
  1130. { tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpq($t) == -123); }
  1131. { tie my $t, 'Mytie', -123.0; ok (mpq($t) == -123); }
  1132. { tie my $t, 'Mytie', mpz(-123); ok (mpq($t) == -123); }
  1133. { tie my $t, 'Mytie', mpq(-123); ok (mpq($t) == -123); }
  1134. { tie my $t, 'Mytie', mpf(-123); ok (mpq($t) == -123); }
  1136. ok (mpq($ivnv_2p128) == $str_2p128);
  1137. { tie my $t, 'Mytie', $ivnv_2p128; ok (mpq($t) == $str_2p128); }
  1139. ok (mpq('3/2') == mpq(3,2));
  1140. ok (mpq('3/1') == mpq(3,1));
  1141. ok (mpq('-3/2') == mpq(-3,2));
  1142. ok (mpq('-3/1') == mpq(-3,1));
  1143. ok (mpq('0x3') == mpq(3,1));
  1144. ok (mpq('0b111') == mpq(7,1));
  1145. ok (mpq('0b0') == mpq(0,1));
  1147. ok (mpq($uv_max) > 0);
  1148. ok (mpq($uv_max) == mpq($uv_max_str));
  1149. { tie my $t, 'Mytie', $uv_max; ok (mpq($t) > 0); }
  1150. { tie my $t, 'Mytie', $uv_max; ok (mpq($t) == mpq($uv_max_str)); }
  1152. { my $x = 123.5;
  1153.   kill (0, $x);
  1154.   ok (mpq($x) == 123.5);
  1155.   tie my $t, 'Mytie', $x;
  1156.   ok (mpq($t) == 123.5);
  1157. }
  1159. #------------------------------------------------------------------------------
  1160. # GMP::Mpq::overload_abs
  1162. ok (abs(mpq(0)) == 0);
  1163. ok (abs(mpq(123)) == 123);
  1164. ok (abs(mpq(-123)) == 123);
  1166. { my $x = mpq(-123); $x = abs($x); ok ($x == 123); }
  1167. { my $x = mpq(0);    $x = abs($x); ok ($x == 0);   }
  1168. { my $x = mpq(123);  $x = abs($x); ok ($x == 123); }
  1170. { tie my $t, 'Mytie', mpq(0); ok (abs($t) == 0); }
  1171. { tie my $t, 'Mytie', mpq(123); ok (abs($t) == 123); }
  1172. { tie my $t, 'Mytie', mpq(-123); ok (abs($t) == 123); }
  1174. #------------------------------------------------------------------------------
  1175. # GMP::Mpq::overload_add
  1177. ok (mpq(0) + 1 == 1);
  1178. ok (mpq(-1) + 1 == 0);
  1179. ok (1 + mpq(0) == 1);
  1180. ok (1 + mpq(-1) == 0);
  1182. ok (mpq(1,2)+mpq(1,3) == mpq(5,6));
  1183. ok (mpq(1,2)+mpq(-1,3) == mpq(1,6));
  1184. ok (mpq(-1,2)+mpq(1,3) == mpq(-1,6));
  1185. ok (mpq(-1,2)+mpq(-1,3) == mpq(-5,6));
  1187. #------------------------------------------------------------------------------
  1188. # GMP::Mpq::overload_addeq
  1190. { my $a = mpq(7); $a += 1; ok ($a == 8); }
  1191. { my $a = mpq(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
  1193. #------------------------------------------------------------------------------
  1194. # GMP::Mpq::overload_bool
  1196. if (mpq(0))   { ok (0); } else { ok (1); }
  1197. if (mpq(123)) { ok (1); } else { ok (0); }
  1199. #------------------------------------------------------------------------------
  1200. # GMP::Mpq::overload_dec
  1202. { my $a = mpq(0); ok ($a-- == 0); ok ($a == -1); }
  1203. { my $a = mpq(0); ok (--$a == -1); }
  1205. { my $a = mpq(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
  1207. #------------------------------------------------------------------------------
  1208. # GMP::Mpq::overload_div
  1210. ok (mpq(6) / 2 == 3);
  1211. ok (mpq(-6) / 2 == -3);
  1212. ok (mpq(6) / -2 == -3);
  1213. ok (mpq(-6) / -2 == 3);
  1215. #------------------------------------------------------------------------------
  1216. # GMP::Mpq::overload_diveq
  1218. { my $a = mpq(21); $a /= 3; ok ($a == 7); }
  1219. { my $a = mpq(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
  1221. #------------------------------------------------------------------------------
  1222. # GMP::Mpq::overload_eq
  1224. { my $a = mpq(0);
  1225.   my $b = $a;
  1226.   $a = mpq(1);
  1227.   ok ($a == 1);
  1228.   ok ($b == 0); }
  1230. #------------------------------------------------------------------------------
  1231. # GMP::Mpq::overload_inc
  1233. { my $a = mpq(0); ok ($a++ == 0); ok ($a == 1); }
  1234. { my $a = mpq(0); ok (++$a == 1); }
  1236. { my $a = mpq(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
  1238. #------------------------------------------------------------------------------
  1239. # GMP::Mpq::overload_lshift
  1241. { my $a = mpq(7) << 1; ok ($a == 14); }
  1243. #------------------------------------------------------------------------------
  1244. # GMP::Mpq::overload_lshifteq
  1246. { my $a = mpq(7); $a <<= 1; ok ($a == 14); }
  1247. { my $a = mpq(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
  1249. #------------------------------------------------------------------------------
  1250. # GMP::Mpq::overload_mul
  1252. ok (mpq(2) * 3 == 6);
  1254. #------------------------------------------------------------------------------
  1255. # GMP::Mpq::overload_muleq
  1257. { my $a = mpq(7); $a *= 3;  ok ($a == 21); }
  1258. { my $a = mpq(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
  1260. #------------------------------------------------------------------------------
  1261. # GMP::Mpq::overload_neg
  1263. ok (- mpq(0) == 0);
  1264. ok (- mpq(123) == -123);
  1265. ok (- mpq(-123) == 123);
  1267. #------------------------------------------------------------------------------
  1268. # GMP::Mpq::overload_not
  1270. if (not mpq(0))   { ok (1); } else { ok (0); }
  1271. if (not mpq(123)) { ok (0); } else { ok (1); }
  1273. ok ((! mpq(0)) == 1);
  1274. ok ((! mpq(123)) == 0);
  1276. #------------------------------------------------------------------------------
  1277. # GMP::Mpq::overload_pow
  1279. ok (mpq(0) ** 1 == 0);
  1280. ok (mpq(1) ** 1 == 1);
  1281. ok (mpq(2) ** 0 == 1);
  1282. ok (mpq(2) ** 1 == 2);
  1283. ok (mpq(2) ** 2 == 4);
  1284. ok (mpq(2) ** 3 == 8);
  1285. ok (mpq(2) ** 4 == 16);
  1287. ok (mpq(0) ** mpq(1) == 0);
  1288. ok (mpq(1) ** mpq(1) == 1);
  1289. ok (mpq(2) ** mpq(0) == 1);
  1290. ok (mpq(2) ** mpq(1) == 2);
  1291. ok (mpq(2) ** mpq(2) == 4);
  1292. ok (mpq(2) ** mpq(3) == 8);
  1293. ok (mpq(2) ** mpq(4) == 16);
  1295. #------------------------------------------------------------------------------
  1296. # GMP::Mpq::overload_poweq
  1298. { my $a = mpq(3); $a **= 4; ok ($a == 81); }
  1299. { my $a = mpq(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
  1301. #------------------------------------------------------------------------------
  1302. # GMP::Mpq::overload_rshift
  1304. { my $a = mpq(32) >> 1; ok ($a == 16); }
  1306. #------------------------------------------------------------------------------
  1307. # GMP::Mpq::overload_rshifteq
  1309. { my $a = mpq(32); $a >>= 1; ok ($a == 16); }
  1310. { my $a = mpq(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
  1312. #------------------------------------------------------------------------------
  1313. # GMP::Mpq::overload_spaceship
  1315. ok (mpq(0) < 1);
  1316. ok (mpq(0) > -1);
  1318. ok (mpq(0) != 1);
  1319. ok (mpq(0) != -1);
  1320. ok (mpq(1) != 0);
  1321. ok (mpq(1) != -1);
  1322. ok (mpq(-1) != 0);
  1323. ok (mpq(-1) != 1);
  1325. ok (mpq(3,2) > 1);
  1326. ok (mpq(3,2) < 2);
  1328. ok (mpq(0) < 1.0);
  1329. ok (mpq(0) < '1');
  1330. ok (mpq(0) < substr('-1',1,1));
  1331. ok (mpq(0) < mpz(1));
  1332. ok (mpq(0) < mpq(1));
  1333. ok (mpq(0) < mpf(1));
  1334. ok (mpq(0) < $uv_max);
  1336. #------------------------------------------------------------------------------
  1337. # GMP::Mpq::overload_string
  1339. { my $x = mpq(0);    ok("$x" eq "0"); }
  1340. { my $x = mpq(123);  ok("$x" eq "123"); }
  1341. { my $x = mpq(-123); ok("$x" eq "-123"); }
  1343. { my $q = mpq(5,7);  ok("$q" eq "5/7"); }
  1344. { my $q = mpq(-5,7); ok("$q" eq "-5/7"); }
  1346. #------------------------------------------------------------------------------
  1347. # GMP::Mpq::overload_sub
  1349. ok (mpq(0) - 1 == -1);
  1350. ok (mpq(1) - 1 == 0);
  1351. ok (1 - mpq(0) == 1);
  1352. ok (1 - mpq(1) == 0);
  1354. ok (mpq(1,2)-mpq(1,3) == mpq(1,6));
  1355. ok (mpq(1,2)-mpq(-1,3) == mpq(5,6));
  1356. ok (mpq(-1,2)-mpq(1,3) == mpq(-5,6));
  1357. ok (mpq(-1,2)-mpq(-1,3) == mpq(-1,6));
  1359. #------------------------------------------------------------------------------
  1360. # GMP::Mpq::overload_subeq
  1362. { my $a = mpq(7); $a -= 1; ok ($a == 6); }
  1363. { my $a = mpq(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
  1365. #------------------------------------------------------------------------------
  1366. # GMP::Mpq::canonicalize
  1368. { my $q = mpq(21,15); canonicalize($q);
  1369.   ok (num($q) == 7);
  1370.   ok (den($q) == 5);
  1371. }
  1373. #------------------------------------------------------------------------------
  1374. # GMP::Mpq::den
  1376. { my $q = mpq(5,9); ok (den($q) == 9); }
  1378. #------------------------------------------------------------------------------
  1379. # GMP::Mpq::num
  1381. { my $q = mpq(5,9); ok (num($q) == 5); }
  1386. #------------------------------------------------------------------------------
  1387. # GMP::Mpf
  1389. #------------------------------------------------------------------------------
  1390. # GMP::Mpf::new
  1392. ok (mpf(0) == 0);
  1393. ok (mpf('0') == 0);
  1394. ok (mpf(substr('101',1,1)) == 0);
  1395. ok (mpf(0.0) == 0);
  1396. ok (mpf(mpz(0)) == 0);
  1397. ok (mpf(mpq(0)) == 0);
  1398. ok (mpf(mpf(0)) == 0);
  1400. { tie my $t, 'Mytie', 0; ok (mpf($t) == 0); }
  1401. { tie my $t, 'Mytie', '0'; ok (mpf($t) == 0); }
  1402. { tie my $t, 'Mytie', substr('101',1,1); ok (mpf($t) == 0); }
  1403. { tie my $t, 'Mytie', 0.0; ok (mpf($t) == 0); }
  1404. { tie my $t, 'Mytie', mpz(0); ok (mpf($t) == 0); }
  1405. { tie my $t, 'Mytie', mpq(0); ok (mpf($t) == 0); }
  1406. { tie my $t, 'Mytie', mpf(0); ok (mpf($t) == 0); }
  1408. ok (mpf(-123) == -123);
  1409. ok (mpf('-123') == -123);
  1410. ok (mpf(substr('1-1231',1,4)) == -123);
  1411. ok (mpf(-123.0) == -123);
  1412. ok (mpf(mpz(-123)) == -123);
  1413. ok (mpf(mpq(-123)) == -123);
  1414. ok (mpf(mpf(-123)) == -123);
  1416. { tie my $t, 'Mytie', -123; ok (mpf($t) == -123); }
  1417. { tie my $t, 'Mytie', '-123'; ok (mpf($t) == -123); }
  1418. { tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpf($t) == -123); }
  1419. { tie my $t, 'Mytie', -123.0; ok (mpf($t) == -123); }
  1420. { tie my $t, 'Mytie', mpz(-123); ok (mpf($t) == -123); }
  1421. { tie my $t, 'Mytie', mpq(-123); ok (mpf($t) == -123); }
  1422. { tie my $t, 'Mytie', mpf(-123); ok (mpf($t) == -123); }
  1424. ok (mpf($ivnv_2p128) == $str_2p128);
  1425. { tie my $t, 'Mytie', $ivnv_2p128; ok (mpf($t) == $str_2p128); }
  1427. ok (mpf(-1.5) == -1.5);
  1428. ok (mpf(-1.0) == -1.0);
  1429. ok (mpf(-0.5) == -0.5);
  1430. ok (mpf(0) == 0);
  1431. ok (mpf(0.5) == 0.5);
  1432. ok (mpf(1.0) == 1.0);
  1433. ok (mpf(1.5) == 1.5);
  1435. ok (mpf("-1.5") == -1.5);
  1436. ok (mpf("-1.0") == -1.0);
  1437. ok (mpf("-0.5") == -0.5);
  1438. ok (mpf("0") == 0);
  1439. ok (mpf("0.5") == 0.5);
  1440. ok (mpf("1.0") == 1.0);
  1441. ok (mpf("1.5") == 1.5);
  1443. ok (mpf($uv_max) > 0);
  1444. ok (mpf($uv_max) == mpf($uv_max_str));
  1445. { tie my $t, 'Mytie', $uv_max; ok (mpf($t) > 0); }
  1446. { tie my $t, 'Mytie', $uv_max; ok (mpf($t) == mpf($uv_max_str)); }
  1448. { my $x = 123.5;
  1449.   kill (0, $x);
  1450.   ok (mpf($x) == 123.5);
  1451.   tie my $t, 'Mytie', $x;
  1452.   ok (mpf($t) == 123.5);
  1453. }
  1455. #------------------------------------------------------------------------------
  1456. # GMP::Mpf::overload_abs
  1458. ok (abs(mpf(0)) == 0);
  1459. ok (abs(mpf(123)) == 123);
  1460. ok (abs(mpf(-123)) == 123);
  1462. { my $x = mpf(-123); $x = abs($x); ok ($x == 123); }
  1463. { my $x = mpf(0);    $x = abs($x); ok ($x == 0);   }
  1464. { my $x = mpf(123);  $x = abs($x); ok ($x == 123); }
  1466. { tie my $t, 'Mytie', mpf(0); ok (abs($t) == 0); }
  1467. { tie my $t, 'Mytie', mpf(123); ok (abs($t) == 123); }
  1468. { tie my $t, 'Mytie', mpf(-123); ok (abs($t) == 123); }
  1470. #------------------------------------------------------------------------------
  1471. # GMP::Mpf::overload_add
  1473. ok (mpf(0) + 1 == 1);
  1474. ok (mpf(-1) + 1 == 0);
  1475. ok (1 + mpf(0) == 1);
  1476. ok (1 + mpf(-1) == 0);
  1478. #------------------------------------------------------------------------------
  1479. # GMP::Mpf::overload_addeq
  1481. { my $a = mpf(7); $a += 1; ok ($a == 8); }
  1482. { my $a = mpf(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
  1484. #------------------------------------------------------------------------------
  1485. # GMP::Mpf::overload_bool
  1487. if (mpf(0))   { ok (0); } else { ok (1); }
  1488. if (mpf(123)) { ok (1); } else { ok (0); }
  1490. #------------------------------------------------------------------------------
  1491. # GMP::Mpf::overload_dec
  1493. { my $a = mpf(0); ok ($a-- == 0); ok ($a == -1); }
  1494. { my $a = mpf(0); ok (--$a == -1); }
  1496. { my $a = mpf(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
  1498. #------------------------------------------------------------------------------
  1499. # GMP::Mpf::overload_div
  1501. ok (mpf(6) / 2 == 3);
  1502. ok (mpf(-6) / 2 == -3);
  1503. ok (mpf(6) / -2 == -3);
  1504. ok (mpf(-6) / -2 == 3);
  1506. #------------------------------------------------------------------------------
  1507. # GMP::Mpf::overload_diveq
  1509. { my $a = mpf(21); $a /= 3; ok ($a == 7); }
  1510. { my $a = mpf(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
  1512. #------------------------------------------------------------------------------
  1513. # GMP::Mpf::overload_eq
  1515. { my $a = mpf(0);
  1516.   my $b = $a;
  1517.   $a = mpf(1);
  1518.   ok ($a == 1);
  1519.   ok ($b == 0); }
  1521. #------------------------------------------------------------------------------
  1522. # GMP::Mpf::overload_inc
  1524. { my $a = mpf(0); ok ($a++ == 0); ok ($a == 1); }
  1525. { my $a = mpf(0); ok (++$a == 1); }
  1527. { my $a = mpf(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
  1529. #------------------------------------------------------------------------------
  1530. # GMP::Mpf::overload_lshift
  1532. { my $a = mpf(7) << 1; ok ($a == 14); }
  1534. #------------------------------------------------------------------------------
  1535. # GMP::Mpf::overload_lshifteq
  1537. { my $a = mpf(7); $a <<= 1; ok ($a == 14); }
  1538. { my $a = mpf(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
  1540. #------------------------------------------------------------------------------
  1541. # GMP::Mpf::overload_mul
  1543. ok (mpf(2) * 3 == 6);
  1545. #------------------------------------------------------------------------------
  1546. # GMP::Mpf::overload_muleq
  1548. { my $a = mpf(7); $a *= 3;  ok ($a == 21); }
  1549. { my $a = mpf(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
  1551. #------------------------------------------------------------------------------
  1552. # GMP::Mpf::overload_neg
  1554. ok (- mpf(0) == 0);
  1555. ok (- mpf(123) == -123);
  1556. ok (- mpf(-123) == 123);
  1558. #------------------------------------------------------------------------------
  1559. # GMP::Mpf::overload_not
  1561. if (not mpf(0))   { ok (1); } else { ok (0); }
  1562. if (not mpf(123)) { ok (0); } else { ok (1); }
  1564. ok ((! mpf(0)) == 1);
  1565. ok ((! mpf(123)) == 0);
  1567. #------------------------------------------------------------------------------
  1568. # GMP::Mpf::overload_pow
  1570. ok (mpf(0) ** 1 == 0);
  1571. ok (mpf(1) ** 1 == 1);
  1572. ok (mpf(2) ** 0 == 1);
  1573. ok (mpf(2) ** 1 == 2);
  1574. ok (mpf(2) ** 2 == 4);
  1575. ok (mpf(2) ** 3 == 8);
  1576. ok (mpf(2) ** 4 == 16);
  1578. ok (mpf(0) ** mpf(1) == 0);
  1579. ok (mpf(1) ** mpf(1) == 1);
  1580. ok (mpf(2) ** mpf(0) == 1);
  1581. ok (mpf(2) ** mpf(1) == 2);
  1582. ok (mpf(2) ** mpf(2) == 4);
  1583. ok (mpf(2) ** mpf(3) == 8);
  1584. ok (mpf(2) ** mpf(4) == 16);
  1586. #------------------------------------------------------------------------------
  1587. # GMP::Mpf::overload_poweq
  1589. { my $a = mpf(3); $a **= 4; ok ($a == 81); }
  1590. { my $a = mpf(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
  1592. #------------------------------------------------------------------------------
  1593. # GMP::Mpf::overload_rshift
  1595. { my $a = mpf(32) >> 1; ok ($a == 16); }
  1597. #------------------------------------------------------------------------------
  1598. # GMP::Mpf::overload_rshifteq
  1600. { my $a = mpf(32); $a >>= 1; ok ($a == 16); }
  1601. { my $a = mpf(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
  1603. #------------------------------------------------------------------------------
  1604. # GMP::Mpf::overload_sqrt
  1606. ok (sqrt(mpf(0)) == 0);
  1607. ok (sqrt(mpf(1)) == 1);
  1608. ok (sqrt(mpf(4)) == 2);
  1609. ok (sqrt(mpf(81)) == 9);
  1611. ok (sqrt(mpf(0.25)) == 0.5);
  1613. #------------------------------------------------------------------------------
  1614. # GMP::Mpf::overload_spaceship
  1616. ok (mpf(0) < 1);
  1617. ok (mpf(0) > -1);
  1619. ok (mpf(0) != 1);
  1620. ok (mpf(0) != -1);
  1621. ok (mpf(1) != 0);
  1622. ok (mpf(1) != -1);
  1623. ok (mpf(-1) != 0);
  1624. ok (mpf(-1) != 1);
  1626. ok (mpf(0) < 1.0);
  1627. ok (mpf(0) < '1');
  1628. ok (mpf(0) < substr('-1',1,1));
  1629. ok (mpf(0) < mpz(1));
  1630. ok (mpf(0) < mpq(1));
  1631. ok (mpf(0) < mpf(1));
  1632. ok (mpf(0) < $uv_max);
  1634. #------------------------------------------------------------------------------
  1635. # GMP::Mpf::overload_string
  1637. { my $x = mpf(0);    ok ("$x" eq "0"); }
  1638. { my $x = mpf(123);  ok ("$x" eq "123"); }
  1639. { my $x = mpf(-123); ok ("$x" eq "-123"); }
  1641. { my $f = mpf(0.25);     ok ("$f" eq "0.25"); }
  1642. { my $f = mpf(-0.25);    ok ("$f" eq "-0.25"); }
  1643. { my $f = mpf(1.25);     ok ("$f" eq "1.25"); }
  1644. { my $f = mpf(-1.25);    ok ("$f" eq "-1.25"); }
  1645. { my $f = mpf(1000000);  ok ("$f" eq "1000000"); }
  1646. { my $f = mpf(-1000000); ok ("$f" eq "-1000000"); }
  1648. #------------------------------------------------------------------------------
  1649. # GMP::Mpf::overload_sub
  1651. ok (mpf(0) - 1 == -1);
  1652. ok (mpf(1) - 1 == 0);
  1653. ok (1 - mpf(0) == 1);
  1654. ok (1 - mpf(1) == 0);
  1656. #------------------------------------------------------------------------------
  1657. # GMP::Mpf::overload_subeq
  1659. { my $a = mpf(7); $a -= 1; ok ($a == 6); }
  1660. { my $a = mpf(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
  1663. #------------------------------------------------------------------------------
  1664. # GMP::Mpf::ceil
  1666. ok (ceil (mpf(-7.5)) == -7.0);
  1667. ok (ceil (mpf(7.5)) == 8.0);
  1669. #------------------------------------------------------------------------------
  1670. # GMP::Mpf::floor
  1672. ok (floor(mpf(-7.5)) == -8.0);
  1673. ok (floor(mpf(7.5)) == 7.0);
  1675. #------------------------------------------------------------------------------
  1676. # GMP::Mpf::mpf_eq
  1678. { my $old_prec = get_default_prec();
  1679.   set_default_prec(128);
  1681.   ok (  mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1));
  1682.   ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128));
  1684.   set_default_prec($old_prec);
  1685. }
  1687. #------------------------------------------------------------------------------
  1688. # GMP::Mpf::get_default_prec
  1690. get_default_prec();
  1692. #------------------------------------------------------------------------------
  1693. # GMP::Mpf::get_prec
  1695. { my $x = mpf(1.0, 512);
  1696.   ok (get_prec ($x) == 512);
  1697. }
  1699. #------------------------------------------------------------------------------
  1700. # GMP::Mpf::reldiff
  1702. ok (reldiff (2,4) == 1);
  1703. ok (reldiff (4,2) == 0.5);
  1705. #------------------------------------------------------------------------------
  1706. # GMP::Mpf::set_default_prec
  1708. { my $old_prec = get_default_prec();
  1710.   set_default_prec(512);
  1711.   ok (get_default_prec () == 512);
  1713.   set_default_prec($old_prec);
  1714. }
  1716. #------------------------------------------------------------------------------
  1717. # GMP::Mpf::set_prec
  1719. { my $x = mpf(1.0, 512);
  1720.   my $y = $x;
  1721.   set_prec ($x, 1024);
  1722.   ok (get_prec ($x) == 1024);
  1723.   ok (get_prec ($y) == 512);
  1724. }
  1726. #------------------------------------------------------------------------------
  1727. # GMP::Mpf::trunc
  1729. ok (trunc(mpf(-7.5)) == -7.0);
  1730. ok (trunc(mpf(7.5)) == 7.0);
  1734. #------------------------------------------------------------------------------
  1735. # GMP::Rand
  1737. #------------------------------------------------------------------------------
  1738. # GMP::Rand::new
  1740. { my $r = randstate();                          ok (defined $r); }
  1741. { my $r = randstate('lc_2exp', 1, 2, 3);        ok (defined $r); }
  1742. { my $r = randstate('lc_2exp_size', 64);        ok (defined $r); }
  1743. { my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); }
  1744. { my $r = randstate('mt');                      ok (defined $r); }
  1746. { # copying a randstate results in same sequence
  1747.   my $r1 = randstate('lc_2exp_size', 64);
  1748.   $r1->seed(123);
  1749.   my $r2 = randstate($r1);
  1750.   for (1 .. 20) {
  1751.     my $z1 = mpz_urandomb($r1, 20);
  1752.     my $z2 = mpz_urandomb($r2, 20);
  1753.     ok ($z1 == $z2);
  1754.   }
  1755. }
  1757. #------------------------------------------------------------------------------
  1758. # GMP::Rand::seed
  1760. { my $r = randstate();
  1761.   $r->seed(123);
  1762.   $r->seed(time());
  1763. }
  1765. #------------------------------------------------------------------------------
  1766. # GMP::Rand::mpf_urandomb
  1768. { my $r = randstate();
  1769.   my $f = mpf_urandomb($r,1024);
  1770.   ok (UNIVERSAL::isa($f,"GMP::Mpf")); }
  1772. #------------------------------------------------------------------------------
  1773. # GMP::Rand::mpz_urandomb
  1775. { my $r = randstate();
  1776.   my $z = mpz_urandomb($r, 1024);
  1777.   ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
  1779. #------------------------------------------------------------------------------
  1780. # GMP::Rand::mpz_rrandomb
  1782. { my $r = randstate();
  1783.   my $z = mpz_rrandomb($r, 1024);
  1784.   ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
  1786. #------------------------------------------------------------------------------
  1787. # GMP::Rand::mpz_urandomm
  1789. { my $r = randstate();
  1790.   my $z = mpz_urandomm($r, mpz(3)**100);
  1791.   ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
  1793. #------------------------------------------------------------------------------
  1794. # GMP::Rand::mpz_urandomb_ui
  1796. { my $r = randstate();
  1797.   foreach (1 .. 20) {
  1798.     my $u = gmp_urandomb_ui($r,8);
  1799.     ok ($u >= 0);
  1800.     ok ($u < 256);
  1801.   }
  1802. }
  1804. #------------------------------------------------------------------------------
  1805. # GMP::Rand::mpz_urandomm_ui
  1807. { my $r = randstate();
  1808.   foreach (1 .. 20) {
  1809.     my $u = gmp_urandomm_ui($r,8);
  1810.     ok ($u >= 0);
  1811.     ok ($u < 8);
  1812.   }
  1813. }
  1818. #------------------------------------------------------------------------------
  1819. # GMP module
  1821. #------------------------------------------------------------------------------
  1822. # GMP::fits_slong_p
  1824. ok (GMP::fits_slong_p(0));
  1826. # in perl 5.005 uv_max is only 32-bits on a 64-bit system, so won't exceed a
  1827. # long
  1828. # ok (! GMP::fits_slong_p($uv_max));
  1830. ok (GMP::fits_slong_p(0.0));
  1832. ok (GMP::fits_slong_p('0'));
  1834. ok (GMP::fits_slong_p(substr('999999999999999999999999999999',1,1)));
  1836. ok (! mpz("-9999999999999999999999999999999999999999999")->fits_slong_p());
  1837. ok (  mpz(-123)->fits_slong_p());
  1838. ok (  mpz(0)->fits_slong_p());
  1839. ok (  mpz(123)->fits_slong_p());
  1840. ok (! mpz("9999999999999999999999999999999999999999999")->fits_slong_p());
  1842. ok (! mpq("-9999999999999999999999999999999999999999999")->fits_slong_p());
  1843. ok (  mpq(-123)->fits_slong_p());
  1844. ok (  mpq(0)->fits_slong_p());
  1845. ok (  mpq(123)->fits_slong_p());
  1846. ok (! mpq("9999999999999999999999999999999999999999999")->fits_slong_p());
  1848. ok (! mpf("-9999999999999999999999999999999999999999999")->fits_slong_p());
  1849. ok (  mpf(-123)->fits_slong_p());
  1850. ok (  mpf(0)->fits_slong_p());
  1851. ok (  mpf(123)->fits_slong_p());
  1852. ok (! mpf("9999999999999999999999999999999999999999999")->fits_slong_p());
  1854. #------------------------------------------------------------------------------
  1855. # GMP::get_d
  1857. ok (GMP::get_d(123) == 123.0);
  1859. ok (GMP::get_d($uv_max) > 0);
  1861. ok (GMP::get_d(123.0) == 123.0);
  1863. ok (GMP::get_d('123') == 123.0);
  1865. ok (GMP::get_d(mpz(123)) == 123.0);
  1867. ok (GMP::get_d(mpq(123)) == 123.0);
  1869. ok (GMP::get_d(mpf(123)) == 123.0);
  1871. #------------------------------------------------------------------------------
  1872. # GMP::get_d_2exp
  1874. { my ($dbl, $exp) = get_d_2exp (0);
  1875.   ok ($dbl == 0); ok ($exp == 0); }
  1876. { my ($dbl, $exp) = get_d_2exp (1);
  1877.   ok ($dbl == 0.5); ok ($exp == 1); }
  1879. { my ($dbl, $exp) = get_d_2exp ($uv_max);
  1880.   ok ($dbl > 0.0); ok ($exp > 0); }
  1882. { my ($dbl, $exp) = get_d_2exp (0.5);
  1883.   ok ($dbl == 0.5); ok ($exp == 0); }
  1884. { my ($dbl, $exp) = get_d_2exp (0.25);
  1885.   ok ($dbl == 0.5); ok ($exp == -1); }
  1887. { my ($dbl, $exp) = get_d_2exp ("1.0");
  1888.   ok ($dbl == 0.5); ok ($exp == 1); }
  1890. { my ($dbl, $exp) = get_d_2exp (mpz ("256"));
  1891.   ok ($dbl == 0.5); ok ($exp == 9); }
  1893. { my ($dbl, $exp) = get_d_2exp (mpq ("1/16"));
  1894.   ok ($dbl == 0.5); ok ($exp == -3); }
  1896. { my ($dbl, $exp) = get_d_2exp (mpf ("1.5"));
  1897.   ok ($dbl == 0.75); ok ($exp == 1); }
  1898. { my ($dbl, $exp) = get_d_2exp (mpf ("3.0"));
  1899.   ok ($dbl == 0.75); ok ($exp == 2); }
  1901. #------------------------------------------------------------------------------
  1902. # GMP::get_str
  1904. ok (get_str(-123) eq '-123');
  1905. ok (get_str('-123') eq '-123');
  1906. ok (get_str(substr('x-123x',1,4)) eq '-123');
  1907. ok (get_str(mpz(-123)) eq '-123');
  1908. ok (get_str(mpq(-123)) eq '-123');
  1910. ok (get_str(-123,10) eq '-123');
  1911. ok (get_str('-123',10) eq '-123');
  1912. ok (get_str(substr('x-123x',1,4),10) eq '-123');
  1913. ok (get_str(mpz(-123),10) eq '-123');
  1914. ok (get_str(mpq(-123),10) eq '-123');
  1916. ok (get_str(-123,16) eq '-7b');
  1917. ok (get_str('-123',16) eq '-7b');
  1918. ok (get_str(substr('x-123x',1,4),16) eq '-7b');
  1919. ok (get_str(mpz(-123),16) eq '-7b');
  1920. ok (get_str(mpq(-123),16) eq '-7b');
  1922. ok (get_str(-123,-16) eq '-7B');
  1923. ok (get_str('-123',-16) eq '-7B');
  1924. ok (get_str(substr('x-123x',1,4),-16) eq '-7B');
  1925. ok (get_str(mpz(-123),-16) eq '-7B');
  1926. ok (get_str(mpq(-123),-16) eq '-7B');
  1928. # is a float in past versions of perl without UV type
  1929. { my ($str, $exp) = get_str($uv_max);
  1930.   ok ($str eq $uv_max_str); }
  1932. ok (get_str(mpq(5/8)) eq "5/8");
  1933. ok (get_str(mpq(-5/8)) eq "-5/8");
  1934. ok (get_str(mpq(255/256),16) eq "ff/100");
  1935. ok (get_str(mpq(255/256),-16) eq "FF/100");
  1936. ok (get_str(mpq(-255/256),16) eq "-ff/100");
  1937. ok (get_str(mpq(-255/256),-16) eq "-FF/100");
  1939. { my ($s,$e) = get_str(1.5, 10);      ok ($s eq '15'); ok ($e == 1); }
  1940. { my ($s,$e) = get_str(mpf(1.5), 10); ok ($s eq '15'); ok ($e == 1); }
  1942. { my ($s,$e) = get_str(-1.5, 10);      ok ($s eq '-15'); ok ($e == 1); }
  1943. { my ($s,$e) = get_str(mpf(-1.5), 10); ok ($s eq '-15'); ok ($e == 1); }
  1945. { my ($s,$e) = get_str(1.5, 16);      ok ($s eq '18'); ok ($e == 1); }
  1946. { my ($s,$e) = get_str(mpf(1.5), 16); ok ($s eq '18'); ok ($e == 1); }
  1948. { my ($s,$e) = get_str(-1.5, 16);      ok ($s eq '-18'); ok ($e == 1); }
  1949. { my ($s,$e) = get_str(mpf(-1.5), 16); ok ($s eq '-18'); ok ($e == 1); }
  1951. { my ($s,$e) = get_str(65536.0, 16);      ok ($s eq '1'); ok ($e == 5); }
  1952. { my ($s,$e) = get_str(mpf(65536.0), 16); ok ($s eq '1'); ok ($e == 5); }
  1954. { my ($s,$e) = get_str(1.625, 16);      ok ($s eq '1a'); ok ($e == 1); }
  1955. { my ($s,$e) = get_str(mpf(1.625), 16); ok ($s eq '1a'); ok ($e == 1); }
  1957. { my ($s,$e) = get_str(1.625, -16);      ok ($s eq '1A'); ok ($e == 1); }
  1958. { my ($s,$e) = get_str(mpf(1.625), -16); ok ($s eq '1A'); ok ($e == 1); }
  1960. { my ($s, $e) = get_str(255.0,16,0);      ok ($s eq "ff"); ok ($e == 2); }
  1961. { my ($s, $e) = get_str(mpf(255.0),16,0); ok ($s eq "ff"); ok ($e == 2); }
  1963. { my ($s, $e) = get_str(255.0,-16,0);      ok ($s eq "FF"); ok ($e == 2); }
  1964. { my ($s, $e) = get_str(mpf(255.0),-16,0); ok ($s eq "FF"); ok ($e == 2); }
  1966. #------------------------------------------------------------------------------
  1967. # GMP::get_si
  1969. ok (GMP::get_si(123) == 123.0);
  1971. # better not assume anything about the relatives sizes of long and UV
  1972. ok (GMP::get_si($uv_max) != 0);
  1974. ok (GMP::get_si(123.0) == 123.0);
  1976. ok (GMP::get_si('123') == 123.0);
  1978. ok (GMP::get_si(mpz(123)) == 123.0);
  1980. ok (GMP::get_si(mpq(123)) == 123.0);
  1982. ok (GMP::get_si(mpf(123)) == 123.0);
  1984. #------------------------------------------------------------------------------
  1985. # GMP::integer_p
  1987. ok (  GMP::integer_p (0));
  1988. ok (  GMP::integer_p (123));
  1989. ok (  GMP::integer_p (-123));
  1991. ok (  GMP::integer_p ($uv_max));
  1993. ok (  GMP::integer_p (0.0));
  1994. ok (  GMP::integer_p (123.0));
  1995. ok (  GMP::integer_p (-123.0));
  1996. ok (! GMP::integer_p (0.5));
  1997. ok (! GMP::integer_p (123.5));
  1998. ok (! GMP::integer_p (-123.5));
  2000. ok (  GMP::integer_p ('0'));
  2001. ok (  GMP::integer_p ('123'));
  2002. ok (  GMP::integer_p ('-123'));
  2003. ok (! GMP::integer_p ('0.5'));
  2004. ok (! GMP::integer_p ('123.5'));
  2005. ok (! GMP::integer_p ('-123.5'));
  2006. ok (! GMP::integer_p ('5/8'));
  2008. ok (  GMP::integer_p (mpz(1)));
  2010. ok (  GMP::integer_p (mpq(1)));
  2011. ok (! GMP::integer_p (mpq(1,2)));
  2013. ok (  GMP::integer_p (mpf(1.0)));
  2014. ok (! GMP::integer_p (mpf(1.5)));
  2016. #------------------------------------------------------------------------------
  2017. # GMP::odd_p
  2019. ok (! odd_p(0));
  2020. ok (  odd_p(1));
  2021. ok (! odd_p(2));
  2023. ok (  odd_p($uv_max));
  2025. ok (  odd_p(mpz(-3)));
  2026. ok (! odd_p(mpz(-2)));
  2027. ok (  odd_p(mpz(-1)));
  2028. ok (! odd_p(mpz(0)));
  2029. ok (  odd_p(mpz(1)));
  2030. ok (! odd_p(mpz(2)));
  2031. ok (  odd_p(mpz(3)));
  2033. #------------------------------------------------------------------------------
  2034. # GMP::printf
  2036. GMP::printf ("hello worldn");
  2038. sub via_printf {
  2039.   my $s;
  2040.   open TEMP, ">test.tmp" or die;
  2041.   GMP::printf TEMP @_;
  2042.   close TEMP or die;
  2043.   open TEMP, "<test.tmp" or die;
  2044.   read (TEMP, $s, 1024);
  2045.   close TEMP or die;
  2046.   unlink 'test.tmp';
  2047.   return $s;
  2048. }
  2050. ok (sprintf ("%d", mpz(123)) eq '123');
  2051. ok (sprintf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
  2052. ok (sprintf ("%d", mpq(15,16)) eq '15/16');
  2053. ok (sprintf ("%f", mpf(1.5)) eq '1.500000');
  2054. ok (sprintf ("%.2f", mpf(1.5)) eq '1.50');
  2056. ok (sprintf ("%*d", 6, 123) eq '   123');
  2057. ok (sprintf ("%*d", 6, mpz(123))  eq '   123');
  2058. ok (sprintf ("%*d", 6, mpq(15,16))  eq ' 15/16');
  2060. ok (sprintf ("%x", 123) eq '7b');
  2061. ok (sprintf ("%x", mpz(123))  eq '7b');
  2062. ok (sprintf ("%X", 123) eq '7B');
  2063. ok (sprintf ("%X", mpz(123))  eq '7B');
  2064. ok (sprintf ("%#x", 123) eq '0x7b');
  2065. ok (sprintf ("%#x", mpz(123))  eq '0x7b');
  2066. ok (sprintf ("%#X", 123) eq '0X7B');
  2067. ok (sprintf ("%#X", mpz(123))  eq '0X7B');
  2069. ok (sprintf ("%x", mpq(15,16))  eq 'f/10');
  2070. ok (sprintf ("%X", mpq(15,16))  eq 'F/10');
  2071. ok (sprintf ("%#x", mpq(15,16))  eq '0xf/0x10');
  2072. ok (sprintf ("%#X", mpq(15,16))  eq '0XF/0X10');
  2074. ok (sprintf ("%*.*f", 10, 3, 1.25) eq '     1.250');
  2075. ok (sprintf ("%*.*f", 10, 3, mpf(1.5))   eq '     1.500');
  2077. ok (via_printf ("%d", mpz(123)) eq '123');
  2078. ok (via_printf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
  2079. ok (via_printf ("%d", mpq(15,16)) eq '15/16');
  2080. ok (via_printf ("%f", mpf(1.5)) eq '1.500000');
  2081. ok (via_printf ("%.2f", mpf(1.5)) eq '1.50');
  2083. ok (via_printf ("%*d", 6, 123) eq '   123');
  2084. ok (via_printf ("%*d", 6, mpz(123))  eq '   123');
  2085. ok (via_printf ("%*d", 6, mpq(15,16))  eq ' 15/16');
  2087. ok (via_printf ("%x", 123) eq '7b');
  2088. ok (via_printf ("%x", mpz(123))  eq '7b');
  2089. ok (via_printf ("%X", 123) eq '7B');
  2090. ok (via_printf ("%X", mpz(123))  eq '7B');
  2091. ok (via_printf ("%#x", 123) eq '0x7b');
  2092. ok (via_printf ("%#x", mpz(123))  eq '0x7b');
  2093. ok (via_printf ("%#X", 123) eq '0X7B');
  2094. ok (via_printf ("%#X", mpz(123))  eq '0X7B');
  2096. ok (via_printf ("%x", mpq(15,16))  eq 'f/10');
  2097. ok (via_printf ("%X", mpq(15,16))  eq 'F/10');
  2098. ok (via_printf ("%#x", mpq(15,16))  eq '0xf/0x10');
  2099. ok (via_printf ("%#X", mpq(15,16))  eq '0XF/0X10');
  2101. ok (via_printf ("%*.*f", 10, 3, 1.25) eq '     1.250');
  2102. ok (via_printf ("%*.*f", 10, 3, mpf(1.5))   eq '     1.500');
  2104. #------------------------------------------------------------------------------
  2105. # GMP::sgn
  2107. ok (sgn(-123) == -1);
  2108. ok (sgn(0)    == 0);
  2109. ok (sgn(123)  == 1);
  2111. ok (sgn($uv_max) == 1);
  2113. ok (sgn(-123.0) == -1);
  2114. ok (sgn(0.0)    == 0);
  2115. ok (sgn(123.0)  == 1);
  2117. ok (sgn('-123') == -1);
  2118. ok (sgn('0')    == 0);
  2119. ok (sgn('123')  == 1);
  2120. ok (sgn('-123.0') == -1);
  2121. ok (sgn('0.0')    == 0);
  2122. ok (sgn('123.0')  == 1);
  2124. ok (sgn(substr('x-123x',1,4)) == -1);
  2125. ok (sgn(substr('x0x',1,1))    == 0);
  2126. ok (sgn(substr('x123x',1,3))  == 1);
  2128. ok (mpz(-123)->sgn() == -1);
  2129. ok (mpz(0)   ->sgn() == 0);
  2130. ok (mpz(123) ->sgn() == 1);
  2132. ok (mpq(-123)->sgn() == -1);
  2133. ok (mpq(0)   ->sgn() == 0);
  2134. ok (mpq(123) ->sgn() == 1);
  2136. ok (mpf(-123)->sgn() == -1);
  2137. ok (mpf(0)   ->sgn() == 0);
  2138. ok (mpf(123) ->sgn() == 1);
  2142. #------------------------------------------------------------------------------
  2143. # overloaded constants
  2145. if ($] > 5.00503) {
  2146.   if (! do 'test2.pl') {
  2147.     die "Cannot run test2.pln";
  2148.   }
  2149. }
  2154. #------------------------------------------------------------------------------
  2155. # $# stuff
  2156. #
  2157. # For some reason "local $#" doesn't leave $# back at its default undefined
  2158. # state when exiting the block.
  2160. { local $# = 'hi %.0f there';
  2161.   my $f = mpf(123);
  2162.   ok ("$f" eq 'hi 123 there'); }
  2166. # Local variables:
  2167. # perl-indent-level: 2
  2168. # End: