diff --git a/test/recipes/10-test_bn.t b/test/recipes/10-test_bn.t new file mode 100644 index 000000000..6dce97327 --- /dev/null +++ b/test/recipes/10-test_bn.t @@ -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; +} diff --git a/test/recipes/10-test_exp.t b/test/recipes/10-test_exp.t new file mode 100644 index 000000000..e7bad93f8 --- /dev/null +++ b/test/recipes/10-test_exp.t @@ -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"); diff --git a/test/recipes/bc.pl b/test/recipes/bc.pl new file mode 100644 index 000000000..29a4a8a84 --- /dev/null +++ b/test/recipes/bc.pl @@ -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;