# Copyright 2001-2003 Free Software Foundation, Inc. # # This file is part of the GNU MP Library. # # The GNU MP Library is free software; you can redistribute it and/or modify # it under the terms of either: # # * the GNU Lesser General Public License as published by the Free # Software Foundation; either version 3 of the License, or (at your # option) any later version. # # or # # * the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any # later version. # # or both in parallel, as here. # # The GNU MP Library is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received copies of the GNU General Public License and the # GNU Lesser General Public License along with the GNU MP Library. If not, # see https://www.gnu.org/licenses/.
# These tests aim to exercise the many possible combinations of operands # etc, and to run all functions at least once, which if nothing else will # check everything intended is in the :all list. # # Use the following in .emacs to match test failure messages. # # ;; perl "Test" module error messages # (eval-after-load "compile" # '(add-to-list # 'compilation-error-regexp-alist # '("^.*Failed test [0-9]+ in \\([^ ]+\\) at line \\([0-9]+\\)" 1 2)))
use strict;
use Test;
BEGIN {
plan tests => 123,
onfail => sub { print "there were failures\n" },
}
use GMP qw(:all);
use GMP::Mpz qw(:all);
use GMP::Mpq qw(:all);
use GMP::Mpf qw(:all);
use GMP::Rand qw(:all);
use GMP::Mpz qw(:constants);
use GMP::Mpz qw(:noconstants);
use GMP::Mpq qw(:constants);
use GMP::Mpq qw(:noconstants);
use GMP::Mpf qw(:constants);
use GMP::Mpf qw(:noconstants);
package Mytie;
use Exporter;
use vars qw($val $fetched $stored);
$val = 0;
$fetched = 0;
$stored = 0;
sub TIESCALAR {
my ($class, $newval) = @_;
my $var = 'mytie dummy refed var';
$val = $newval;
$fetched = 0;
$stored = 0;
return bless \$var, $class;
}
sub FETCH {
my ($self) = @_;
$fetched++;
return $val;
}
sub STORE {
my ($self, $newval) = @_;
$val = $newval;
$stored++;
}
package main;
# check Mytie does what it should
{ tie my $t, 'Mytie', 123;
ok ($Mytie::val == 123);
$Mytie::val = 456;
ok ($t == 456);
$t = 789;
ok ($Mytie::val == 789);
}
# Usage: str(x) # Return x forced to a string, not a PVIV. #
sub str {
my $s = "$_[0]" . "";
return $s;
}
ok (mpz(0) == 0);
ok (mpz('0') == 0);
ok (mpz(substr('101',1,1)) == 0);
ok (mpz(0.0) == 0);
ok (mpz(mpz(0)) == 0);
ok (mpz(mpq(0)) == 0);
ok (mpz(mpf(0)) == 0);
{ tie my $t, 'Mytie', 0;
ok (mpz($t) == 0);
ok ($Mytie::fetched > 0);
}
{ tie my $t, 'Mytie', '0';
ok (mpz($t) == 0);
ok ($Mytie::fetched > 0);
}
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpz($t) == 0); }
{ tie my $t, 'Mytie', 0.0; ok (mpz($t) == 0); }
{ tie my $t, 'Mytie', mpz(0); ok (mpz($t) == 0); }
{ tie my $t, 'Mytie', mpq(0); ok (mpz($t) == 0); }
{ tie my $t, 'Mytie', mpf(0); ok (mpz($t) == 0); }
ok (mpz(-123) == -123);
ok (mpz('-123') == -123);
ok (mpz(substr('1-1231',1,4)) == -123);
ok (mpz(-123.0) == -123);
ok (mpz(mpz(-123)) == -123);
ok (mpz(mpq(-123)) == -123);
ok (mpz(mpf(-123)) == -123);
{ tie my $t, 'Mytie', -123; ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', '-123'; ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', -123.0; ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', mpz(-123); ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', mpq(-123); ok (mpz($t) == -123); }
{ tie my $t, 'Mytie', mpf(-123); ok (mpz($t) == -123); }
ok (mpz($ivnv_2p128) == $str_2p128);
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpz($t) == $str_2p128); }
ok (mpz($uv_max) > 0);
ok (mpz($uv_max) == mpz($uv_max_str));
{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) > 0); }
{ tie my $t, 'Mytie', $uv_max; ok (mpz($t) == mpz($uv_max_str)); }
{ my $s = '999999999999999999999999999999';
kill (0, $s);
ok (mpz($s) == '999999999999999999999999999999');
tie my $t, 'Mytie', $s;
ok (mpz($t) == '999999999999999999999999999999');
}
ok (abs(mpz(0)) == 0);
ok (abs(mpz(123)) == 123);
ok (abs(mpz(-123)) == 123);
{ my $x = mpz(-123); $x = abs($x); ok ($x == 123); }
{ my $x = mpz(0); $x = abs($x); ok ($x == 0); }
{ my $x = mpz(123); $x = abs($x); ok ($x == 123); }
{ tie my $t, 'Mytie', mpz(0); ok (abs($t) == 0); }
{ tie my $t, 'Mytie', mpz(123); ok (abs($t) == 123); }
{ tie my $t, 'Mytie', mpz(-123); ok (abs($t) == 123); }
ok (mpz(0) != 1);
ok (mpz(0) != -1);
ok (mpz(1) != 0);
ok (mpz(1) != -1);
ok (mpz(-1) != 0);
ok (mpz(-1) != 1);
ok (mpz(0) < 1.0);
ok (mpz(0) < '1');
ok (mpz(0) < substr('-1',1,1));
ok (mpz(0) < mpz(1));
ok (mpz(0) < mpq(1));
ok (mpz(0) < mpf(1));
ok (mpz(0) < $uv_max);
{ my $a = mpz(3); clrbit ($a, 1); ok ($a == 1);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = mpz(3); clrbit ($a, 2); ok ($a == 3);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = 3; clrbit ($a, 1); ok ($a == 1);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = 3; clrbit ($a, 2); ok ($a == 3);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
# mutate only given variable
{ my $a = mpz(3);
my $b = $a;
clrbit ($a, 0);
ok ($a == 2);
ok ($b == 3);
}
{ my $a = 3;
my $b = $a;
clrbit ($a, 0);
ok ($a == 2);
ok ($b == 3);
}
{ tie my $a, 'Mytie', mpz(3);
clrbit ($a, 1);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 1); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ tie my $a, 'Mytie', 3;
clrbit ($a, 1);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 1); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ my $b = mpz(3);
tie my $a, 'Mytie', $b;
clrbit ($a, 0);
ok ($a == 2);
ok ($b == 3);
ok (tied($a));
}
{ my $b = 3;
tie my $a, 'Mytie', $b;
clrbit ($a, 0);
ok ($a == 2);
ok ($b == 3);
ok (tied($a));
}
{ my $a = mpz(3); combit ($a, 1); ok ($a == 1);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = mpz(3); combit ($a, 2); ok ($a == 7);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = 3; combit ($a, 1); ok ($a == 1);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
{ my $a = 3; combit ($a, 2); ok ($a == 7);
ok (UNIVERSAL::isa($a,"GMP::Mpz")); }
# mutate only given variable
{ my $a = mpz(3);
my $b = $a;
combit ($a, 0);
ok ($a == 2);
ok ($b == 3);
}
{ my $a = 3;
my $b = $a;
combit ($a, 0);
ok ($a == 2);
ok ($b == 3);
}
{ tie my $a, 'Mytie', mpz(3);
combit ($a, 2);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 7); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ tie my $a, 'Mytie', 3;
combit ($a, 2);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 7); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ my $b = mpz(3);
tie my $a, 'Mytie', $b;
combit ($a, 0);
ok ($a == 2);
ok ($b == 3);
ok (tied($a));
}
{ my $b = 3;
tie my $a, 'Mytie', $b;
combit ($a, 0);
ok ($a == 2);
ok ($b == 3);
ok (tied($a));
}
ok (! even_p(mpz(-3)));
ok ( even_p(mpz(-2)));
ok (! even_p(mpz(-1)));
ok ( even_p(mpz(0)));
ok (! even_p(mpz(1)));
ok ( even_p(mpz(2)));
ok (! even_p(mpz(3)));
ok (lcm (2) == 2);
ok (lcm (0) == 0);
ok (lcm (0,0) == 0);
ok (lcm (0,0,0) == 0);
ok (lcm (0,0,0,0) == 0);
ok (lcm (2,0) == 0);
ok (lcm (-2,0) == 0);
ok (lcm (2,3) == 6);
ok (lcm (2,3,4) == 12);
ok (lcm (2,-3) == 6);
ok (lcm (-2,3) == 6);
ok (lcm (-2,-3) == 6);
ok (lcm (mpz(2)**512,1) == mpz(2)**512);
ok (lcm (mpz(2)**512,-1) == mpz(2)**512);
ok (lcm (-mpz(2)**512,1) == mpz(2)**512);
ok (lcm (-mpz(2)**512,-1) == mpz(2)**512);
ok (lcm (mpz(2)**512,mpz(2)**512) == mpz(2)**512);
ok (lcm (mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
ok (lcm (-mpz(2)**512,mpz(2)**512) == mpz(2)**512);
ok (lcm (-mpz(2)**512,-mpz(2)**512) == mpz(2)**512);
# ok ( perfect_power_p(mpz(-27))); # ok (! perfect_power_p(mpz(-9))); # ok (! perfect_power_p(mpz(-1)));
ok ( perfect_power_p(mpz(0)));
ok ( perfect_power_p(mpz(1)));
ok (! perfect_power_p(mpz(2)));
ok (! perfect_power_p(mpz(3)));
ok ( perfect_power_p(mpz(4)));
ok ( perfect_power_p(mpz(9)));
ok ( perfect_power_p(mpz(27)));
ok ( perfect_power_p(mpz(81)));
ok (! perfect_square_p(mpz(-9)));
ok (! perfect_square_p(mpz(-1)));
ok ( perfect_square_p(mpz(0)));
ok ( perfect_square_p(mpz(1)));
ok (! perfect_square_p(mpz(2)));
ok (! perfect_square_p(mpz(3)));
ok ( perfect_square_p(mpz(4)));
ok ( perfect_square_p(mpz(9)));
ok (! perfect_square_p(mpz(27)));
ok ( perfect_square_p(mpz(81)));
{ my ($r,$e);
($r, $e) = roote(0,2);
ok ($r == 0);
ok ($e);
($r, $e) = roote(81,4);
ok ($r == 3);
ok ($e);
($r, $e) = roote(85,4);
ok ($r == 3);
ok (! $e);
}
{ my $a = mpz(3); setbit ($a, 1); ok ($a == 3); }
{ my $a = mpz(3); setbit ($a, 2); ok ($a == 7); }
{ my $a = 3; setbit ($a, 1); ok ($a == 3); }
{ my $a = 3; setbit ($a, 2); ok ($a == 7); }
# mutate only given variable
{ my $a = mpz(0);
my $b = $a;
setbit ($a, 0);
ok ($a == 1);
ok ($b == 0);
}
{ my $a = 0;
my $b = $a;
setbit ($a, 0);
ok ($a == 1);
ok ($b == 0);
}
{ tie my $a, 'Mytie', mpz(3);
setbit ($a, 2);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 7); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ tie my $a, 'Mytie', 3;
setbit ($a, 2);
ok ($Mytie::fetched > 0); # used fetch
ok ($Mytie::stored > 0); # used store
ok ($a == 7); # expected result
ok (UNIVERSAL::isa($a,"GMP::Mpz"));
ok (tied($a)); # still tied
}
{ my $b = mpz(2);
tie my $a, 'Mytie', $b;
setbit ($a, 0);
ok ($a == 3);
ok ($b == 2);
ok (tied($a));
}
{ my $b = 2;
tie my $a, 'Mytie', $b;
setbit ($a, 0);
ok ($a == 3);
ok ($b == 2);
ok (tied($a));
}
{
my ($root, $rem) = sqrtrem(mpz(0));
ok ($root == 0);
ok ($rem == 0);
}
{
my ($root, $rem) = sqrtrem(mpz(1));
ok ($root == 1);
ok ($rem == 0);
}
{
my ($root, $rem) = sqrtrem(mpz(2));
ok ($root == 1);
ok ($rem == 1);
}
{
my ($root, $rem) = sqrtrem(mpz(9));
ok ($root == 3);
ok ($rem == 0);
}
{
my ($root, $rem) = sqrtrem(mpz(35));
ok ($root == 5);
ok ($rem == 10);
}
{
my ($root, $rem) = sqrtrem(mpz(0));
ok ($root == 0);
ok ($rem == 0);
}
ok (mpq(0) == 0);
ok (mpq('0') == 0);
ok (mpq(substr('101',1,1)) == 0);
ok (mpq(0.0) == 0);
ok (mpq(mpz(0)) == 0);
ok (mpq(mpq(0)) == 0);
ok (mpq(mpf(0)) == 0);
{ tie my $t, 'Mytie', 0; ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', '0'; ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', 0.0; ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', mpz(0); ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', mpq(0); ok (mpq($t) == 0); }
{ tie my $t, 'Mytie', mpf(0); ok (mpq($t) == 0); }
ok (mpq(-123) == -123);
ok (mpq('-123') == -123);
ok (mpq(substr('1-1231',1,4)) == -123);
ok (mpq(-123.0) == -123);
ok (mpq(mpz(-123)) == -123);
ok (mpq(mpq(-123)) == -123);
ok (mpq(mpf(-123)) == -123);
{ tie my $t, 'Mytie', -123; ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', '-123'; ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', -123.0; ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', mpz(-123); ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', mpq(-123); ok (mpq($t) == -123); }
{ tie my $t, 'Mytie', mpf(-123); ok (mpq($t) == -123); }
ok (mpq($ivnv_2p128) == $str_2p128);
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpq($t) == $str_2p128); }
ok (mpq('3/2') == mpq(3,2));
ok (mpq('3/1') == mpq(3,1));
ok (mpq('-3/2') == mpq(-3,2));
ok (mpq('-3/1') == mpq(-3,1));
ok (mpq('0x3') == mpq(3,1));
ok (mpq('0b111') == mpq(7,1));
ok (mpq('0b0') == mpq(0,1));
ok (mpq($uv_max) > 0);
ok (mpq($uv_max) == mpq($uv_max_str));
{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) > 0); }
{ tie my $t, 'Mytie', $uv_max; ok (mpq($t) == mpq($uv_max_str)); }
{ my $x = 123.5;
kill (0, $x);
ok (mpq($x) == 123.5);
tie my $t, 'Mytie', $x;
ok (mpq($t) == 123.5);
}
ok (abs(mpq(0)) == 0);
ok (abs(mpq(123)) == 123);
ok (abs(mpq(-123)) == 123);
{ my $x = mpq(-123); $x = abs($x); ok ($x == 123); }
{ my $x = mpq(0); $x = abs($x); ok ($x == 0); }
{ my $x = mpq(123); $x = abs($x); ok ($x == 123); }
{ tie my $t, 'Mytie', mpq(0); ok (abs($t) == 0); }
{ tie my $t, 'Mytie', mpq(123); ok (abs($t) == 123); }
{ tie my $t, 'Mytie', mpq(-123); ok (abs($t) == 123); }
ok (mpq(0) != 1);
ok (mpq(0) != -1);
ok (mpq(1) != 0);
ok (mpq(1) != -1);
ok (mpq(-1) != 0);
ok (mpq(-1) != 1);
ok (mpq(3,2) > 1);
ok (mpq(3,2) < 2);
ok (mpq(0) < 1.0);
ok (mpq(0) < '1');
ok (mpq(0) < substr('-1',1,1));
ok (mpq(0) < mpz(1));
ok (mpq(0) < mpq(1));
ok (mpq(0) < mpf(1));
ok (mpq(0) < $uv_max);
ok (mpf(0) == 0);
ok (mpf('0') == 0);
ok (mpf(substr('101',1,1)) == 0);
ok (mpf(0.0) == 0);
ok (mpf(mpz(0)) == 0);
ok (mpf(mpq(0)) == 0);
ok (mpf(mpf(0)) == 0);
{ tie my $t, 'Mytie', 0; ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', '0'; ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', substr('101',1,1); ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', 0.0; ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', mpz(0); ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', mpq(0); ok (mpf($t) == 0); }
{ tie my $t, 'Mytie', mpf(0); ok (mpf($t) == 0); }
ok (mpf(-123) == -123);
ok (mpf('-123') == -123);
ok (mpf(substr('1-1231',1,4)) == -123);
ok (mpf(-123.0) == -123);
ok (mpf(mpz(-123)) == -123);
ok (mpf(mpq(-123)) == -123);
ok (mpf(mpf(-123)) == -123);
{ tie my $t, 'Mytie', -123; ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', '-123'; ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', substr('1-1231',1,4); ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', -123.0; ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', mpz(-123); ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', mpq(-123); ok (mpf($t) == -123); }
{ tie my $t, 'Mytie', mpf(-123); ok (mpf($t) == -123); }
ok (mpf($ivnv_2p128) == $str_2p128);
{ tie my $t, 'Mytie', $ivnv_2p128; ok (mpf($t) == $str_2p128); }
ok (mpf(-1.5) == -1.5);
ok (mpf(-1.0) == -1.0);
ok (mpf(-0.5) == -0.5);
ok (mpf(0) == 0);
ok (mpf(0.5) == 0.5);
ok (mpf(1.0) == 1.0);
ok (mpf(1.5) == 1.5);
ok (mpf("-1.5") == -1.5);
ok (mpf("-1.0") == -1.0);
ok (mpf("-0.5") == -0.5);
ok (mpf("0") == 0);
ok (mpf("0.5") == 0.5);
ok (mpf("1.0") == 1.0);
ok (mpf("1.5") == 1.5);
ok (mpf($uv_max) > 0);
ok (mpf($uv_max) == mpf($uv_max_str));
{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) > 0); }
{ tie my $t, 'Mytie', $uv_max; ok (mpf($t) == mpf($uv_max_str)); }
{ my $x = 123.5;
kill (0, $x);
ok (mpf($x) == 123.5);
tie my $t, 'Mytie', $x;
ok (mpf($t) == 123.5);
}
ok (abs(mpf(0)) == 0);
ok (abs(mpf(123)) == 123);
ok (abs(mpf(-123)) == 123);
{ my $x = mpf(-123); $x = abs($x); ok ($x == 123); }
{ my $x = mpf(0); $x = abs($x); ok ($x == 0); }
{ my $x = mpf(123); $x = abs($x); ok ($x == 123); }
{ tie my $t, 'Mytie', mpf(0); ok (abs($t) == 0); }
{ tie my $t, 'Mytie', mpf(123); ok (abs($t) == 123); }
{ tie my $t, 'Mytie', mpf(-123); ok (abs($t) == 123); }
ok (mpf(0) != 1);
ok (mpf(0) != -1);
ok (mpf(1) != 0);
ok (mpf(1) != -1);
ok (mpf(-1) != 0);
ok (mpf(-1) != 1);
ok (mpf(0) < 1.0);
ok (mpf(0) < '1');
ok (mpf(0) < substr('-1',1,1));
ok (mpf(0) < mpz(1));
ok (mpf(0) < mpq(1));
ok (mpf(0) < mpf(1));
ok (mpf(0) < $uv_max);
{ my $x = mpf(0); ok ("$x" eq "0"); }
{ my $x = mpf(123); ok ("$x" eq "123"); }
{ my $x = mpf(-123); ok ("$x" eq "-123"); }
{ my $f = mpf(0.25); ok ("$f" eq "0.25"); }
{ my $f = mpf(-0.25); ok ("$f" eq "-0.25"); }
{ my $f = mpf(1.25); ok ("$f" eq "1.25"); }
{ my $f = mpf(-1.25); ok ("$f" eq "-1.25"); }
{ my $f = mpf(1000000); ok ("$f" eq "1000000"); }
{ my $f = mpf(-1000000); ok ("$f" eq "-1000000"); }
{ my $r = randstate(); ok (defined $r); }
{ my $r = randstate('lc_2exp', 1, 2, 3); ok (defined $r); }
{ my $r = randstate('lc_2exp_size', 64); ok (defined $r); }
{ my $r = randstate('lc_2exp_size', 999999999); ok (! defined $r); }
{ my $r = randstate('mt'); ok (defined $r); }
{ # copying a randstate results in same sequence
my $r1 = randstate('lc_2exp_size', 64);
$r1->seed(123);
my $r2 = randstate($r1); for (1 .. 20) {
my $z1 = mpz_urandomb($r1, 20);
my $z2 = mpz_urandomb($r2, 20);
ok ($z1 == $z2);
}
}
# in perl 5.005 uv_max is only 32-bits on a 64-bit system, so won't exceed a # long # ok (! GMP::fits_slong_p($uv_max));
ok (GMP::fits_slong_p(0.0));
ok (GMP::fits_slong_p('0'));
ok (GMP::fits_slong_p(substr('999999999999999999999999999999',1,1)));
ok (! mpz("-9999999999999999999999999999999999999999999")->fits_slong_p());
ok ( mpz(-123)->fits_slong_p());
ok ( mpz(0)->fits_slong_p());
ok ( mpz(123)->fits_slong_p());
ok (! mpz("9999999999999999999999999999999999999999999")->fits_slong_p());
ok (! mpq("-9999999999999999999999999999999999999999999")->fits_slong_p());
ok ( mpq(-123)->fits_slong_p());
ok ( mpq(0)->fits_slong_p());
ok ( mpq(123)->fits_slong_p());
ok (! mpq("9999999999999999999999999999999999999999999")->fits_slong_p());
ok (! mpf("-9999999999999999999999999999999999999999999")->fits_slong_p());
ok ( mpf(-123)->fits_slong_p());
ok ( mpf(0)->fits_slong_p());
ok ( mpf(123)->fits_slong_p());
ok (! mpf("9999999999999999999999999999999999999999999")->fits_slong_p());
ok (get_str(-123) eq '-123');
ok (get_str('-123') eq '-123');
ok (get_str(substr('x-123x',1,4)) eq '-123');
ok (get_str(mpz(-123)) eq '-123');
ok (get_str(mpq(-123)) eq '-123');
ok (get_str(-123,10) eq '-123');
ok (get_str('-123',10) eq '-123');
ok (get_str(substr('x-123x',1,4),10) eq '-123');
ok (get_str(mpz(-123),10) eq '-123');
ok (get_str(mpq(-123),10) eq '-123');
ok (get_str(-123,16) eq '-7b');
ok (get_str('-123',16) eq '-7b');
ok (get_str(substr('x-123x',1,4),16) eq '-7b');
ok (get_str(mpz(-123),16) eq '-7b');
ok (get_str(mpq(-123),16) eq '-7b');
ok (get_str(-123,-16) eq '-7B');
ok (get_str('-123',-16) eq '-7B');
ok (get_str(substr('x-123x',1,4),-16) eq '-7B');
ok (get_str(mpz(-123),-16) eq '-7B');
ok (get_str(mpq(-123),-16) eq '-7B');
# is a float in past versions of perl without UV type
{ my ($str, $exp) = get_str($uv_max);
ok ($str eq $uv_max_str); }
ok (get_str(mpq(5/8)) eq "5/8");
ok (get_str(mpq(-5/8)) eq "-5/8");
ok (get_str(mpq(255/256),16) eq "ff/100");
ok (get_str(mpq(255/256),-16) eq "FF/100");
ok (get_str(mpq(-255/256),16) eq "-ff/100");
ok (get_str(mpq(-255/256),-16) eq "-FF/100");
{ my ($s,$e) = get_str(1.5, 10); ok ($s eq '15'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(1.5), 10); ok ($s eq '15'); ok ($e == 1); }
{ my ($s,$e) = get_str(-1.5, 10); ok ($s eq '-15'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(-1.5), 10); ok ($s eq '-15'); ok ($e == 1); }
{ my ($s,$e) = get_str(1.5, 16); ok ($s eq '18'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(1.5), 16); ok ($s eq '18'); ok ($e == 1); }
{ my ($s,$e) = get_str(-1.5, 16); ok ($s eq '-18'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(-1.5), 16); ok ($s eq '-18'); ok ($e == 1); }
{ my ($s,$e) = get_str(65536.0, 16); ok ($s eq '1'); ok ($e == 5); }
{ my ($s,$e) = get_str(mpf(65536.0), 16); ok ($s eq '1'); ok ($e == 5); }
{ my ($s,$e) = get_str(1.625, 16); ok ($s eq '1a'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(1.625), 16); ok ($s eq '1a'); ok ($e == 1); }
{ my ($s,$e) = get_str(1.625, -16); ok ($s eq '1A'); ok ($e == 1); }
{ my ($s,$e) = get_str(mpf(1.625), -16); ok ($s eq '1A'); ok ($e == 1); }
{ my ($s, $e) = get_str(255.0,16,0); ok ($s eq "ff"); ok ($e == 2); }
{ my ($s, $e) = get_str(mpf(255.0),16,0); ok ($s eq "ff"); ok ($e == 2); }
{ my ($s, $e) = get_str(255.0,-16,0); ok ($s eq "FF"); ok ($e == 2); }
{ my ($s, $e) = get_str(mpf(255.0),-16,0); ok ($s eq "FF"); ok ($e == 2); }
ok ( GMP::integer_p (0));
ok ( GMP::integer_p (123));
ok ( GMP::integer_p (-123));
ok ( GMP::integer_p ($uv_max));
ok ( GMP::integer_p (0.0));
ok ( GMP::integer_p (123.0));
ok ( GMP::integer_p (-123.0));
ok (! GMP::integer_p (0.5));
ok (! GMP::integer_p (123.5));
ok (! GMP::integer_p (-123.5));
ok ( GMP::integer_p ('0'));
ok ( GMP::integer_p ('123'));
ok ( GMP::integer_p ('-123'));
ok (! GMP::integer_p ('0.5'));
ok (! GMP::integer_p ('123.5'));
ok (! GMP::integer_p ('-123.5'));
ok (! GMP::integer_p ('5/8'));
ok ( GMP::integer_p (mpz(1)));
ok ( GMP::integer_p (mpq(1)));
ok (! GMP::integer_p (mpq(1,2)));
ok ( GMP::integer_p (mpf(1.0)));
ok (! GMP::integer_p (mpf(1.5)));
ok ( odd_p(mpz(-3)));
ok (! odd_p(mpz(-2)));
ok ( odd_p(mpz(-1)));
ok (! odd_p(mpz(0)));
ok ( odd_p(mpz(1)));
ok (! odd_p(mpz(2)));
ok ( odd_p(mpz(3)));
sub via_printf {
my $s;
open TEMP, ">test.tmp" or die;
GMP::printf TEMP @_;
close TEMP or die;
open TEMP, "<test.tmp" or die;
read (TEMP, $s, 1024);
close TEMP or die;
unlink 'test.tmp';
return $s;
}
ok (sprintf ("%d", mpz(123)) eq '123');
ok (sprintf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
ok (sprintf ("%d", mpq(15,16)) eq '15/16');
ok (sprintf ("%f", mpf(1.5)) eq '1.500000');
ok (sprintf ("%.2f", mpf(1.5)) eq '1.50');
ok (sprintf ("%*d", 6, 123) eq ' 123');
ok (sprintf ("%*d", 6, mpz(123)) eq ' 123');
ok (sprintf ("%*d", 6, mpq(15,16)) eq ' 15/16');
ok (sprintf ("%x", 123) eq '7b');
ok (sprintf ("%x", mpz(123)) eq '7b');
ok (sprintf ("%X", 123) eq '7B');
ok (sprintf ("%X", mpz(123)) eq '7B');
ok (sprintf ("%#x", 123) eq '0x7b');
ok (sprintf ("%#x", mpz(123)) eq '0x7b');
ok (sprintf ("%#X", 123) eq '0X7B');
ok (sprintf ("%#X", mpz(123)) eq '0X7B');
ok (sprintf ("%x", mpq(15,16)) eq 'f/10');
ok (sprintf ("%X", mpq(15,16)) eq 'F/10');
ok (sprintf ("%#x", mpq(15,16)) eq '0xf/0x10');
ok (sprintf ("%#X", mpq(15,16)) eq '0XF/0X10');
ok (sprintf ("%*.*f", 10, 3, 1.25) eq ' 1.250');
ok (sprintf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500');
ok (via_printf ("%d", mpz(123)) eq '123');
ok (via_printf ("%d %d %d", 456, mpz(123), 789) eq '456 123 789');
ok (via_printf ("%d", mpq(15,16)) eq '15/16');
ok (via_printf ("%f", mpf(1.5)) eq '1.500000');
ok (via_printf ("%.2f", mpf(1.5)) eq '1.50');
ok (via_printf ("%*d", 6, 123) eq ' 123');
ok (via_printf ("%*d", 6, mpz(123)) eq ' 123');
ok (via_printf ("%*d", 6, mpq(15,16)) eq ' 15/16');
ok (via_printf ("%x", 123) eq '7b');
ok (via_printf ("%x", mpz(123)) eq '7b');
ok (via_printf ("%X", 123) eq '7B');
ok (via_printf ("%X", mpz(123)) eq '7B');
ok (via_printf ("%#x", 123) eq '0x7b');
ok (via_printf ("%#x", mpz(123)) eq '0x7b');
ok (via_printf ("%#X", 123) eq '0X7B');
ok (via_printf ("%#X", mpz(123)) eq '0X7B');
ok (via_printf ("%x", mpq(15,16)) eq 'f/10');
ok (via_printf ("%X", mpq(15,16)) eq 'F/10');
ok (via_printf ("%#x", mpq(15,16)) eq '0xf/0x10');
ok (via_printf ("%#X", mpq(15,16)) eq '0XF/0X10');
ok (via_printf ("%*.*f", 10, 3, 1.25) eq ' 1.250');
ok (via_printf ("%*.*f", 10, 3, mpf(1.5)) eq ' 1.500');
if ($] > 5.00503) { if (! do'test2.pl') {
die "Cannot run test2.pl\n";
}
}
#------------------------------------------------------------------------------ # $# stuff # # For some reason "local $#" doesn't leave $# back at its default undefined # state when exiting the block.
{ local $# = 'hi %.0f there';
my $f = mpf(123);
ok ("$f" eq 'hi 123 there'); }
# Local variables: # perl-indent-level: 2 # End:
Messung V0.5 in Prozent
¤ Dauer der Verarbeitung: 0.58 Sekunden
(vorverarbeitet am 2026-06-10)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.