29a4a8a84a0789064d04a86e4fd54ac6a70c2f0e
[openssl.git] / test / recipes / bc.pl
1 #! /usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Math::BigInt;
7
8 sub calc {
9     @_ = __adder(@_);
10     if (scalar @_ != 1) { return "NaN"; }
11     return shift;
12 }
13
14 sub __canonhex {
15     my ($sign, $hex) = (shift =~ /^([+\-]?)(.*)$/);
16     $hex = "0x".$hex if $hex !~ /^0x/;
17     return $sign.$hex;
18 }
19
20 sub __adder {
21     @_ = __multiplier(@_);
22     while (scalar @_ > 1 && $_[1] =~ /^[\+\-]$/) {
23         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
24         my $operator = shift;
25         @_ = __multiplier(@_);
26         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
27         if ($operator eq "+") {
28             $operand1->badd($operand2);
29         } elsif ($operator eq "-") {
30             $operand1->bsub($operand2);
31         } else {
32             die "SOMETHING WENT AWFULLY WRONG";
33         }
34         unshift @_, $operand1->as_hex();
35     }
36     return @_;
37 }
38
39 sub __multiplier {
40     @_ = __power(@_);
41     while (scalar @_ > 1 && $_[1] =~ /^[\*\/%]$/) {
42         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
43         my $operator = shift;
44         @_ = __power(@_);
45         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
46         if ($operator eq "*") {
47             $operand1->bmul($operand2);
48         } elsif ($operator eq "/") {
49             $operand1->bdiv($operand2);
50         } elsif ($operator eq "%") {
51             # Here's a bit of a quirk...
52             # With OpenSSL's BN, as well as bc, the result of -10 % 3 is -1
53             # while Math::BigInt, the result is 2.
54             # The latter is mathematically more correct, but...
55             my $o1isneg = $operand1->is_neg();
56             $operand1->babs();
57             # Math::BigInt does something different with a negative modulus,
58             # while OpenSSL's BN and bc treat it like a positive number...
59             $operand2->babs();
60             $operand1->bmod($operand2);
61             if ($o1isneg) { $operand1->bneg(); }
62         } else {
63             die "SOMETHING WENT AWFULLY WRONG";
64         }
65         unshift @_, $operand1->as_hex();
66     }
67     return @_;
68 }
69
70 sub __power {
71     @_ = __paren(@_);
72     while (scalar @_ > 1 && $_[1] eq "^") {
73         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
74         shift;
75         @_ = __paren(@_);
76         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
77         $operand1->bpow($operand2);
78         unshift @_, $operand1->as_hex();
79     }
80     return @_;
81 }
82
83 # returns array ( $result, @remaining )
84 sub __paren {
85     if (scalar @_ > 0 && $_[0] eq "(") {
86         shift;
87         my @result = __adder(@_);
88         if (scalar @_ == 0 || $_[0] ne ")") {
89             return ("NaN");
90         }
91         shift;
92         return @result;
93     }
94     return @_;
95 }
96
97 1;