CoCalc -- test.pl

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Path: gap4r8 / extern / gmp-6.0.0a / demos / perl / test.pl
Views: ⁴¹⁸³⁴⁶
1
#!/usr/bin/perl -w
2

3
# GMP perl module tests
4

5
# Copyright 2001-2003 Free Software Foundation, Inc.
6
#
7
#  This file is part of the GNU MP Library.
8
#
9
#  The GNU MP Library is free software; you can redistribute it and/or modify
10
#  it under the terms of either:
11
#
12
#    * the GNU Lesser General Public License as published by the Free
13
#      Software Foundation; either version 3 of the License, or (at your
14
#      option) any later version.
15
#
16
#  or
17
#
18
#    * the GNU General Public License as published by the Free Software
19
#      Foundation; either version 2 of the License, or (at your option) any
20
#      later version.
21
#
22
#  or both in parallel, as here.
23
#
24
#  The GNU MP Library is distributed in the hope that it will be useful, but
25
#  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
26
#  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
27
#  for more details.
28
#
29
#  You should have received copies of the GNU General Public License and the
30
#  GNU Lesser General Public License along with the GNU MP Library.  If not,
31
#  see https://www.gnu.org/licenses/.
32

33

34
# These tests aim to exercise the many possible combinations of operands
35
# etc, and to run all functions at least once, which if nothing else will
36
# check everything intended is in the :all list.
37
#
38
# Use the following in .emacs to match test failure messages.
39
#
40
# ;; perl "Test" module error messages
41
# (eval-after-load "compile"
42
#   '(add-to-list
43
#     'compilation-error-regexp-alist
44
#     '("^.*Failed test [0-9]+ in \\([^ ]+\\) at line \\([0-9]+\\)" 1 2)))
45

46

47
use strict;
48
use Test;
49

50
BEGIN {
51
  plan tests => 123,
52
  onfail => sub { print "there were failures\n" },
53
}
54

55
use GMP qw(:all);
56
use GMP::Mpz qw(:all);
57
use GMP::Mpq qw(:all);
58
use GMP::Mpf qw(:all);
59
use GMP::Rand qw(:all);
60

61
use GMP::Mpz qw(:constants);
62
use GMP::Mpz qw(:noconstants);
63
use GMP::Mpq qw(:constants);
64
use GMP::Mpq qw(:noconstants);
65
use GMP::Mpf qw(:constants);
66
use GMP::Mpf qw(:noconstants);
67

68
package Mytie;
69
use Exporter;
70
use vars  qw($val $fetched $stored);
71
$val = 0;
72
$fetched = 0;
73
$stored = 0;
74
sub TIESCALAR {
75
  my ($class, $newval) = @_;
76
  my $var = 'mytie dummy refed var';
77
  $val = $newval;
78
  $fetched = 0;
79
  $stored = 0;
80
  return bless \$var, $class;
81
}
82
sub FETCH {
83
  my ($self) = @_;
84
  $fetched++;
85
  return $val;
86
}
87
sub STORE {
88
  my ($self, $newval) = @_;
89
  $val = $newval;
90
  $stored++;
91
}
92
package main;
93

94
# check Mytie does what it should
95
{ tie my $t, 'Mytie', 123;
96
  ok ($Mytie::val == 123);
97
  $Mytie::val = 456;
98
  ok ($t == 456);
99
  $t = 789;
100
  ok ($Mytie::val == 789);
101
}
102

103

104
# Usage: str(x)
105
# Return x forced to a string, not a PVIV.
106
#
107
sub str {
108
  my $s = "$_[0]" . "";
109
  return $s;
110
}
111

112
my $ivnv_2p128 = 65536.0 * 65536.0 * 65536.0 * 65536.0
113
               * 65536.0 * 65536.0 * 65536.0 * 65536.0;
114
kill (0, $ivnv_2p128);
115
my $str_2p128 = '340282366920938463463374607431768211456';
116

117
my $uv_max = ~ 0;
118
my $uv_max_str = ~ 0;
119
$uv_max_str = "$uv_max_str";
120
$uv_max_str = "" . "$uv_max_str";
121

122

123
#------------------------------------------------------------------------------
124
# GMP::version
125

126
use GMP qw(version);
127
print '$GMP::VERSION ',$GMP::VERSION,' GMP::version() ',version(),"\n";
128

129

130
#------------------------------------------------------------------------------
131
# GMP::Mpz::new
132

133
ok (mpz(0) == 0);
134
ok (mpz('0') == 0);
135
ok (mpz(substr('101',1,1)) == 0);
136
ok (mpz(0.0) == 0);
137
ok (mpz(mpz(0)) == 0);
138
ok (mpz(mpq(0)) == 0);
139
ok (mpz(mpf(0)) == 0);
140

141
{ tie my $t, 'Mytie', 0;
142
  ok (mpz($t) == 0);
143
  ok ($Mytie::fetched > 0);
144
}
145
{ tie my $t, 'Mytie', '0';
146
  ok (mpz($t) == 0);
147
  ok ($Mytie::fetched > 0);
148
}
149
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpz($t) == 0); }
150
{ tie my $t, 'Mytie', 0.0; ok (mpz($t) == 0); }
151
{ tie my $t, 'Mytie', mpz(0); ok (mpz($t) == 0); }
152
{ tie my $t, 'Mytie', mpq(0); ok (mpz($t) == 0); }
153
{ tie my $t, 'Mytie', mpf(0); ok (mpz($t) == 0); }
154

155
ok (mpz(-123) == -123);
156
ok (mpz('-123') == -123);
157
ok (mpz(substr('1-1231',1,4)) == -123);
158
ok (mpz(-123.0) == -123);
159
ok (mpz(mpz(-123)) == -123);
160
ok (mpz(mpq(-123)) == -123);
161
ok (mpz(mpf(-123)) == -123);
162

163
{ tie my $t, 'Mytie', -123; ok (mpz($t) == -123); }
164
{ tie my $t, 'Mytie', '-123'; ok (mpz($t) == -123); }
165
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpz($t) == -123); }
166
{ tie my $t, 'Mytie', -123.0; ok (mpz($t) == -123); }
167
{ tie my $t, 'Mytie', mpz(-123); ok (mpz($t) == -123); }
168
{ tie my $t, 'Mytie', mpq(-123); ok (mpz($t) == -123); }
169
{ tie my $t, 'Mytie', mpf(-123); ok (mpz($t) == -123); }
170

171
ok (mpz($ivnv_2p128) == $str_2p128);
172
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpz($t) == $str_2p128); }
173

174
ok (mpz($uv_max) > 0);
175
ok (mpz($uv_max) == mpz($uv_max_str));
176
{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) > 0); }
177
{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) == mpz($uv_max_str)); }
178

179
{ my $s = '999999999999999999999999999999';
180
  kill (0, $s);
181
  ok (mpz($s) == '999999999999999999999999999999');
182
  tie my $t, 'Mytie', $s;
183
  ok (mpz($t) == '999999999999999999999999999999');
184
}
185

186
#------------------------------------------------------------------------------
187
# GMP::Mpz::overload_abs
188

189
ok (abs(mpz(0)) == 0);
190
ok (abs(mpz(123)) == 123);
191
ok (abs(mpz(-123)) == 123);
192

193
{ my $x = mpz(-123); $x = abs($x); ok ($x == 123); }
194
{ my $x = mpz(0);    $x = abs($x); ok ($x == 0);   }
195
{ my $x = mpz(123);  $x = abs($x); ok ($x == 123); }
196

197
{ tie my $t, 'Mytie', mpz(0); ok (abs($t) == 0); }
198
{ tie my $t, 'Mytie', mpz(123); ok (abs($t) == 123); }
199
{ tie my $t, 'Mytie', mpz(-123); ok (abs($t) == 123); }
200

201
#------------------------------------------------------------------------------
202
# GMP::Mpz::overload_add
203

204
ok (mpz(0) + 1 == 1);
205
ok (mpz(-1) + 1 == 0);
206
ok (1 + mpz(0) == 1);
207
ok (1 + mpz(-1) == 0);
208

209
#------------------------------------------------------------------------------
210
# GMP::Mpz::overload_addeq
211

212
{ my $a = mpz(7); $a += 1; ok ($a == 8); }
213
{ my $a = mpz(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
214

215
#------------------------------------------------------------------------------
216
# GMP::Mpz::overload_and
217

218
ok ((mpz(3) & 1) == 1);
219
ok ((mpz(3) & 4) == 0);
220

221
{ my $a = mpz(3); $a &= 1; ok ($a == 1); }
222
{ my $a = mpz(3); $a &= 4; ok ($a == 0); }
223

224
#------------------------------------------------------------------------------
225
# GMP::Mpz::overload_bool
226

227
if (mpz(0))   { ok (0); } else { ok (1); }
228
if (mpz(123)) { ok (1); } else { ok (0); }
229

230
#------------------------------------------------------------------------------
231
# GMP::Mpz::overload_com
232

233
ok (~ mpz(0) == -1);
234
ok (~ mpz(1) == -2);
235
ok (~ mpz(-2) == 1);
236
ok (~ mpz(0xFF) == -0x100);
237
ok (~ mpz(-0x100) == 0xFF);
238

239
#------------------------------------------------------------------------------
240
# GMP::Mpz::overload_dec
241

242
{ my $a = mpz(0); ok ($a-- == 0); ok ($a == -1); }
243
{ my $a = mpz(0); ok (--$a == -1); }
244

245
{ my $a = mpz(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
246

247
#------------------------------------------------------------------------------
248
# GMP::Mpz::overload_div
249

250
ok (mpz(6) / 2 == 3);
251
ok (mpz(-6) / 2 == -3);
252
ok (mpz(6) / -2 == -3);
253
ok (mpz(-6) / -2 == 3);
254

255
#------------------------------------------------------------------------------
256
# GMP::Mpz::overload_diveq
257

258
{ my $a = mpz(21); $a /= 3; ok ($a == 7); }
259
{ my $a = mpz(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
260

261
#------------------------------------------------------------------------------
262
# GMP::Mpz::overload_eq
263

264
{ my $a = mpz(0);
265
  my $b = $a;
266
  $a = mpz(1);
267
  ok ($a == 1);
268
  ok ($b == 0); }
269

270
#------------------------------------------------------------------------------
271
# GMP::Mpz::overload_inc
272

273
{ my $a = mpz(0); ok ($a++ == 0); ok ($a == 1); }
274
{ my $a = mpz(0); ok (++$a == 1); }
275

276
{ my $a = mpz(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
277

278
#------------------------------------------------------------------------------
279
# GMP::Mpz::overload_ior
280

281
ok ((mpz(3) | 1) == 3);
282
ok ((mpz(3) | 4) == 7);
283

284
{ my $a = mpz(3); $a |= 1; ok ($a == 3); }
285
{ my $a = mpz(3); $a |= 4; ok ($a == 7); }
286

287
ok ((mpz("0xAA") | mpz("0x55")) == mpz("0xFF"));
288

289
#------------------------------------------------------------------------------
290
# GMP::Mpz::overload_lshift
291

292
{ my $a = mpz(7) << 1; ok ($a == 14); }
293

294
#------------------------------------------------------------------------------
295
# GMP::Mpz::overload_lshifteq
296

297
{ my $a = mpz(7); $a <<= 1; ok ($a == 14); }
298
{ my $a = mpz(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
299

300
#------------------------------------------------------------------------------
301
# GMP::Mpz::overload_mul
302

303
ok (mpz(2) * 3 == 6);
304

305
#------------------------------------------------------------------------------
306
# GMP::Mpz::overload_muleq
307

308
{ my $a = mpz(7); $a *= 3;  ok ($a == 21); }
309
{ my $a = mpz(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
310

311
#------------------------------------------------------------------------------
312
# GMP::Mpz::overload_neg
313

314
ok (- mpz(0) == 0);
315
ok (- mpz(123) == -123);
316
ok (- mpz(-123) == 123);
317

318
#------------------------------------------------------------------------------
319
# GMP::Mpz::overload_not
320

321
if (not mpz(0))   { ok (1); } else { ok (0); }
322
if (not mpz(123)) { ok (0); } else { ok (1); }
323

324
ok ((! mpz(0)) == 1);
325
ok ((! mpz(123)) == 0);
326

327
#------------------------------------------------------------------------------
328
# GMP::Mpz::overload_pow
329

330
ok (mpz(0) ** 1 == 0);
331
ok (mpz(1) ** 1 == 1);
332
ok (mpz(2) ** 0 == 1);
333
ok (mpz(2) ** 1 == 2);
334
ok (mpz(2) ** 2 == 4);
335
ok (mpz(2) ** 3 == 8);
336
ok (mpz(2) ** 4 == 16);
337

338
ok (mpz(0) ** mpz(1) == 0);
339
ok (mpz(1) ** mpz(1) == 1);
340
ok (mpz(2) ** mpz(0) == 1);
341
ok (mpz(2) ** mpz(1) == 2);
342
ok (mpz(2) ** mpz(2) == 4);
343
ok (mpz(2) ** mpz(3) == 8);
344
ok (mpz(2) ** mpz(4) == 16);
345

346
#------------------------------------------------------------------------------
347
# GMP::Mpz::overload_poweq
348

349
{ my $a = mpz(3); $a **= 4; ok ($a == 81); }
350
{ my $a = mpz(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
351

352
#------------------------------------------------------------------------------
353
# GMP::Mpz::overload_rem
354

355
ok (mpz(-8) % 3 == -2);
356
ok (mpz(-7) % 3 == -1);
357
ok (mpz(-6) % 3 == 0);
358
ok (mpz(6) % 3 == 0);
359
ok (mpz(7) % 3 == 1);
360
ok (mpz(8) % 3 == 2);
361

362
{ my $a = mpz(24); $a %= 7; ok ($a == 3); }
363

364
#------------------------------------------------------------------------------
365
# GMP::Mpz::overload_rshift
366

367
{ my $a = mpz(32) >> 1; ok ($a == 16); }
368

369
#------------------------------------------------------------------------------
370
# GMP::Mpz::overload_rshifteq
371

372
{ my $a = mpz(32); $a >>= 1; ok ($a == 16); }
373
{ my $a = mpz(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
374

375
#------------------------------------------------------------------------------
376
# GMP::Mpz::overload_spaceship
377

378
ok (mpz(0) < 1);
379
ok (mpz(0) > -1);
380

381
ok (mpz(0) != 1);
382
ok (mpz(0) != -1);
383
ok (mpz(1) != 0);
384
ok (mpz(1) != -1);
385
ok (mpz(-1) != 0);
386
ok (mpz(-1) != 1);
387

388
ok (mpz(0) < 1.0);
389
ok (mpz(0) < '1');
390
ok (mpz(0) < substr('-1',1,1));
391
ok (mpz(0) < mpz(1));
392
ok (mpz(0) < mpq(1));
393
ok (mpz(0) < mpf(1));
394
ok (mpz(0) < $uv_max);
395

396
#------------------------------------------------------------------------------
397
# GMP::Mpz::overload_sqrt
398

399
ok (sqrt(mpz(0)) == 0);
400
ok (sqrt(mpz(1)) == 1);
401
ok (sqrt(mpz(4)) == 2);
402
ok (sqrt(mpz(81)) == 9);
403

404
#------------------------------------------------------------------------------
405
# GMP::Mpz::overload_string
406

407
{ my $x = mpz(0);    ok("$x" eq "0"); }
408
{ my $x = mpz(123);  ok("$x" eq "123"); }
409
{ my $x = mpz(-123); ok("$x" eq "-123"); }
410

411
#------------------------------------------------------------------------------
412
# GMP::Mpz::overload_sub
413

414
ok (mpz(0) - 1 == -1);
415
ok (mpz(1) - 1 == 0);
416
ok (1 - mpz(0) == 1);
417
ok (1 - mpz(1) == 0);
418

419
#------------------------------------------------------------------------------
420
# GMP::Mpz::overload_subeq
421

422
{ my $a = mpz(7); $a -= 1; ok ($a == 6); }
423
{ my $a = mpz(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
424

425
#------------------------------------------------------------------------------
426
# GMP::Mpz::overload_xor
427

428
ok ((mpz(3) ^ 1) == 2);
429
ok ((mpz(3) ^ 4) == 7);
430

431
{ my $a = mpz(3); $a ^= 1; ok ($a == 2); }
432
{ my $a = mpz(3); $a ^= 4; ok ($a == 7); }
433

434

435
#------------------------------------------------------------------------------
436
# GMP::Mpz::bin
437

438
ok (bin(2,0) == 1);
439
ok (bin(2,1) == 2);
440
ok (bin(2,2) == 1);
441

442
ok (bin(3,0) == 1);
443
ok (bin(3,1) == 3);
444
ok (bin(3,2) == 3);
445
ok (bin(3,3) == 1);
446

447

448
#------------------------------------------------------------------------------
449
# GMP::Mpz::cdiv
450

451
{ my ($q, $r);
452
  ($q, $r) = cdiv (16, 3);
453
  ok ($q == 6);
454
  ok ($r == -2);
455
  ($q, $r) = cdiv (16, -3);
456
  ok ($q == -5);
457
  ok ($r == 1);
458
  ($q, $r) = cdiv (-16, 3);
459
  ok ($q == -5);
460
  ok ($r == -1);
461
  ($q, $r) = cdiv (-16, -3);
462
  ok ($q == 6);
463
  ok ($r == 2);
464
}
465

466

467
#------------------------------------------------------------------------------
468
# GMP::Mpz::cdiv_2exp
469

470
{ my ($q, $r);
471
  ($q, $r) = cdiv_2exp (23, 2);
472
  ok ($q == 6);
473
  ok ($r == -1);
474
  ($q, $r) = cdiv_2exp (-23, 2);
475
  ok ($q == -5);
476
  ok ($r == -3);
477
}
478

479

480
#------------------------------------------------------------------------------
481
# GMP::Mpz::clrbit
482

483
{ my $a = mpz(3); clrbit ($a, 1); ok ($a == 1);
484
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
485
{ my $a = mpz(3); clrbit ($a, 2); ok ($a == 3);
486
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
487

488
{ my $a = 3; clrbit ($a, 1); ok ($a == 1);
489
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
490
{ my $a = 3; clrbit ($a, 2); ok ($a == 3);
491
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
492

493
# mutate only given variable
494
{ my $a = mpz(3);
495
  my $b = $a;
496
  clrbit ($a, 0);
497
  ok ($a == 2);
498
  ok ($b == 3);
499
}
500
{ my $a = 3;
501
  my $b = $a;
502
  clrbit ($a, 0);
503
  ok ($a == 2);
504
  ok ($b == 3);
505
}
506

507
{ tie my $a, 'Mytie', mpz(3);
508
  clrbit ($a, 1);
509
  ok ($Mytie::fetched > 0);    # used fetch
510
  ok ($Mytie::stored > 0);     # used store
511
  ok ($a == 1);                # expected result
512
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
513
  ok (tied($a));               # still tied
514
}
515
{ tie my $a, 'Mytie', 3;
516
  clrbit ($a, 1);
517
  ok ($Mytie::fetched > 0);    # used fetch
518
  ok ($Mytie::stored > 0);     # used store
519
  ok ($a == 1);                # expected result
520
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
521
  ok (tied($a));               # still tied
522
}
523

524
{ my $b = mpz(3);
525
  tie my $a, 'Mytie', $b;
526
  clrbit ($a, 0);
527
  ok ($a == 2);
528
  ok ($b == 3);
529
  ok (tied($a));
530
}
531
{ my $b = 3;
532
  tie my $a, 'Mytie', $b;
533
  clrbit ($a, 0);
534
  ok ($a == 2);
535
  ok ($b == 3);
536
  ok (tied($a));
537
}
538

539
#------------------------------------------------------------------------------
540
# GMP::Mpz::combit
541

542
{ my $a = mpz(3); combit ($a, 1); ok ($a == 1);
543
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
544
{ my $a = mpz(3); combit ($a, 2); ok ($a == 7);
545
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
546

547
{ my $a = 3; combit ($a, 1); ok ($a == 1);
548
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
549
{ my $a = 3; combit ($a, 2); ok ($a == 7);
550
  ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
551

552
# mutate only given variable
553
{ my $a = mpz(3);
554
  my $b = $a;
555
  combit ($a, 0);
556
  ok ($a == 2);
557
  ok ($b == 3);
558
}
559
{ my $a = 3;
560
  my $b = $a;
561
  combit ($a, 0);
562
  ok ($a == 2);
563
  ok ($b == 3);
564
}
565

566
{ tie my $a, 'Mytie', mpz(3);
567
  combit ($a, 2);
568
  ok ($Mytie::fetched > 0);    # used fetch
569
  ok ($Mytie::stored > 0);     # used store
570
  ok ($a == 7);                # expected result
571
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
572
  ok (tied($a));               # still tied
573
}
574
{ tie my $a, 'Mytie', 3;
575
  combit ($a, 2);
576
  ok ($Mytie::fetched > 0);    # used fetch
577
  ok ($Mytie::stored > 0);     # used store
578
  ok ($a == 7);                # expected result
579
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
580
  ok (tied($a));               # still tied
581
}
582

583
{ my $b = mpz(3);
584
  tie my $a, 'Mytie', $b;
585
  combit ($a, 0);
586
  ok ($a == 2);
587
  ok ($b == 3);
588
  ok (tied($a));
589
}
590
{ my $b = 3;
591
  tie my $a, 'Mytie', $b;
592
  combit ($a, 0);
593
  ok ($a == 2);
594
  ok ($b == 3);
595
  ok (tied($a));
596
}
597

598
#------------------------------------------------------------------------------
599
# GMP::Mpz::congruent_p
600

601
ok (  congruent_p (21, 0, 7));
602
ok (! congruent_p (21, 1, 7));
603
ok (  congruent_p (21, 5, 8));
604
ok (! congruent_p (21, 6, 8));
605

606

607
#------------------------------------------------------------------------------
608
# GMP::Mpz::congruent_2exp_p
609

610
ok (  congruent_2exp_p (20, 0, 2));
611
ok (! congruent_2exp_p (21, 0, 2));
612
ok (! congruent_2exp_p (20, 1, 2));
613

614
#------------------------------------------------------------------------------
615
# GMP::Mpz::divexact
616

617
ok (divexact(27,3) == 9);
618
ok (divexact(27,-3) == -9);
619
ok (divexact(-27,3) == -9);
620
ok (divexact(-27,-3) == 9);
621

622
#------------------------------------------------------------------------------
623
# GMP::Mpz::divisible_p
624

625
ok (  divisible_p (21, 7));
626
ok (! divisible_p (21, 8));
627

628
#------------------------------------------------------------------------------
629
# GMP::Mpz::divisible_2exp_p
630

631
ok (  divisible_2exp_p (20, 2));
632
ok (! divisible_2exp_p (21, 2));
633

634
#------------------------------------------------------------------------------
635
# GMP::Mpz::even_p
636

637
ok (! even_p(mpz(-3)));
638
ok (  even_p(mpz(-2)));
639
ok (! even_p(mpz(-1)));
640
ok (  even_p(mpz(0)));
641
ok (! even_p(mpz(1)));
642
ok (  even_p(mpz(2)));
643
ok (! even_p(mpz(3)));
644

645
#------------------------------------------------------------------------------
646
# GMP::Mpz::export
647

648
{ my $s = mpz_export (1, 2, 1, 0, "0x61626364");
649
  ok ($s eq 'abcd'); }
650
{ my $s = mpz_export (-1, 2, 1, 0, "0x61626364");
651
  ok ($s eq 'cdab'); }
652
{ my $s = mpz_export (1, 2, -1, 0, "0x61626364");
653
  ok ($s eq 'badc'); }
654
{ my $s = mpz_export (-1, 2, -1, 0, "0x61626364");
655
  ok ($s eq 'dcba'); }
656

657
#------------------------------------------------------------------------------
658
# GMP::Mpz::fac
659

660
ok (fac(0) == 1);
661
ok (fac(1) == 1);
662
ok (fac(2) == 2);
663
ok (fac(3) == 6);
664
ok (fac(4) == 24);
665
ok (fac(5) == 120);
666

667
#------------------------------------------------------------------------------
668
# GMP::Mpz::fdiv
669

670
{ my ($q, $r);
671
  ($q, $r) = fdiv (16, 3);
672
  ok ($q == 5);
673
  ok ($r == 1);
674
  ($q, $r) = fdiv (16, -3);
675
  ok ($q == -6);
676
  ok ($r == -2);
677
  ($q, $r) = fdiv (-16, 3);
678
  ok ($q == -6);
679
  ok ($r == 2);
680
  ($q, $r) = fdiv (-16, -3);
681
  ok ($q == 5);
682
  ok ($r == -1);
683
}
684

685
#------------------------------------------------------------------------------
686
# GMP::Mpz::fdiv_2exp
687

688
{ my ($q, $r);
689
  ($q, $r) = fdiv_2exp (23, 2);
690
  ok ($q == 5);
691
  ok ($r == 3);
692
  ($q, $r) = fdiv_2exp (-23, 2);
693
  ok ($q == -6);
694
  ok ($r == 1);
695
}
696

697
#------------------------------------------------------------------------------
698
# GMP::Mpz::fib
699

700
ok (fib(0) == 0);
701
ok (fib(1) == 1);
702
ok (fib(2) == 1);
703
ok (fib(3) == 2);
704
ok (fib(4) == 3);
705
ok (fib(5) == 5);
706
ok (fib(6) == 8);
707

708
#------------------------------------------------------------------------------
709
# GMP::Mpz::fib2
710

711
{ my ($a, $b) = fib2(0); ok($a==0); ok($b==1); }
712
{ my ($a, $b) = fib2(1); ok($a==1); ok($b==0); }
713
{ my ($a, $b) = fib2(2); ok($a==1); ok($b==1); }
714
{ my ($a, $b) = fib2(3); ok($a==2); ok($b==1); }
715
{ my ($a, $b) = fib2(4); ok($a==3); ok($b==2); }
716
{ my ($a, $b) = fib2(5); ok($a==5); ok($b==3); }
717
{ my ($a, $b) = fib2(6); ok($a==8); ok($b==5); }
718

719
#------------------------------------------------------------------------------
720
# GMP::Mpz::gcd
721

722
ok (gcd (21) == 21);
723
ok (gcd (21,15) == 3);
724
ok (gcd (21,15,30,57) == 3);
725
ok (gcd (21,-15) == 3);
726
ok (gcd (-21,15) == 3);
727
ok (gcd (-21,-15) == 3);
728

729
#------------------------------------------------------------------------------
730
# GMP::Mpz::gcdext
731

732
{
733
  my ($g, $x, $y) = gcdext (3,5);
734
  ok ($g == 1);
735
  ok ($x == 2);
736
  ok ($y == -1);
737
}
738

739
#------------------------------------------------------------------------------
740
# GMP::Mpz::hamdist
741

742
ok (hamdist(5,7) == 1);
743

744
#------------------------------------------------------------------------------
745
# GMP::Mpz::import
746

747
{ my $z = mpz_import (1, 2, 1, 0, 'abcd');
748
  ok ($z == 0x61626364); }
749
{ my $z = mpz_import (-1, 2, 1, 0, 'abcd');
750
  ok ($z == 0x63646162); }
751
{ my $z = mpz_import (1, 2, -1, 0, 'abcd');
752
  ok ($z == 0x62616463); }
753
{ my $z = mpz_import (-1, 2, -1, 0, 'abcd');
754
  ok ($z == 0x64636261); }
755

756
#------------------------------------------------------------------------------
757
# GMP::Mpz::invert
758

759
ok (invert(1,123) == 1);
760
ok (invert(6,7) == 6);
761
ok (! defined invert(2,8));
762

763
#------------------------------------------------------------------------------
764
# GMP::Mpz::jacobi, GMP::Mpz::kronecker
765

766
foreach my $i ([  1, 19,  1 ],
767
	       [  4, 19,  1 ],
768
	       [  5, 19,  1 ],
769
	       [  6, 19,  1 ],
770
	       [  7, 19,  1 ],
771
	       [  9, 19,  1 ],
772
	       [ 11, 19,  1 ],
773
	       [ 16, 19,  1 ],
774
	       [ 17, 19,  1 ],
775
	       [  2, 19, -1 ],
776
	       [  3, 19, -1 ],
777
	       [  8, 19, -1 ],
778
	       [ 10, 19, -1 ],
779
	       [ 12, 19, -1 ],
780
	       [ 13, 19, -1 ],
781
	       [ 14, 19, -1 ],
782
	       [ 15, 19, -1 ],
783
	       [ 18, 19, -1 ]) {
784
  foreach my $fun (\&jacobi, \&kronecker) {
785
    ok (&$fun ($$i[0], $$i[1]) == $$i[2]);
786

787
    ok (&$fun ($$i[0],      str($$i[1])) == $$i[2]);
788
    ok (&$fun (str($$i[0]),     $$i[1])  == $$i[2]);
789
    ok (&$fun (str($$i[0]), str($$i[1])) == $$i[2]);
790

791
    ok (&$fun ($$i[0],      mpz($$i[1])) == $$i[2]);
792
    ok (&$fun (mpz($$i[0]), $$i[1]) == $$i[2]);
793
    ok (&$fun (mpz($$i[0]), mpz($$i[1])) == $$i[2]);
794
  }
795
}
796

797
#------------------------------------------------------------------------------
798
# GMP::Mpz::lcm
799

800
ok (lcm (2) == 2);
801
ok (lcm (0) == 0);
802
ok (lcm (0,0) == 0);
803
ok (lcm (0,0,0) == 0);
804
ok (lcm (0,0,0,0) == 0);
805
ok (lcm (2,0) == 0);
806
ok (lcm (-2,0) == 0);
807
ok (lcm (2,3) == 6);
808
ok (lcm (2,3,4) == 12);
809
ok (lcm (2,-3) == 6);
810
ok (lcm (-2,3) == 6);
811
ok (lcm (-2,-3) == 6);
812
ok (lcm (mpz(2)**512,1) == mpz(2)**512);
813
ok (lcm (mpz(2)**512,-1) == mpz(2)**512);
814
ok (lcm (-mpz(2)**512,1) == mpz(2)**512);
815
ok (lcm (-mpz(2)**512,-1) == mpz(2)**512);
816
ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512);
817
ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
818
ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512);
819
ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
820

821
#------------------------------------------------------------------------------
822
# GMP::Mpz::lucnum
823

824
ok (lucnum(0) == 2);
825
ok (lucnum(1) == 1);
826
ok (lucnum(2) == 3);
827
ok (lucnum(3) == 4);
828
ok (lucnum(4) == 7);
829
ok (lucnum(5) == 11);
830
ok (lucnum(6) == 18);
831

832
#------------------------------------------------------------------------------
833
# GMP::Mpz::lucnum2
834

835
{ my ($a, $b) = lucnum2(0); ok($a==2);  ok($b==-1); }
836
{ my ($a, $b) = lucnum2(1); ok($a==1);  ok($b==2); }
837
{ my ($a, $b) = lucnum2(2); ok($a==3);  ok($b==1); }
838
{ my ($a, $b) = lucnum2(3); ok($a==4);  ok($b==3); }
839
{ my ($a, $b) = lucnum2(4); ok($a==7);  ok($b==4); }
840
{ my ($a, $b) = lucnum2(5); ok($a==11); ok($b==7); }
841
{ my ($a, $b) = lucnum2(6); ok($a==18); ok($b==11); }
842

843
#------------------------------------------------------------------------------
844
# GMP::Mpz::nextprime
845

846
ok (nextprime(2) == 3);
847
ok (nextprime(3) == 5);
848
ok (nextprime(5) == 7);
849
ok (nextprime(7) == 11);
850
ok (nextprime(11) == 13);
851

852
#------------------------------------------------------------------------------
853
# GMP::Mpz::perfect_power_p
854

855
# ok (  perfect_power_p(mpz(-27)));
856
# ok (! perfect_power_p(mpz(-9)));
857
# ok (! perfect_power_p(mpz(-1)));
858
ok (  perfect_power_p(mpz(0)));
859
ok (  perfect_power_p(mpz(1)));
860
ok (! perfect_power_p(mpz(2)));
861
ok (! perfect_power_p(mpz(3)));
862
ok (  perfect_power_p(mpz(4)));
863
ok (  perfect_power_p(mpz(9)));
864
ok (  perfect_power_p(mpz(27)));
865
ok (  perfect_power_p(mpz(81)));
866

867
#------------------------------------------------------------------------------
868
# GMP::Mpz::perfect_square_p
869

870
ok (! perfect_square_p(mpz(-9)));
871
ok (! perfect_square_p(mpz(-1)));
872
ok (  perfect_square_p(mpz(0)));
873
ok (  perfect_square_p(mpz(1)));
874
ok (! perfect_square_p(mpz(2)));
875
ok (! perfect_square_p(mpz(3)));
876
ok (  perfect_square_p(mpz(4)));
877
ok (  perfect_square_p(mpz(9)));
878
ok (! perfect_square_p(mpz(27)));
879
ok (  perfect_square_p(mpz(81)));
880

881
#------------------------------------------------------------------------------
882
# GMP::Mpz::popcount
883

884
ok (popcount(7) == 3);
885

886
#------------------------------------------------------------------------------
887
# GMP::Mpz::powm
888

889
ok (powm (3,2,8) == 1);
890

891
#------------------------------------------------------------------------------
892
# GMP::Mpz::probab_prime_p
893

894
ok (  probab_prime_p(89,1));
895
ok (! probab_prime_p(81,1));
896

897
#------------------------------------------------------------------------------
898
# GMP::Mpz::realloc
899

900
{ my $z = mpz(123);
901
  realloc ($z, 512); }
902

903
#------------------------------------------------------------------------------
904
# GMP::Mpz::remove
905

906
{
907
  my ($rem, $mult);
908
  ($rem, $mult) = remove(12,3);
909
  ok ($rem == 4);
910
  ok ($mult == 1);
911
  ($rem, $mult) = remove(12,2);
912
  ok ($rem == 3);
913
  ok ($mult == 2);
914
}
915

916
#------------------------------------------------------------------------------
917
# GMP::Mpz::root
918

919
ok (root(0,2) == 0);
920
ok (root(8,3) == 2);
921
ok (root(-8,3) == -2);
922
ok (root(81,4) == 3);
923
ok (root(243,5) == 3);
924

925
#------------------------------------------------------------------------------
926
# GMP::Mpz::roote
927

928
{ my ($r,$e);
929
  ($r, $e) = roote(0,2);
930
  ok ($r == 0);
931
  ok ($e);
932
  ($r, $e) = roote(81,4);
933
  ok ($r == 3);
934
  ok ($e);
935
  ($r, $e) = roote(85,4);
936
  ok ($r == 3);
937
  ok (! $e);
938
}
939

940
#------------------------------------------------------------------------------
941
# GMP::Mpz::rootrem
942

943
{ my ($root, $rem) = rootrem (mpz(0), 1);
944
  ok ($root == 0); ok ($rem == 0); }
945
{ my ($root, $rem) = rootrem (mpz(0), 2);
946
  ok ($root == 0); ok ($rem == 0); }
947
{ my ($root, $rem) = rootrem (mpz(64), 2);
948
  ok ($root == 8); ok ($rem == 0); }
949
{ my ($root, $rem) = rootrem (mpz(64), 3);
950
  ok ($root == 4); ok ($rem == 0); }
951
{ my ($root, $rem) = rootrem (mpz(65), 3);
952
  ok ($root == 4); ok ($rem == 1); }
953

954
#------------------------------------------------------------------------------
955
# GMP::Mpz::scan0
956

957
ok (scan0 (0, 0) == 0);
958
ok (scan0 (1, 0) == 1);
959
ok (scan0 (3, 0) == 2);
960
ok (scan0 (-1, 0) == ~0);
961
ok (scan0 (-2, 1) == ~0);
962

963
#------------------------------------------------------------------------------
964
# GMP::Mpz::scan1
965

966
ok (scan1 (1, 0) == 0);
967
ok (scan1 (2, 0) == 1);
968
ok (scan1 (4, 0) == 2);
969
ok (scan1 (0, 0) == ~0);
970
ok (scan1 (3, 2) == ~0);
971

972
#------------------------------------------------------------------------------
973
# GMP::Mpz::setbit
974

975
{ my $a = mpz(3); setbit ($a, 1); ok ($a == 3); }
976
{ my $a = mpz(3); setbit ($a, 2); ok ($a == 7); }
977

978
{ my $a = 3; setbit ($a, 1); ok ($a == 3); }
979
{ my $a = 3; setbit ($a, 2); ok ($a == 7); }
980

981
# mutate only given variable
982
{ my $a = mpz(0);
983
  my $b = $a;
984
  setbit ($a, 0);
985
  ok ($a == 1);
986
  ok ($b == 0);
987
}
988
{ my $a = 0;
989
  my $b = $a;
990
  setbit ($a, 0);
991
  ok ($a == 1);
992
  ok ($b == 0);
993
}
994

995
{ tie my $a, 'Mytie', mpz(3);
996
  setbit ($a, 2);
997
  ok ($Mytie::fetched > 0);    # used fetch
998
  ok ($Mytie::stored > 0);     # used store
999
  ok ($a == 7);                # expected result
1000
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
1001
  ok (tied($a));               # still tied
1002
}
1003
{ tie my $a, 'Mytie', 3;
1004
  setbit ($a, 2);
1005
  ok ($Mytie::fetched > 0);    # used fetch
1006
  ok ($Mytie::stored > 0);     # used store
1007
  ok ($a == 7);                # expected result
1008
  ok (UNIVERSAL::isa($a,"GMP::Mpz"));
1009
  ok (tied($a));               # still tied
1010
}
1011

1012
{ my $b = mpz(2);
1013
  tie my $a, 'Mytie', $b;
1014
  setbit ($a, 0);
1015
  ok ($a == 3);
1016
  ok ($b == 2);
1017
  ok (tied($a));
1018
}
1019
{ my $b = 2;
1020
  tie my $a, 'Mytie', $b;
1021
  setbit ($a, 0);
1022
  ok ($a == 3);
1023
  ok ($b == 2);
1024
  ok (tied($a));
1025
}
1026

1027
#------------------------------------------------------------------------------
1028
# GMP::Mpz::sizeinbase
1029

1030
ok (sizeinbase(1,10) == 1);
1031
ok (sizeinbase(100,10) == 3);
1032
ok (sizeinbase(9999,10) == 5);
1033

1034
#------------------------------------------------------------------------------
1035
# GMP::Mpz::sqrtrem
1036

1037
{
1038
  my ($root, $rem) = sqrtrem(mpz(0));
1039
  ok ($root == 0);
1040
  ok ($rem == 0);
1041
}
1042
{
1043
  my ($root, $rem) = sqrtrem(mpz(1));
1044
  ok ($root == 1);
1045
  ok ($rem == 0);
1046
}
1047
{
1048
  my ($root, $rem) = sqrtrem(mpz(2));
1049
  ok ($root == 1);
1050
  ok ($rem == 1);
1051
}
1052
{
1053
  my ($root, $rem) = sqrtrem(mpz(9));
1054
  ok ($root == 3);
1055
  ok ($rem == 0);
1056
}
1057
{
1058
  my ($root, $rem) = sqrtrem(mpz(35));
1059
  ok ($root == 5);
1060
  ok ($rem == 10);
1061
}
1062
{
1063
  my ($root, $rem) = sqrtrem(mpz(0));
1064
  ok ($root == 0);
1065
  ok ($rem == 0);
1066
}
1067

1068
#------------------------------------------------------------------------------
1069
# GMP::Mpz::tdiv
1070

1071
{ my ($q, $r);
1072
  ($q, $r) = tdiv (16, 3);
1073
  ok ($q == 5);
1074
  ok ($r == 1);
1075
  ($q, $r) = tdiv (16, -3);
1076
  ok ($q == -5);
1077
  ok ($r == 1);
1078
  ($q, $r) = tdiv (-16, 3);
1079
  ok ($q == -5);
1080
  ok ($r == -1);
1081
  ($q, $r) = tdiv (-16, -3);
1082
  ok ($q == 5);
1083
  ok ($r == -1);
1084
}
1085

1086
#------------------------------------------------------------------------------
1087
# GMP::Mpz::tdiv_2exp
1088

1089
{ my ($q, $r);
1090
  ($q, $r) = tdiv_2exp (23, 2);
1091
  ok ($q == 5);
1092
  ok ($r == 3);
1093
  ($q, $r) = tdiv_2exp (-23, 2);
1094
  ok ($q == -5);
1095
  ok ($r == -3);
1096
}
1097

1098
#------------------------------------------------------------------------------
1099
# GMP::Mpz::tstbit
1100

1101
ok (tstbit (6, 0) == 0);
1102
ok (tstbit (6, 1) == 1);
1103
ok (tstbit (6, 2) == 1);
1104
ok (tstbit (6, 3) == 0);
1105

1106

1107

1108

1109
#------------------------------------------------------------------------------
1110
# GMP::Mpq
1111

1112
#------------------------------------------------------------------------------
1113
# GMP::Mpq::new
1114

1115
ok (mpq(0) == 0);
1116
ok (mpq('0') == 0);
1117
ok (mpq(substr('101',1,1)) == 0);
1118
ok (mpq(0.0) == 0);
1119
ok (mpq(mpz(0)) == 0);
1120
ok (mpq(mpq(0)) == 0);
1121
ok (mpq(mpf(0)) == 0);
1122

1123
{ tie my $t, 'Mytie', 0; ok (mpq($t) == 0); }
1124
{ tie my $t, 'Mytie', '0'; ok (mpq($t) == 0); }
1125
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpq($t) == 0); }
1126
{ tie my $t, 'Mytie', 0.0; ok (mpq($t) == 0); }
1127
{ tie my $t, 'Mytie', mpz(0); ok (mpq($t) == 0); }
1128
{ tie my $t, 'Mytie', mpq(0); ok (mpq($t) == 0); }
1129
{ tie my $t, 'Mytie', mpf(0); ok (mpq($t) == 0); }
1130

1131
ok (mpq(-123) == -123);
1132
ok (mpq('-123') == -123);
1133
ok (mpq(substr('1-1231',1,4)) == -123);
1134
ok (mpq(-123.0) == -123);
1135
ok (mpq(mpz(-123)) == -123);
1136
ok (mpq(mpq(-123)) == -123);
1137
ok (mpq(mpf(-123)) == -123);
1138

1139
{ tie my $t, 'Mytie', -123; ok (mpq($t) == -123); }
1140
{ tie my $t, 'Mytie', '-123'; ok (mpq($t) == -123); }
1141
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpq($t) == -123); }
1142
{ tie my $t, 'Mytie', -123.0; ok (mpq($t) == -123); }
1143
{ tie my $t, 'Mytie', mpz(-123); ok (mpq($t) == -123); }
1144
{ tie my $t, 'Mytie', mpq(-123); ok (mpq($t) == -123); }
1145
{ tie my $t, 'Mytie', mpf(-123); ok (mpq($t) == -123); }
1146

1147
ok (mpq($ivnv_2p128) == $str_2p128);
1148
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpq($t) == $str_2p128); }
1149

1150
ok (mpq('3/2') == mpq(3,2));
1151
ok (mpq('3/1') == mpq(3,1));
1152
ok (mpq('-3/2') == mpq(-3,2));
1153
ok (mpq('-3/1') == mpq(-3,1));
1154
ok (mpq('0x3') == mpq(3,1));
1155
ok (mpq('0b111') == mpq(7,1));
1156
ok (mpq('0b0') == mpq(0,1));
1157

1158
ok (mpq($uv_max) > 0);
1159
ok (mpq($uv_max) == mpq($uv_max_str));
1160
{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) > 0); }
1161
{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) == mpq($uv_max_str)); }
1162

1163
{ my $x = 123.5;
1164
  kill (0, $x);
1165
  ok (mpq($x) == 123.5);
1166
  tie my $t, 'Mytie', $x;
1167
  ok (mpq($t) == 123.5);
1168
}
1169

1170
#------------------------------------------------------------------------------
1171
# GMP::Mpq::overload_abs
1172

1173
ok (abs(mpq(0)) == 0);
1174
ok (abs(mpq(123)) == 123);
1175
ok (abs(mpq(-123)) == 123);
1176

1177
{ my $x = mpq(-123); $x = abs($x); ok ($x == 123); }
1178
{ my $x = mpq(0);    $x = abs($x); ok ($x == 0);   }
1179
{ my $x = mpq(123);  $x = abs($x); ok ($x == 123); }
1180

1181
{ tie my $t, 'Mytie', mpq(0); ok (abs($t) == 0); }
1182
{ tie my $t, 'Mytie', mpq(123); ok (abs($t) == 123); }
1183
{ tie my $t, 'Mytie', mpq(-123); ok (abs($t) == 123); }
1184

1185
#------------------------------------------------------------------------------
1186
# GMP::Mpq::overload_add
1187

1188
ok (mpq(0) + 1 == 1);
1189
ok (mpq(-1) + 1 == 0);
1190
ok (1 + mpq(0) == 1);
1191
ok (1 + mpq(-1) == 0);
1192

1193
ok (mpq(1,2)+mpq(1,3) == mpq(5,6));
1194
ok (mpq(1,2)+mpq(-1,3) == mpq(1,6));
1195
ok (mpq(-1,2)+mpq(1,3) == mpq(-1,6));
1196
ok (mpq(-1,2)+mpq(-1,3) == mpq(-5,6));
1197

1198
#------------------------------------------------------------------------------
1199
# GMP::Mpq::overload_addeq
1200

1201
{ my $a = mpq(7); $a += 1; ok ($a == 8); }
1202
{ my $a = mpq(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
1203

1204
#------------------------------------------------------------------------------
1205
# GMP::Mpq::overload_bool
1206

1207
if (mpq(0))   { ok (0); } else { ok (1); }
1208
if (mpq(123)) { ok (1); } else { ok (0); }
1209

1210
#------------------------------------------------------------------------------
1211
# GMP::Mpq::overload_dec
1212

1213
{ my $a = mpq(0); ok ($a-- == 0); ok ($a == -1); }
1214
{ my $a = mpq(0); ok (--$a == -1); }
1215

1216
{ my $a = mpq(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
1217

1218
#------------------------------------------------------------------------------
1219
# GMP::Mpq::overload_div
1220

1221
ok (mpq(6) / 2 == 3);
1222
ok (mpq(-6) / 2 == -3);
1223
ok (mpq(6) / -2 == -3);
1224
ok (mpq(-6) / -2 == 3);
1225

1226
#------------------------------------------------------------------------------
1227
# GMP::Mpq::overload_diveq
1228

1229
{ my $a = mpq(21); $a /= 3; ok ($a == 7); }
1230
{ my $a = mpq(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
1231

1232
#------------------------------------------------------------------------------
1233
# GMP::Mpq::overload_eq
1234

1235
{ my $a = mpq(0);
1236
  my $b = $a;
1237
  $a = mpq(1);
1238
  ok ($a == 1);
1239
  ok ($b == 0); }
1240

1241
#------------------------------------------------------------------------------
1242
# GMP::Mpq::overload_inc
1243

1244
{ my $a = mpq(0); ok ($a++ == 0); ok ($a == 1); }
1245
{ my $a = mpq(0); ok (++$a == 1); }
1246

1247
{ my $a = mpq(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
1248

1249
#------------------------------------------------------------------------------
1250
# GMP::Mpq::overload_lshift
1251

1252
{ my $a = mpq(7) << 1; ok ($a == 14); }
1253

1254
#------------------------------------------------------------------------------
1255
# GMP::Mpq::overload_lshifteq
1256

1257
{ my $a = mpq(7); $a <<= 1; ok ($a == 14); }
1258
{ my $a = mpq(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
1259

1260
#------------------------------------------------------------------------------
1261
# GMP::Mpq::overload_mul
1262

1263
ok (mpq(2) * 3 == 6);
1264

1265
#------------------------------------------------------------------------------
1266
# GMP::Mpq::overload_muleq
1267

1268
{ my $a = mpq(7); $a *= 3;  ok ($a == 21); }
1269
{ my $a = mpq(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
1270

1271
#------------------------------------------------------------------------------
1272
# GMP::Mpq::overload_neg
1273

1274
ok (- mpq(0) == 0);
1275
ok (- mpq(123) == -123);
1276
ok (- mpq(-123) == 123);
1277

1278
#------------------------------------------------------------------------------
1279
# GMP::Mpq::overload_not
1280

1281
if (not mpq(0))   { ok (1); } else { ok (0); }
1282
if (not mpq(123)) { ok (0); } else { ok (1); }
1283

1284
ok ((! mpq(0)) == 1);
1285
ok ((! mpq(123)) == 0);
1286

1287
#------------------------------------------------------------------------------
1288
# GMP::Mpq::overload_pow
1289

1290
ok (mpq(0) ** 1 == 0);
1291
ok (mpq(1) ** 1 == 1);
1292
ok (mpq(2) ** 0 == 1);
1293
ok (mpq(2) ** 1 == 2);
1294
ok (mpq(2) ** 2 == 4);
1295
ok (mpq(2) ** 3 == 8);
1296
ok (mpq(2) ** 4 == 16);
1297

1298
ok (mpq(0) ** mpq(1) == 0);
1299
ok (mpq(1) ** mpq(1) == 1);
1300
ok (mpq(2) ** mpq(0) == 1);
1301
ok (mpq(2) ** mpq(1) == 2);
1302
ok (mpq(2) ** mpq(2) == 4);
1303
ok (mpq(2) ** mpq(3) == 8);
1304
ok (mpq(2) ** mpq(4) == 16);
1305

1306
#------------------------------------------------------------------------------
1307
# GMP::Mpq::overload_poweq
1308

1309
{ my $a = mpq(3); $a **= 4; ok ($a == 81); }
1310
{ my $a = mpq(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
1311

1312
#------------------------------------------------------------------------------
1313
# GMP::Mpq::overload_rshift
1314

1315
{ my $a = mpq(32) >> 1; ok ($a == 16); }
1316

1317
#------------------------------------------------------------------------------
1318
# GMP::Mpq::overload_rshifteq
1319

1320
{ my $a = mpq(32); $a >>= 1; ok ($a == 16); }
1321
{ my $a = mpq(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
1322

1323
#------------------------------------------------------------------------------
1324
# GMP::Mpq::overload_spaceship
1325

1326
ok (mpq(0) < 1);
1327
ok (mpq(0) > -1);
1328

1329
ok (mpq(0) != 1);
1330
ok (mpq(0) != -1);
1331
ok (mpq(1) != 0);
1332
ok (mpq(1) != -1);
1333
ok (mpq(-1) != 0);
1334
ok (mpq(-1) != 1);
1335

1336
ok (mpq(3,2) > 1);
1337
ok (mpq(3,2) < 2);
1338

1339
ok (mpq(0) < 1.0);
1340
ok (mpq(0) < '1');
1341
ok (mpq(0) < substr('-1',1,1));
1342
ok (mpq(0) < mpz(1));
1343
ok (mpq(0) < mpq(1));
1344
ok (mpq(0) < mpf(1));
1345
ok (mpq(0) < $uv_max);
1346

1347
#------------------------------------------------------------------------------
1348
# GMP::Mpq::overload_string
1349

1350
{ my $x = mpq(0);    ok("$x" eq "0"); }
1351
{ my $x = mpq(123);  ok("$x" eq "123"); }
1352
{ my $x = mpq(-123); ok("$x" eq "-123"); }
1353

1354
{ my $q = mpq(5,7);  ok("$q" eq "5/7"); }
1355
{ my $q = mpq(-5,7); ok("$q" eq "-5/7"); }
1356

1357
#------------------------------------------------------------------------------
1358
# GMP::Mpq::overload_sub
1359

1360
ok (mpq(0) - 1 == -1);
1361
ok (mpq(1) - 1 == 0);
1362
ok (1 - mpq(0) == 1);
1363
ok (1 - mpq(1) == 0);
1364

1365
ok (mpq(1,2)-mpq(1,3) == mpq(1,6));
1366
ok (mpq(1,2)-mpq(-1,3) == mpq(5,6));
1367
ok (mpq(-1,2)-mpq(1,3) == mpq(-5,6));
1368
ok (mpq(-1,2)-mpq(-1,3) == mpq(-1,6));
1369

1370
#------------------------------------------------------------------------------
1371
# GMP::Mpq::overload_subeq
1372

1373
{ my $a = mpq(7); $a -= 1; ok ($a == 6); }
1374
{ my $a = mpq(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
1375

1376
#------------------------------------------------------------------------------
1377
# GMP::Mpq::canonicalize
1378

1379
{ my $q = mpq(21,15); canonicalize($q);
1380
  ok (num($q) == 7);
1381
  ok (den($q) == 5);
1382
}
1383

1384
#------------------------------------------------------------------------------
1385
# GMP::Mpq::den
1386

1387
{ my $q = mpq(5,9); ok (den($q) == 9); }
1388

1389
#------------------------------------------------------------------------------
1390
# GMP::Mpq::num
1391

1392
{ my $q = mpq(5,9); ok (num($q) == 5); }
1393

1394

1395

1396

1397
#------------------------------------------------------------------------------
1398
# GMP::Mpf
1399

1400
#------------------------------------------------------------------------------
1401
# GMP::Mpf::new
1402

1403
ok (mpf(0) == 0);
1404
ok (mpf('0') == 0);
1405
ok (mpf(substr('101',1,1)) == 0);
1406
ok (mpf(0.0) == 0);
1407
ok (mpf(mpz(0)) == 0);
1408
ok (mpf(mpq(0)) == 0);
1409
ok (mpf(mpf(0)) == 0);
1410

1411
{ tie my $t, 'Mytie', 0; ok (mpf($t) == 0); }
1412
{ tie my $t, 'Mytie', '0'; ok (mpf($t) == 0); }
1413
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpf($t) == 0); }
1414
{ tie my $t, 'Mytie', 0.0; ok (mpf($t) == 0); }
1415
{ tie my $t, 'Mytie', mpz(0); ok (mpf($t) == 0); }
1416
{ tie my $t, 'Mytie', mpq(0); ok (mpf($t) == 0); }
1417
{ tie my $t, 'Mytie', mpf(0); ok (mpf($t) == 0); }
1418

1419
ok (mpf(-123) == -123);
1420
ok (mpf('-123') == -123);
1421
ok (mpf(substr('1-1231',1,4)) == -123);
1422
ok (mpf(-123.0) == -123);
1423
ok (mpf(mpz(-123)) == -123);
1424
ok (mpf(mpq(-123)) == -123);
1425
ok (mpf(mpf(-123)) == -123);
1426

1427
{ tie my $t, 'Mytie', -123; ok (mpf($t) == -123); }
1428
{ tie my $t, 'Mytie', '-123'; ok (mpf($t) == -123); }
1429
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpf($t) == -123); }
1430
{ tie my $t, 'Mytie', -123.0; ok (mpf($t) == -123); }
1431
{ tie my $t, 'Mytie', mpz(-123); ok (mpf($t) == -123); }
1432
{ tie my $t, 'Mytie', mpq(-123); ok (mpf($t) == -123); }
1433
{ tie my $t, 'Mytie', mpf(-123); ok (mpf($t) == -123); }
1434

1435
ok (mpf($ivnv_2p128) == $str_2p128);
1436
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpf($t) == $str_2p128); }
1437

1438
ok (mpf(-1.5) == -1.5);
1439
ok (mpf(-1.0) == -1.0);
1440
ok (mpf(-0.5) == -0.5);
1441
ok (mpf(0) == 0);
1442
ok (mpf(0.5) == 0.5);
1443
ok (mpf(1.0) == 1.0);
1444
ok (mpf(1.5) == 1.5);
1445

1446
ok (mpf("-1.5") == -1.5);
1447
ok (mpf("-1.0") == -1.0);
1448
ok (mpf("-0.5") == -0.5);
1449
ok (mpf("0") == 0);
1450
ok (mpf("0.5") == 0.5);
1451
ok (mpf("1.0") == 1.0);
1452
ok (mpf("1.5") == 1.5);
1453

1454
ok (mpf($uv_max) > 0);
1455
ok (mpf($uv_max) == mpf($uv_max_str));
1456
{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) > 0); }
1457
{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) == mpf($uv_max_str)); }
1458

1459
{ my $x = 123.5;
1460
  kill (0, $x);
1461
  ok (mpf($x) == 123.5);
1462
  tie my $t, 'Mytie', $x;
1463
  ok (mpf($t) == 123.5);
1464
}
1465

1466
#------------------------------------------------------------------------------
1467
# GMP::Mpf::overload_abs
1468

1469
ok (abs(mpf(0)) == 0);
1470
ok (abs(mpf(123)) == 123);
1471
ok (abs(mpf(-123)) == 123);
1472

1473
{ my $x = mpf(-123); $x = abs($x); ok ($x == 123); }
1474
{ my $x = mpf(0);    $x = abs($x); ok ($x == 0);   }
1475
{ my $x = mpf(123);  $x = abs($x); ok ($x == 123); }
1476

1477
{ tie my $t, 'Mytie', mpf(0); ok (abs($t) == 0); }
1478
{ tie my $t, 'Mytie', mpf(123); ok (abs($t) == 123); }
1479
{ tie my $t, 'Mytie', mpf(-123); ok (abs($t) == 123); }
1480

1481
#------------------------------------------------------------------------------
1482
# GMP::Mpf::overload_add
1483

1484
ok (mpf(0) + 1 == 1);
1485
ok (mpf(-1) + 1 == 0);
1486
ok (1 + mpf(0) == 1);
1487
ok (1 + mpf(-1) == 0);
1488

1489
#------------------------------------------------------------------------------
1490
# GMP::Mpf::overload_addeq
1491

1492
{ my $a = mpf(7); $a += 1; ok ($a == 8); }
1493
{ my $a = mpf(7); my $b = $a; $a += 1; ok ($a == 8); ok ($b == 7); }
1494

1495
#------------------------------------------------------------------------------
1496
# GMP::Mpf::overload_bool
1497

1498
if (mpf(0))   { ok (0); } else { ok (1); }
1499
if (mpf(123)) { ok (1); } else { ok (0); }
1500

1501
#------------------------------------------------------------------------------
1502
# GMP::Mpf::overload_dec
1503

1504
{ my $a = mpf(0); ok ($a-- == 0); ok ($a == -1); }
1505
{ my $a = mpf(0); ok (--$a == -1); }
1506

1507
{ my $a = mpf(0); my $b = $a; $a--; ok ($a == -1); ok ($b == 0); }
1508

1509
#------------------------------------------------------------------------------
1510
# GMP::Mpf::overload_div
1511

1512
ok (mpf(6) / 2 == 3);
1513
ok (mpf(-6) / 2 == -3);
1514
ok (mpf(6) / -2 == -3);
1515
ok (mpf(-6) / -2 == 3);
1516

1517
#------------------------------------------------------------------------------
1518
# GMP::Mpf::overload_diveq
1519

1520
{ my $a = mpf(21); $a /= 3; ok ($a == 7); }
1521
{ my $a = mpf(21); my $b = $a; $a /= 3; ok ($a == 7); ok ($b == 21); }
1522

1523
#------------------------------------------------------------------------------
1524
# GMP::Mpf::overload_eq
1525

1526
{ my $a = mpf(0);
1527
  my $b = $a;
1528
  $a = mpf(1);
1529
  ok ($a == 1);
1530
  ok ($b == 0); }
1531

1532
#------------------------------------------------------------------------------
1533
# GMP::Mpf::overload_inc
1534

1535
{ my $a = mpf(0); ok ($a++ == 0); ok ($a == 1); }
1536
{ my $a = mpf(0); ok (++$a == 1); }
1537

1538
{ my $a = mpf(0); my $b = $a; $a++; ok ($a == 1); ok ($b == 0); }
1539

1540
#------------------------------------------------------------------------------
1541
# GMP::Mpf::overload_lshift
1542

1543
{ my $a = mpf(7) << 1; ok ($a == 14); }
1544

1545
#------------------------------------------------------------------------------
1546
# GMP::Mpf::overload_lshifteq
1547

1548
{ my $a = mpf(7); $a <<= 1; ok ($a == 14); }
1549
{ my $a = mpf(7); my $b = $a; $a <<= 1; ok ($a == 14); ok ($b == 7); }
1550

1551
#------------------------------------------------------------------------------
1552
# GMP::Mpf::overload_mul
1553

1554
ok (mpf(2) * 3 == 6);
1555

1556
#------------------------------------------------------------------------------
1557
# GMP::Mpf::overload_muleq
1558

1559
{ my $a = mpf(7); $a *= 3;  ok ($a == 21); }
1560
{ my $a = mpf(7); my $b = $a; $a *= 3;  ok ($a == 21); ok ($b == 7); }
1561

1562
#------------------------------------------------------------------------------
1563
# GMP::Mpf::overload_neg
1564

1565
ok (- mpf(0) == 0);
1566
ok (- mpf(123) == -123);
1567
ok (- mpf(-123) == 123);
1568

1569
#------------------------------------------------------------------------------
1570
# GMP::Mpf::overload_not
1571

1572
if (not mpf(0))   { ok (1); } else { ok (0); }
1573
if (not mpf(123)) { ok (0); } else { ok (1); }
1574

1575
ok ((! mpf(0)) == 1);
1576
ok ((! mpf(123)) == 0);
1577

1578
#------------------------------------------------------------------------------
1579
# GMP::Mpf::overload_pow
1580

1581
ok (mpf(0) ** 1 == 0);
1582
ok (mpf(1) ** 1 == 1);
1583
ok (mpf(2) ** 0 == 1);
1584
ok (mpf(2) ** 1 == 2);
1585
ok (mpf(2) ** 2 == 4);
1586
ok (mpf(2) ** 3 == 8);
1587
ok (mpf(2) ** 4 == 16);
1588

1589
ok (mpf(0) ** mpf(1) == 0);
1590
ok (mpf(1) ** mpf(1) == 1);
1591
ok (mpf(2) ** mpf(0) == 1);
1592
ok (mpf(2) ** mpf(1) == 2);
1593
ok (mpf(2) ** mpf(2) == 4);
1594
ok (mpf(2) ** mpf(3) == 8);
1595
ok (mpf(2) ** mpf(4) == 16);
1596

1597
#------------------------------------------------------------------------------
1598
# GMP::Mpf::overload_poweq
1599

1600
{ my $a = mpf(3); $a **= 4; ok ($a == 81); }
1601
{ my $a = mpf(3); my $b = $a; $a **= 4; ok ($a == 81); ok ($b == 3); }
1602

1603
#------------------------------------------------------------------------------
1604
# GMP::Mpf::overload_rshift
1605

1606
{ my $a = mpf(32) >> 1; ok ($a == 16); }
1607

1608
#------------------------------------------------------------------------------
1609
# GMP::Mpf::overload_rshifteq
1610

1611
{ my $a = mpf(32); $a >>= 1; ok ($a == 16); }
1612
{ my $a = mpf(32); my $b = $a; $a >>= 1; ok ($a == 16); ok ($b == 32); }
1613

1614
#------------------------------------------------------------------------------
1615
# GMP::Mpf::overload_sqrt
1616

1617
ok (sqrt(mpf(0)) == 0);
1618
ok (sqrt(mpf(1)) == 1);
1619
ok (sqrt(mpf(4)) == 2);
1620
ok (sqrt(mpf(81)) == 9);
1621

1622
ok (sqrt(mpf(0.25)) == 0.5);
1623

1624
#------------------------------------------------------------------------------
1625
# GMP::Mpf::overload_spaceship
1626

1627
ok (mpf(0) < 1);
1628
ok (mpf(0) > -1);
1629

1630
ok (mpf(0) != 1);
1631
ok (mpf(0) != -1);
1632
ok (mpf(1) != 0);
1633
ok (mpf(1) != -1);
1634
ok (mpf(-1) != 0);
1635
ok (mpf(-1) != 1);
1636

1637
ok (mpf(0) < 1.0);
1638
ok (mpf(0) < '1');
1639
ok (mpf(0) < substr('-1',1,1));
1640
ok (mpf(0) < mpz(1));
1641
ok (mpf(0) < mpq(1));
1642
ok (mpf(0) < mpf(1));
1643
ok (mpf(0) < $uv_max);
1644

1645
#------------------------------------------------------------------------------
1646
# GMP::Mpf::overload_string
1647

1648
{ my $x = mpf(0);    ok ("$x" eq "0"); }
1649
{ my $x = mpf(123);  ok ("$x" eq "123"); }
1650
{ my $x = mpf(-123); ok ("$x" eq "-123"); }
1651

1652
{ my $f = mpf(0.25);   	 ok ("$f" eq "0.25"); }
1653
{ my $f = mpf(-0.25);  	 ok ("$f" eq "-0.25"); }
1654
{ my $f = mpf(1.25);   	 ok ("$f" eq "1.25"); }
1655
{ my $f = mpf(-1.25);  	 ok ("$f" eq "-1.25"); }
1656
{ my $f = mpf(1000000);	 ok ("$f" eq "1000000"); }
1657
{ my $f = mpf(-1000000); ok ("$f" eq "-1000000"); }
1658

1659
#------------------------------------------------------------------------------
1660
# GMP::Mpf::overload_sub
1661

1662
ok (mpf(0) - 1 == -1);
1663
ok (mpf(1) - 1 == 0);
1664
ok (1 - mpf(0) == 1);
1665
ok (1 - mpf(1) == 0);
1666

1667
#------------------------------------------------------------------------------
1668
# GMP::Mpf::overload_subeq
1669

1670
{ my $a = mpf(7); $a -= 1; ok ($a == 6); }
1671
{ my $a = mpf(7); my $b = $a; $a -= 1; ok ($a == 6); ok ($b == 7); }
1672

1673

1674
#------------------------------------------------------------------------------
1675
# GMP::Mpf::ceil
1676

1677
ok (ceil (mpf(-7.5)) == -7.0);
1678
ok (ceil (mpf(7.5)) == 8.0);
1679

1680
#------------------------------------------------------------------------------
1681
# GMP::Mpf::floor
1682

1683
ok (floor(mpf(-7.5)) == -8.0);
1684
ok (floor(mpf(7.5)) == 7.0);
1685

1686
#------------------------------------------------------------------------------
1687
# GMP::Mpf::mpf_eq
1688

1689
{ my $old_prec = get_default_prec();
1690
  set_default_prec(128);
1691

1692
  ok (  mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1));
1693
  ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128));
1694

1695
  set_default_prec($old_prec);
1696
}
1697

1698
#------------------------------------------------------------------------------
1699
# GMP::Mpf::get_default_prec
1700

1701
get_default_prec();
1702

1703
#------------------------------------------------------------------------------
1704
# GMP::Mpf::get_prec
1705

1706
{ my $x = mpf(1.0, 512);
1707
  ok (get_prec ($x) == 512);
1708
}
1709

1710
#------------------------------------------------------------------------------
1711
# GMP::Mpf::reldiff
1712

1713
ok (reldiff (2,4) == 1);
1714
ok (reldiff (4,2) == 0.5);
1715

1716
#------------------------------------------------------------------------------
1717
# GMP::Mpf::set_default_prec
1718

1719
{ my $old_prec = get_default_prec();
1720

1721
  set_default_prec(512);
1722
  ok (get_default_prec () == 512);
1723

1724
  set_default_prec($old_prec);
1725
}
1726

1727
#------------------------------------------------------------------------------
1728
# GMP::Mpf::set_prec
1729

1730
{ my $x = mpf(1.0, 512);
1731
  my $y = $x;
1732
  set_prec ($x, 1024);
1733
  ok (get_prec ($x) == 1024);
1734
  ok (get_prec ($y) == 512);
1735
}
1736

1737
#------------------------------------------------------------------------------
1738
# GMP::Mpf::trunc
1739

1740
ok (trunc(mpf(-7.5)) == -7.0);
1741
ok (trunc(mpf(7.5)) == 7.0);
1742

1743

1744

1745
#------------------------------------------------------------------------------
1746
# GMP::Rand
1747

1748
#------------------------------------------------------------------------------
1749
# GMP::Rand::new
1750

1751
{ my $r = randstate();                          ok (defined $r); }
1752
{ my $r = randstate('lc_2exp', 1, 2, 3);        ok (defined $r); }
1753
{ my $r = randstate('lc_2exp_size', 64);        ok (defined $r); }
1754
{ my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); }
1755
{ my $r = randstate('mt');                      ok (defined $r); }
1756

1757
{ # copying a randstate results in same sequence
1758
  my $r1 = randstate('lc_2exp_size', 64);
1759
  $r1->seed(123);
1760
  my $r2 = randstate($r1);
1761
  for (1 .. 20) {
1762
    my $z1 = mpz_urandomb($r1, 20);
1763
    my $z2 = mpz_urandomb($r2, 20);
1764
    ok ($z1 == $z2);
1765
  }
1766
}
1767

1768
#------------------------------------------------------------------------------
1769
# GMP::Rand::seed
1770

1771
{ my $r = randstate();
1772
  $r->seed(123);
1773
  $r->seed(time());
1774
}
1775

1776
#------------------------------------------------------------------------------
1777
# GMP::Rand::mpf_urandomb
1778

1779
{ my $r = randstate();
1780
  my $f = mpf_urandomb($r,1024);
1781
  ok (UNIVERSAL::isa($f,"GMP::Mpf")); }
1782

1783
#------------------------------------------------------------------------------
1784
# GMP::Rand::mpz_urandomb
1785

1786
{ my $r = randstate();
1787
  my $z = mpz_urandomb($r, 1024);
1788
  ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
1789

1790
#------------------------------------------------------------------------------
1791
# GMP::Rand::mpz_rrandomb
1792

1793
{ my $r = randstate();
1794
  my $z = mpz_rrandomb($r, 1024);
1795
  ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
1796

1797
#------------------------------------------------------------------------------
1798
# GMP::Rand::mpz_urandomm
1799

1800
{ my $r = randstate();
1801
  my $z = mpz_urandomm($r, mpz(3)**100);
1802
  ok (UNIVERSAL::isa($z,"GMP::Mpz")); }
1803

1804
#------------------------------------------------------------------------------
1805
# GMP::Rand::mpz_urandomb_ui
1806

1807
{ my $r = randstate();
1808
  foreach (1 .. 20) {
1809
    my $u = gmp_urandomb_ui($r,8);
1810
    ok ($u >= 0);
1811
    ok ($u < 256);
1812
  }
1813
}
1814

1815
#------------------------------------------------------------------------------
1816
# GMP::Rand::mpz_urandomm_ui
1817

1818
{ my $r = randstate();
1819
  foreach (1 .. 20) {
1820
    my $u = gmp_urandomm_ui($r,8);
1821
    ok ($u >= 0);
1822
    ok ($u < 8);
1823
  }
1824
}
1825

1826

1827

1828

1829
#------------------------------------------------------------------------------
1830
# GMP module
1831

1832
#------------------------------------------------------------------------------
1833
# GMP::fits_slong_p
1834

1835
ok (GMP::fits_slong_p(0));
1836

1837
# in perl 5.005 uv_max is only 32-bits on a 64-bit system, so won't exceed a
1838
# long
1839
# ok (! GMP::fits_slong_p($uv_max));
1840

1841
ok (GMP::fits_slong_p(0.0));
1842

1843
ok (GMP::fits_slong_p('0'));
1844

1845
ok (GMP::fits_slong_p(substr('999999999999999999999999999999',1,1)));
1846

1847
ok (! mpz("-9999999999999999999999999999999999999999999")->fits_slong_p());
1848
ok (  mpz(-123)->fits_slong_p());
1849
ok (  mpz(0)->fits_slong_p());
1850
ok (  mpz(123)->fits_slong_p());
1851
ok (! mpz("9999999999999999999999999999999999999999999")->fits_slong_p());
1852

1853
ok (! mpq("-9999999999999999999999999999999999999999999")->fits_slong_p());
1854
ok (  mpq(-123)->fits_slong_p());
1855
ok (  mpq(0)->fits_slong_p());
1856
ok (  mpq(123)->fits_slong_p());
1857
ok (! mpq("9999999999999999999999999999999999999999999")->fits_slong_p());
1858

1859
ok (! mpf("-9999999999999999999999999999999999999999999")->fits_slong_p());
1860
ok (  mpf(-123)->fits_slong_p());
1861
ok (  mpf(0)->fits_slong_p());
1862
ok (  mpf(123)->fits_slong_p());
1863
ok (! mpf("9999999999999999999999999999999999999999999")->fits_slong_p());
1864

1865
#------------------------------------------------------------------------------
1866
# GMP::get_d
1867

1868
ok (GMP::get_d(123) == 123.0);
1869

1870
ok (GMP::get_d($uv_max) > 0);
1871

1872
ok (GMP::get_d(123.0) == 123.0);
1873

1874
ok (GMP::get_d('123') == 123.0);
1875

1876
ok (GMP::get_d(mpz(123)) == 123.0);
1877

1878
ok (GMP::get_d(mpq(123)) == 123.0);
1879

1880
ok (GMP::get_d(mpf(123)) == 123.0);
1881

1882
#------------------------------------------------------------------------------
1883
# GMP::get_d_2exp
1884

1885
{ my ($dbl, $exp) = get_d_2exp (0);
1886
  ok ($dbl == 0); ok ($exp == 0); }
1887
{ my ($dbl, $exp) = get_d_2exp (1);
1888
  ok ($dbl == 0.5); ok ($exp == 1); }
1889

1890
{ my ($dbl, $exp) = get_d_2exp ($uv_max);
1891
  ok ($dbl > 0.0); ok ($exp > 0); }
1892

1893
{ my ($dbl, $exp) = get_d_2exp (0.5);
1894
  ok ($dbl == 0.5); ok ($exp == 0); }
1895
{ my ($dbl, $exp) = get_d_2exp (0.25);
1896
  ok ($dbl == 0.5); ok ($exp == -1); }
1897

1898
{ my ($dbl, $exp) = get_d_2exp ("1.0");
1899
  ok ($dbl == 0.5); ok ($exp == 1); }
1900

1901
{ my ($dbl, $exp) = get_d_2exp (mpz ("256"));
1902
  ok ($dbl == 0.5); ok ($exp == 9); }
1903

1904
{ my ($dbl, $exp) = get_d_2exp (mpq ("1/16"));
1905
  ok ($dbl == 0.5); ok ($exp == -3); }
1906

1907
{ my ($dbl, $exp) = get_d_2exp (mpf ("1.5"));
1908
  ok ($dbl == 0.75); ok ($exp == 1); }
1909
{ my ($dbl, $exp) = get_d_2exp (mpf ("3.0"));
1910
  ok ($dbl == 0.75); ok ($exp == 2); }
1911

1912
#------------------------------------------------------------------------------
1913
# GMP::get_str
1914

1915
ok (get_str(-123) eq '-123');
1916
ok (get_str('-123') eq '-123');
1917
ok (get_str(substr('x-123x',1,4)) eq '-123');
1918
ok (get_str(mpz(-123)) eq '-123');
1919
ok (get_str(mpq(-123)) eq '-123');
1920

1921
ok (get_str(-123,10) eq '-123');
1922
ok (get_str('-123',10) eq '-123');
1923
ok (get_str(substr('x-123x',1,4),10) eq '-123');
1924
ok (get_str(mpz(-123),10) eq '-123');
1925
ok (get_str(mpq(-123),10) eq '-123');
1926

1927
ok (get_str(-123,16) eq '-7b');
1928
ok (get_str('-123',16) eq '-7b');
1929
ok (get_str(substr('x-123x',1,4),16) eq '-7b');
1930
ok (get_str(mpz(-123),16) eq '-7b');
1931
ok (get_str(mpq(-123),16) eq '-7b');
1932

1933
ok (get_str(-123,-16) eq '-7B');
1934
ok (get_str('-123',-16) eq '-7B');
1935
ok (get_str(substr('x-123x',1,4),-16) eq '-7B');
1936
ok (get_str(mpz(-123),-16) eq '-7B');
1937
ok (get_str(mpq(-123),-16) eq '-7B');
1938

1939
# is a float in past versions of perl without UV type
1940
{ my ($str, $exp) = get_str($uv_max);
1941
  ok ($str eq $uv_max_str); }
1942

1943
ok (get_str(mpq(5/8)) eq "5/8");
1944
ok (get_str(mpq(-5/8)) eq "-5/8");
1945
ok (get_str(mpq(255/256),16) eq "ff/100");
1946
ok (get_str(mpq(255/256),-16) eq "FF/100");
1947
ok (get_str(mpq(-255/256),16) eq "-ff/100");
1948
ok (get_str(mpq(-255/256),-16) eq "-FF/100");
1949

1950
{ my ($s,$e) = get_str(1.5, 10);      ok ($s eq '15'); ok ($e == 1); }
1951
{ my ($s,$e) = get_str(mpf(1.5), 10); ok ($s eq '15'); ok ($e == 1); }
1952

1953
{ my ($s,$e) = get_str(-1.5, 10);      ok ($s eq '-15'); ok ($e == 1); }
1954
{ my ($s,$e) = get_str(mpf(-1.5), 10); ok ($s eq '-15'); ok ($e == 1); }
1955

1956
{ my ($s,$e) = get_str(1.5, 16);      ok ($s eq '18'); ok ($e == 1); }
1957
{ my ($s,$e) = get_str(mpf(1.5), 16); ok ($s eq '18'); ok ($e == 1); }
1958

1959
{ my ($s,$e) = get_str(-1.5, 16);      ok ($s eq '-18'); ok ($e == 1); }
1960
{ my ($s,$e) = get_str(mpf(-1.5), 16); ok ($s eq '-18'); ok ($e == 1); }
1961

1962
{ my ($s,$e) = get_str(65536.0, 16);      ok ($s eq '1'); ok ($e == 5); }
1963
{ my ($s,$e) = get_str(mpf(65536.0), 16); ok ($s eq '1'); ok ($e == 5); }
1964

1965
{ my ($s,$e) = get_str(1.625, 16);      ok ($s eq '1a'); ok ($e == 1); }
1966
{ my ($s,$e) = get_str(mpf(1.625), 16); ok ($s eq '1a'); ok ($e == 1); }
1967

1968
{ my ($s,$e) = get_str(1.625, -16);      ok ($s eq '1A'); ok ($e == 1); }
1969
{ my ($s,$e) = get_str(mpf(1.625), -16); ok ($s eq '1A'); ok ($e == 1); }
1970

1971
{ my ($s, $e) = get_str(255.0,16,0);      ok ($s eq "ff"); ok ($e == 2); }
1972
{ my ($s, $e) = get_str(mpf(255.0),16,0); ok ($s eq "ff"); ok ($e == 2); }
1973

1974
{ my ($s, $e) = get_str(255.0,-16,0);      ok ($s eq "FF"); ok ($e == 2); }
1975
{ my ($s, $e) = get_str(mpf(255.0),-16,0); ok ($s eq "FF"); ok ($e == 2); }
1976

1977
#------------------------------------------------------------------------------
1978
# GMP::get_si
1979

1980
ok (GMP::get_si(123) == 123.0);
1981

1982
# better not assume anything about the relatives sizes of long and UV
1983
ok (GMP::get_si($uv_max) != 0);
1984

1985
ok (GMP::get_si(123.0) == 123.0);
1986

1987
ok (GMP::get_si('123') == 123.0);
1988

1989
ok (GMP::get_si(mpz(123)) == 123.0);
1990

1991
ok (GMP::get_si(mpq(123)) == 123.0);
1992

1993
ok (GMP::get_si(mpf(123)) == 123.0);
1994

1995
#------------------------------------------------------------------------------
1996
# GMP::integer_p
1997

1998
ok (  GMP::integer_p (0));
1999
ok (  GMP::integer_p (123));
2000
ok (  GMP::integer_p (-123));
2001

2002
ok (  GMP::integer_p ($uv_max));
2003

2004
ok (  GMP::integer_p (0.0));
2005
ok (  GMP::integer_p (123.0));
2006
ok (  GMP::integer_p (-123.0));
2007
ok (! GMP::integer_p (0.5));
2008
ok (! GMP::integer_p (123.5));
2009
ok (! GMP::integer_p (-123.5));
2010

2011
ok (  GMP::integer_p ('0'));
2012
ok (  GMP::integer_p ('123'));
2013
ok (  GMP::integer_p ('-123'));
2014
ok (! GMP::integer_p ('0.5'));
2015
ok (! GMP::integer_p ('123.5'));
2016
ok (! GMP::integer_p ('-123.5'));
2017
ok (! GMP::integer_p ('5/8'));
2018

2019
ok (  GMP::integer_p (mpz(1)));
2020

2021
ok (  GMP::integer_p (mpq(1)));
2022
ok (! GMP::integer_p (mpq(1,2)));
2023

2024
ok (  GMP::integer_p (mpf(1.0)));
2025
ok (! GMP::integer_p (mpf(1.5)));
2026

2027
#------------------------------------------------------------------------------
2028
# GMP::odd_p
2029

2030
ok (! odd_p(0));
2031
ok (  odd_p(1));
2032
ok (! odd_p(2));
2033

2034
ok (  odd_p($uv_max));
2035

2036
ok (  odd_p(mpz(-3)));
2037
ok (! odd_p(mpz(-2)));
2038
ok (  odd_p(mpz(-1)));
2039
ok (! odd_p(mpz(0)));
2040
ok (  odd_p(mpz(1)));
2041
ok (! odd_p(mpz(2)));
2042
ok (  odd_p(mpz(3)));
2043

2044
#------------------------------------------------------------------------------
2045
# GMP::printf
2046

2047
GMP::printf ("hello world\n");
2048

2049
sub via_printf {
2050
  my $s;
2051
  open TEMP, ">test.tmp" or die;
2052
  GMP::printf TEMP @_;
2053
  close TEMP or die;
2054
  open TEMP, "<test.tmp" or die;
2055
  read (TEMP, $s, 1024);
2056
  close TEMP or die;
2057
  unlink 'test.tmp';
2058
  return $s;
2059
}
2060

2061
ok (sprintf ("%d", mpz(123)) eq '123');
2062
ok (sprintf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
2063
ok (sprintf ("%d", mpq(15,16)) eq '15/16');
2064
ok (sprintf ("%f", mpf(1.5)) eq '1.500000');
2065
ok (sprintf ("%.2f", mpf(1.5)) eq '1.50');
2066

2067
ok (sprintf ("%*d", 6, 123) eq '   123');
2068
ok (sprintf ("%*d", 6, mpz(123))  eq '   123');
2069
ok (sprintf ("%*d", 6, mpq(15,16))  eq ' 15/16');
2070

2071
ok (sprintf ("%x", 123) eq '7b');
2072
ok (sprintf ("%x", mpz(123))  eq '7b');
2073
ok (sprintf ("%X", 123) eq '7B');
2074
ok (sprintf ("%X", mpz(123))  eq '7B');
2075
ok (sprintf ("%#x", 123) eq '0x7b');
2076
ok (sprintf ("%#x", mpz(123))  eq '0x7b');
2077
ok (sprintf ("%#X", 123) eq '0X7B');
2078
ok (sprintf ("%#X", mpz(123))  eq '0X7B');
2079

2080
ok (sprintf ("%x", mpq(15,16))  eq 'f/10');
2081
ok (sprintf ("%X", mpq(15,16))  eq 'F/10');
2082
ok (sprintf ("%#x", mpq(15,16))  eq '0xf/0x10');
2083
ok (sprintf ("%#X", mpq(15,16))  eq '0XF/0X10');
2084

2085
ok (sprintf ("%*.*f", 10, 3, 1.25) eq '     1.250');
2086
ok (sprintf ("%*.*f", 10, 3, mpf(1.5))   eq '     1.500');
2087

2088
ok (via_printf ("%d", mpz(123)) eq '123');
2089
ok (via_printf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
2090
ok (via_printf ("%d", mpq(15,16)) eq '15/16');
2091
ok (via_printf ("%f", mpf(1.5)) eq '1.500000');
2092
ok (via_printf ("%.2f", mpf(1.5)) eq '1.50');
2093

2094
ok (via_printf ("%*d", 6, 123) eq '   123');
2095
ok (via_printf ("%*d", 6, mpz(123))  eq '   123');
2096
ok (via_printf ("%*d", 6, mpq(15,16))  eq ' 15/16');
2097

2098
ok (via_printf ("%x", 123) eq '7b');
2099
ok (via_printf ("%x", mpz(123))  eq '7b');
2100
ok (via_printf ("%X", 123) eq '7B');
2101
ok (via_printf ("%X", mpz(123))  eq '7B');
2102
ok (via_printf ("%#x", 123) eq '0x7b');
2103
ok (via_printf ("%#x", mpz(123))  eq '0x7b');
2104
ok (via_printf ("%#X", 123) eq '0X7B');
2105
ok (via_printf ("%#X", mpz(123))  eq '0X7B');
2106

2107
ok (via_printf ("%x", mpq(15,16))  eq 'f/10');
2108
ok (via_printf ("%X", mpq(15,16))  eq 'F/10');
2109
ok (via_printf ("%#x", mpq(15,16))  eq '0xf/0x10');
2110
ok (via_printf ("%#X", mpq(15,16))  eq '0XF/0X10');
2111

2112
ok (via_printf ("%*.*f", 10, 3, 1.25) eq '     1.250');
2113
ok (via_printf ("%*.*f", 10, 3, mpf(1.5))   eq '     1.500');
2114

2115
#------------------------------------------------------------------------------
2116
# GMP::sgn
2117

2118
ok (sgn(-123) == -1);
2119
ok (sgn(0)    == 0);
2120
ok (sgn(123)  == 1);
2121

2122
ok (sgn($uv_max) == 1);
2123

2124
ok (sgn(-123.0) == -1);
2125
ok (sgn(0.0)    == 0);
2126
ok (sgn(123.0)  == 1);
2127

2128
ok (sgn('-123') == -1);
2129
ok (sgn('0')    == 0);
2130
ok (sgn('123')  == 1);
2131
ok (sgn('-123.0') == -1);
2132
ok (sgn('0.0')    == 0);
2133
ok (sgn('123.0')  == 1);
2134

2135
ok (sgn(substr('x-123x',1,4)) == -1);
2136
ok (sgn(substr('x0x',1,1))    == 0);
2137
ok (sgn(substr('x123x',1,3))  == 1);
2138

2139
ok (mpz(-123)->sgn() == -1);
2140
ok (mpz(0)   ->sgn() == 0);
2141
ok (mpz(123) ->sgn() == 1);
2142

2143
ok (mpq(-123)->sgn() == -1);
2144
ok (mpq(0)   ->sgn() == 0);
2145
ok (mpq(123) ->sgn() == 1);
2146

2147
ok (mpf(-123)->sgn() == -1);
2148
ok (mpf(0)   ->sgn() == 0);
2149
ok (mpf(123) ->sgn() == 1);
2150

2151

2152

2153
#------------------------------------------------------------------------------
2154
# overloaded constants
2155

2156
if ($] > 5.00503) {
2157
  if (! do 'test2.pl') {
2158
    die "Cannot run test2.pl\n";
2159
  }
2160
}
2161

2162

2163

2164

2165
#------------------------------------------------------------------------------
2166
# $# stuff
2167
#
2168
# For some reason "local $#" doesn't leave $# back at its default undefined
2169
# state when exiting the block.
2170

2171
{ local $# = 'hi %.0f there';
2172
  my $f = mpf(123);
2173
  ok ("$f" eq 'hi 123 there'); }
2174

2175

2176

2177
# Local variables:
2178
# perl-indent-level: 2
2179
# End:
2180

2181
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

Product

Resources

Company

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more, all in one place.

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
