test/recipes/bc.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2015-2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the OpenSSL license (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9
  10 use strict;
  11 use warnings;
  12
  13 use Math::BigInt;
  14
  15 sub calc {
  16     @_ = __adder(@_);
  17     if (scalar @_ != 1) { return "NaN"; }
  18     return shift;
  19 }
  20
  21 sub __canonhex {
  22     my ($sign, $hex) = (shift =~ /^([+\-]?)(.*)$/);
  23     $hex = "0x".$hex if $hex !~ /^0x/;
  24     return $sign.$hex;
  25 }
  26
  27 sub __adder {
  28     @_ = __multiplier(@_);
  29     while (scalar @_ > 1 && $_[1] =~ /^[\+\-]$/) {
  30         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  31         my $operator = shift;
  32         @_ = __multiplier(@_);
  33         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  34         if ($operator eq "+") {
  35             $operand1->badd($operand2);
  36         } elsif ($operator eq "-") {
  37             $operand1->bsub($operand2);
  38         } else {
  39             die "SOMETHING WENT AWFULLY WRONG";
  40         }
  41         unshift @_, $operand1->as_hex();
  42     }
  43     return @_;
  44 }
  45
  46 sub __multiplier {
  47     @_ = __power(@_);
  48     while (scalar @_ > 1 && $_[1] =~ /^[\*\/%]$/) {
  49         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  50         my $operator = shift;
  51         @_ = __power(@_);
  52         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  53         if ($operator eq "*") {
  54             $operand1->bmul($operand2);
  55         } elsif ($operator eq "/") {
  56             # Math::BigInt->bdiv() is documented to do floored division,
  57             # i.e. 1 / -4 = -1, while bc and OpenSSL BN_div do truncated
  58             # division, i.e. 1 / -4 = 0.  We need to make the operation
  59             # work like OpenSSL's BN_div to be able to verify.
  60             my $neg = ($operand1->is_neg()
  61                        ? !$operand2->is_neg() : $operand2->is_neg());
  62             $operand1->babs();
  63             $operand2->babs();
  64             $operand1->bdiv($operand2);
  65             if ($neg) { $operand1->bneg(); }
  66         } elsif ($operator eq "%") {
  67             # Here's a bit of a quirk...
  68             # With OpenSSL's BN, as well as bc, the result of -10 % 3 is -1
  69             # while Math::BigInt, the result is 2.
  70             # The latter is mathematically more correct, but...
  71             my $o1isneg = $operand1->is_neg();
  72             $operand1->babs();
  73             # Math::BigInt does something different with a negative modulus,
  74             # while OpenSSL's BN and bc treat it like a positive number...
  75             $operand2->babs();
  76             $operand1->bmod($operand2);
  77             if ($o1isneg) { $operand1->bneg(); }
  78         } else {
  79             die "SOMETHING WENT AWFULLY WRONG";
  80         }
  81         unshift @_, $operand1->as_hex();
  82     }
  83     return @_;
  84 }
  85
  86 sub __power {
  87     @_ = __paren(@_);
  88     while (scalar @_ > 1 && $_[1] eq "^") {
  89         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  90         shift;
  91         @_ = __paren(@_);
  92         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  93         $operand1->bpow($operand2);
  94         unshift @_, $operand1->as_hex();
  95     }
  96     return @_;
  97 }
  98
  99 # returns array ( $result, @remaining )
 100 sub __paren {
 101     if (scalar @_ > 0 && $_[0] eq "(") {
 102         shift;
 103         my @result = __adder(@_);
 104         if (scalar @_ == 0 || $_[0] ne ")") {
 105             return ("NaN");
 106         }
 107         shift;
 108         return @result;
 109     }
 110     return @_;
 111 }
 112
 113 1;