test.pl

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

#!/usr/bin/perl -w

# GMP perl module tests

# Copyright 2001, 2002, 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 the GNU Lesser General Public License as published
# by the Free Software Foundation; either version 2.1 of the License, or (at
# your option) any later version.
#
# 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 Lesser General Public
# License for more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.


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

my $ivnv_2p128 = 65536.0 * 65536.0 * 65536.0 * 65536.0
               * 65536.0 * 65536.0 * 65536.0 * 65536.0;
kill (0, $ivnv_2p128);
my $str_2p128 = '340282366920938463463374607431768211456';

my $uv_max = ~ 0;
my $uv_max_str = ~ 0;
$uv_max_str = "$uv_max_str";
$uv_max_str = "" . "$uv_max_str";


#------------------------------------------------------------------------------
# GMP::version

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


#------------------------------------------------------------------------------
# GMP::Mpz::new

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_abs

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_add

ok (mpz(0) + 1 == 1);
ok (mpz(-1) + 1 == 0);
ok (1 + mpz(0) == 1);
ok (1 + mpz(-1) == 0);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_addeq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_and

ok ((mpz(3) & 1) == 1);
ok ((mpz(3) & 4) == 0);

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_bool

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_com

ok (~ mpz(0) == -1);
ok (~ mpz(1) == -2);
ok (~ mpz(-2) == 1);
ok (~ mpz(0xFF) == -0x100);
ok (~ mpz(-0x100) == 0xFF);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_dec

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

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_div

ok (mpz(6) / 2 == 3);
ok (mpz(-6) / 2 == -3);
ok (mpz(6) / -2 == -3);
ok (mpz(-6) / -2 == 3);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_diveq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_eq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_inc

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

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_ior

ok ((mpz(3) | 1) == 3);
ok ((mpz(3) | 4) == 7);

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

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_lshift

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_lshifteq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_mul

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_muleq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_neg

ok (- mpz(0) == 0);
ok (- mpz(123) == -123);
ok (- mpz(-123) == 123);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_not

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

ok ((! mpz(0)) == 1);
ok ((! mpz(123)) == 0);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_pow

ok (mpz(0) ** 1 == 0);
ok (mpz(1) ** 1 == 1);
ok (mpz(2) ** 0 == 1);
ok (mpz(2) ** 1 == 2);
ok (mpz(2) ** 2 == 4);
ok (mpz(2) ** 3 == 8);
ok (mpz(2) ** 4 == 16);

ok (mpz(0) ** mpz(1) == 0);
ok (mpz(1) ** mpz(1) == 1);
ok (mpz(2) ** mpz(0) == 1);
ok (mpz(2) ** mpz(1) == 2);
ok (mpz(2) ** mpz(2) == 4);
ok (mpz(2) ** mpz(3) == 8);
ok (mpz(2) ** mpz(4) == 16);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_poweq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_rem

ok (mpz(-8) % 3 == -2);
ok (mpz(-7) % 3 == -1);
ok (mpz(-6) % 3 == 0);
ok (mpz(6) % 3 == 0);
ok (mpz(7) % 3 == 1);
ok (mpz(8) % 3 == 2);

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_rshift

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_rshifteq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_spaceship

ok (mpz(0) < 1);
ok (mpz(0) > -1);

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_sqrt

ok (sqrt(mpz(0)) == 0);
ok (sqrt(mpz(1)) == 1);
ok (sqrt(mpz(4)) == 2);
ok (sqrt(mpz(81)) == 9);

#------------------------------------------------------------------------------
# GMP::Mpz::overload_string

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_sub

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_subeq

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

#------------------------------------------------------------------------------
# GMP::Mpz::overload_xor

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

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


#------------------------------------------------------------------------------
# GMP::Mpz::bin

ok (bin(2,0) == 1);
ok (bin(2,1) == 2);
ok (bin(2,2) == 1);

ok (bin(3,0) == 1);
ok (bin(3,1) == 3);
ok (bin(3,2) == 3);
ok (bin(3,3) == 1);


#------------------------------------------------------------------------------
# GMP::Mpz::cdiv

{ my ($q, $r);
  ($q, $r) = cdiv (16, 3);
  ok ($q == 6);
  ok ($r == -2);
  ($q, $r) = cdiv (16, -3);
  ok ($q == -5);
  ok ($r == 1);
  ($q, $r) = cdiv (-16, 3);
  ok ($q == -5);
  ok ($r == -1);
  ($q, $r) = cdiv (-16, -3);
  ok ($q == 6);
  ok ($r == 2);
}


#------------------------------------------------------------------------------
# GMP::Mpz::cdiv_2exp

{ my ($q, $r);
  ($q, $r) = cdiv_2exp (23, 2);
  ok ($q == 6);
  ok ($r == -1);
  ($q, $r) = cdiv_2exp (-23, 2);
  ok ($q == -5);
  ok ($r == -3);
}


#------------------------------------------------------------------------------
# GMP::Mpz::clrbit

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