test.pl

a very popular packet of cryptography tools,it encloses the most common used algorithm and protocols

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);

#------------------------------------------------------------------------------
# GMP::Mpf::overload_string

{ 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"); }

#------------------------------------------------------------------------------
# GMP::Mpf::overload_sub

ok (mpf(0) - 1 == -1);
ok (mpf(1) - 1 == 0);
ok (1 - mpf(0) == 1);
ok (1 - mpf(1) == 0);

#------------------------------------------------------------------------------
# GMP::Mpf::overload_subeq

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


#------------------------------------------------------------------------------
# GMP::Mpf::ceil

ok (ceil (mpf(-7.5)) == -7.0);
ok (ceil (mpf(7.5)) == 8.0);

#------------------------------------------------------------------------------
# GMP::Mpf::floor

ok (floor(mpf(-7.5)) == -8.0);
ok (floor(mpf(7.5)) == 7.0);

#------------------------------------------------------------------------------
# GMP::Mpf::mpf_eq

{ my $old_prec = get_default_prec();
  set_default_prec(128);
 
  ok (  mpf_eq (mpz("0x10000000000000001"), mpz("0x10000000000000002"), 1));
  ok (! mpf_eq (mpz("0x11"), mpz("0x12"), 128));

  set_default_prec($old_prec);
}

#------------------------------------------------------------------------------
# GMP::Mpf::get_default_prec

get_default_prec();

#------------------------------------------------------------------------------
# GMP::Mpf::get_prec

{ my $x = mpf(1.0, 512);
  ok (get_prec ($x) == 512);
}

#------------------------------------------------------------------------------
# GMP::Mpf::reldiff

ok (reldiff (2,4) == 1);
ok (reldiff (4,2) == 0.5);

#------------------------------------------------------------------------------
# GMP::Mpf::set_default_prec

{ my $old_prec = get_default_prec();

  set_default_prec(512);
  ok (get_default_prec () == 512);

  set_default_prec($old_prec);
}

#------------------------------------------------------------------------------
# GMP::Mpf::set_prec

{ my $x = mpf(1.0, 512);
  my $y = $x;
  set_prec ($x, 1024);
  ok (get_prec ($x) == 1024);
  ok (get_prec ($y) == 512);
}

#------------------------------------------------------------------------------
# GMP::Mpf::trunc

ok (trunc(mpf(-7.5)) == -7.0);
ok (trunc(mpf(7.5)) == 7.0);



#------------------------------------------------------------------------------
# GMP::Rand

#------------------------------------------------------------------------------
# GMP::Rand::new

{ 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); }

#------------------------------------------------------------------------------
# GMP::Rand::seed

{ my $r = randstate();
  $r->seed(123);
  $r->seed(time());
}

#------------------------------------------------------------------------------
# GMP::Rand::mpf_urandomb

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

#------------------------------------------------------------------------------
# GMP::Rand::mpz_urandomb

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

#------------------------------------------------------------------------------
# GMP::Rand::mpz_rrandomb

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

#------------------------------------------------------------------------------
# GMP::Rand::mpz_urandomm

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



#------------------------------------------------------------------------------
# GMP module

#------------------------------------------------------------------------------
# GMP::fits_slong_p

ok (GMP::fits_slong_p(0));

# 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());

#------------------------------------------------------------------------------
# GMP::get_d

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

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

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

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

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

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

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

#------------------------------------------------------------------------------
# GMP::get_d_2exp

{ my ($dbl, $exp) = get_d_2exp (0);
  ok ($dbl == 0); ok ($exp == 0); }
{ my ($dbl, $exp) = get_d_2exp (1);
  ok ($dbl == 0.5); ok ($exp == 1); }

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

{ my ($dbl, $exp) = get_d_2exp (0.5);
  ok ($dbl == 0.5); ok ($exp == 0); }
{ my ($dbl, $exp) = get_d_2exp (0.25);
  ok ($dbl == 0.5); ok ($exp == -1); }

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

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

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

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

#------------------------------------------------------------------------------
# GMP::get_str

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); }

#------------------------------------------------------------------------------
# GMP::get_si

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

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

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

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

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

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

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

#------------------------------------------------------------------------------
# GMP::integer_p

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)));

#------------------------------------------------------------------------------
# GMP::odd_p

ok (! odd_p(0));
ok (  odd_p(1));
ok (! odd_p(2));

ok (  odd_p($uv_max));

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)));

#------------------------------------------------------------------------------
# GMP::printf

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

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');
 
#------------------------------------------------------------------------------
# GMP::sgn

ok (sgn(-123) == -1);
ok (sgn(0)    == 0);
ok (sgn(123)  == 1);

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

ok (sgn(-123.0) == -1);
ok (sgn(0.0)    == 0);
ok (sgn(123.0)  == 1);

ok (sgn('-123') == -1);
ok (sgn('0')    == 0);
ok (sgn('123')  == 1);
ok (sgn('-123.0') == -1);
ok (sgn('0.0')    == 0);
ok (sgn('123.0')  == 1);

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

ok (mpz(-123)->sgn() == -1);
ok (mpz(0)   ->sgn() == 0);
ok (mpz(123) ->sgn() == 1);

ok (mpq(-123)->sgn() == -1);
ok (mpq(0)   ->sgn() == 0);
ok (mpq(123) ->sgn() == 1);

ok (mpf(-123)->sgn() == -1);
ok (mpf(0)   ->sgn() == 0);
ok (mpf(123) ->sgn() == 1);



#------------------------------------------------------------------------------
# overloaded constants

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: