Add math tests recipes
The math recipes are among the heavier, but also quite important. For the BN test, we have previously relied on bc to verify the numbers. Unfortunately, bc doesn't exist everywhere, making tests on some platforms rather painful. With the new recipe (recipes/10-test_bn.t), we rely on perl's Math::BigInt and a homegrown simple calculator (recipes/bc.pl) that can do enough to cover for bc. Reviewed-by: Rich Salz <rsalz@openssl.org>
This commit is contained in:
parent
aec27d4d52
commit
f3356b7f49
76
test/recipes/10-test_bn.t
Normal file
76
test/recipes/10-test_bn.t
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
#! /usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Math::BigInt;
|
||||||
|
|
||||||
|
use Test::More;
|
||||||
|
use OpenSSL::Test qw/:DEFAULT top_file/;
|
||||||
|
|
||||||
|
setup("test_bn");
|
||||||
|
|
||||||
|
plan tests => 3;
|
||||||
|
|
||||||
|
require_ok(top_file("test","recipes","bc.pl"));
|
||||||
|
|
||||||
|
my $testresults = "tmp.bntest";
|
||||||
|
my $init = ok(run(test(["bntest"], stdout => $testresults)), 'initialize');
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
skip "Initializing failed, skipping", 1 if !$init;
|
||||||
|
|
||||||
|
subtest 'Checking the bn results' => sub {
|
||||||
|
my @lines = ();
|
||||||
|
if (open DATA, $testresults) {
|
||||||
|
@lines = <DATA>;
|
||||||
|
close DATA;
|
||||||
|
}
|
||||||
|
chomp(@lines);
|
||||||
|
|
||||||
|
plan tests => scalar grep(/^print /, @lines);
|
||||||
|
|
||||||
|
my $l = "";
|
||||||
|
|
||||||
|
while (scalar @lines) {
|
||||||
|
$l = shift @lines;
|
||||||
|
|
||||||
|
last if $l =~ /^print /;
|
||||||
|
}
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
$l =~ s/^print "//;
|
||||||
|
$l =~ s/\\n"//;
|
||||||
|
my $t = $l;
|
||||||
|
my @operations = ();
|
||||||
|
|
||||||
|
$l = undef;
|
||||||
|
while (scalar @lines) {
|
||||||
|
$l = shift @lines;
|
||||||
|
|
||||||
|
last if $l =~ /^print /;
|
||||||
|
push @operations, $l;
|
||||||
|
$l = undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
ok(check_operations(@operations), "verify $t");
|
||||||
|
|
||||||
|
last unless $l;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_operations {
|
||||||
|
my $failcount = 0;
|
||||||
|
|
||||||
|
foreach my $line (@_) {
|
||||||
|
my $result = calc(split /\s+/, $line);
|
||||||
|
|
||||||
|
if ($result ne "0" && $result ne "0x0") {
|
||||||
|
$failcount++;
|
||||||
|
print STDERR "Failed! $line => $result\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return $failcount == 0;
|
||||||
|
}
|
12
test/recipes/10-test_exp.t
Normal file
12
test/recipes/10-test_exp.t
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
#! /usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Test::More;
|
||||||
|
use OpenSSL::Test;
|
||||||
|
|
||||||
|
setup("test_exp");
|
||||||
|
|
||||||
|
plan tests => 1;
|
||||||
|
ok(run(test(["exptest"])), "running exptest");
|
97
test/recipes/bc.pl
Normal file
97
test/recipes/bc.pl
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
#! /usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Math::BigInt;
|
||||||
|
|
||||||
|
sub calc {
|
||||||
|
@_ = __adder(@_);
|
||||||
|
if (scalar @_ != 1) { return "NaN"; }
|
||||||
|
return shift;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub __canonhex {
|
||||||
|
my ($sign, $hex) = (shift =~ /^([+\-]?)(.*)$/);
|
||||||
|
$hex = "0x".$hex if $hex !~ /^0x/;
|
||||||
|
return $sign.$hex;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub __adder {
|
||||||
|
@_ = __multiplier(@_);
|
||||||
|
while (scalar @_ > 1 && $_[1] =~ /^[\+\-]$/) {
|
||||||
|
my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
my $operator = shift;
|
||||||
|
@_ = __multiplier(@_);
|
||||||
|
my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
if ($operator eq "+") {
|
||||||
|
$operand1->badd($operand2);
|
||||||
|
} elsif ($operator eq "-") {
|
||||||
|
$operand1->bsub($operand2);
|
||||||
|
} else {
|
||||||
|
die "SOMETHING WENT AWFULLY WRONG";
|
||||||
|
}
|
||||||
|
unshift @_, $operand1->as_hex();
|
||||||
|
}
|
||||||
|
return @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub __multiplier {
|
||||||
|
@_ = __power(@_);
|
||||||
|
while (scalar @_ > 1 && $_[1] =~ /^[\*\/%]$/) {
|
||||||
|
my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
my $operator = shift;
|
||||||
|
@_ = __power(@_);
|
||||||
|
my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
if ($operator eq "*") {
|
||||||
|
$operand1->bmul($operand2);
|
||||||
|
} elsif ($operator eq "/") {
|
||||||
|
$operand1->bdiv($operand2);
|
||||||
|
} elsif ($operator eq "%") {
|
||||||
|
# Here's a bit of a quirk...
|
||||||
|
# With OpenSSL's BN, as well as bc, the result of -10 % 3 is -1
|
||||||
|
# while Math::BigInt, the result is 2.
|
||||||
|
# The latter is mathematically more correct, but...
|
||||||
|
my $o1isneg = $operand1->is_neg();
|
||||||
|
$operand1->babs();
|
||||||
|
# Math::BigInt does something different with a negative modulus,
|
||||||
|
# while OpenSSL's BN and bc treat it like a positive number...
|
||||||
|
$operand2->babs();
|
||||||
|
$operand1->bmod($operand2);
|
||||||
|
if ($o1isneg) { $operand1->bneg(); }
|
||||||
|
} else {
|
||||||
|
die "SOMETHING WENT AWFULLY WRONG";
|
||||||
|
}
|
||||||
|
unshift @_, $operand1->as_hex();
|
||||||
|
}
|
||||||
|
return @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub __power {
|
||||||
|
@_ = __paren(@_);
|
||||||
|
while (scalar @_ > 1 && $_[1] eq "^") {
|
||||||
|
my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
shift;
|
||||||
|
@_ = __paren(@_);
|
||||||
|
my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
|
||||||
|
$operand1->bpow($operand2);
|
||||||
|
unshift @_, $operand1->as_hex();
|
||||||
|
}
|
||||||
|
return @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# returns array ( $result, @remaining )
|
||||||
|
sub __paren {
|
||||||
|
if (scalar @_ > 0 && $_[0] eq "(") {
|
||||||
|
shift;
|
||||||
|
my @result = __adder(@_);
|
||||||
|
if (scalar @_ == 0 || $_[0] ne ")") {
|
||||||
|
return ("NaN");
|
||||||
|
}
|
||||||
|
shift;
|
||||||
|
return @result;
|
||||||
|
}
|
||||||
|
return @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
Loading…
x
Reference in New Issue
Block a user