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             # Math::BigInt->bdiv() is documented to do floored division,
  50             # i.e. 1 / -4 = -1, while bc and OpenSSL BN_div do truncated
  51             # division, i.e. 1 / -4 = 0.  We need to make the operation
  52             # work like OpenSSL's BN_div to be able to verify.
  53             my $neg = ($operand1->is_neg()
  54                        ? !$operand2->is_neg() : $operand2->is_neg());
  55             $operand1->babs();
  56             $operand2->babs();
  57             $operand1->bdiv($operand2);
  58             if ($neg) { $operand1->bneg(); }
  59         } elsif ($operator eq "%") {
  60             # Here's a bit of a quirk...
  61             # With OpenSSL's BN, as well as bc, the result of -10 % 3 is -1
  62             # while Math::BigInt, the result is 2.
  63             # The latter is mathematically more correct, but...
  64             my $o1isneg = $operand1->is_neg();
  65             $operand1->babs();
  66             # Math::BigInt does something different with a negative modulus,
  67             # while OpenSSL's BN and bc treat it like a positive number...
  68             $operand2->babs();
  69             $operand1->bmod($operand2);
  70             if ($o1isneg) { $operand1->bneg(); }
  71         } else {
  72             die "SOMETHING WENT AWFULLY WRONG";
  73         }
  74         unshift @_, $operand1->as_hex();
  75     }
  76     return @_;
  77 }
  78
  79 sub __power {
  80     @_ = __paren(@_);
  81     while (scalar @_ > 1 && $_[1] eq "^") {
  82         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  83         shift;
  84         @_ = __paren(@_);
  85         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  86         $operand1->bpow($operand2);
  87         unshift @_, $operand1->as_hex();
  88     }
  89     return @_;
  90 }
  91
  92 # returns array ( $result, @remaining )
  93 sub __paren {
  94     if (scalar @_ > 0 && $_[0] eq "(") {
  95         shift;
  96         my @result = __adder(@_);
  97         if (scalar @_ == 0 || $_[0] ne ")") {
  98             return ("NaN");
  99         }
 100         shift;
 101         return @result;
 102     }
 103     return @_;
 104 }
 105
 106 1;