[perl #82098] Fix RT 61543 and remaining part of RT 63237

Extend bmodpow() to handle negative numbers.

- dist/Math-BigInt/lib/Math/BigInt.pm: Fix bmodpow() code and make the
  documentation style more like that of other methods.

- dist/Math-BigInt/t/bigintpm.inc: Edit test results so they match new
  behaviour, i.e., where earlier a NaN was returned, there are now
  some cases where an integer is returned, since bmodpow() now also
  handles negative numbers. Also include test cases from RT 63237. The
  tests themselves have all been verified to be correct using other
  software.

- dist/Math-BigRat/t/bigratpm.inc: Fix test case so it matches the new
  behaviour of Math::BigInt->bmodinv(). Math::BigRat->bmodinv() only
  handles integers, and is essentially just a front-end to
  Math::BigInt->bmodinv().

- dist/Math-BigInt/t/bare_mbi.t: Increment test count.

- dist/Math-BigInt/t/bigintpm.t: Increment test count.

- dist/Math-BigInt/t/sub_mbi.t: Increment test count.

5 files changed, 250 insertions, 25 deletions

diff --git a/dist/Math-BigInt/lib/Math/BigInt.pm b/dist/Math-BigInt/lib/Math/BigInt.pm
index c3a05a1567..96f4168317 100644
--- a/dist/Math-BigInt/lib/Math/BigInt.pm
+++ b/dist/Math-BigInt/lib/Math/BigInt.pm
@@ -1865,25 +1865,84 @@ sub bmodpow
 
   return $num if $num->modify('bmodpow');
 
-  # check modulus for valid values
-  return $num->bnan() if ($mod->{sign} ne '+'		# NaN, - , -inf, +inf
-                       || $mod->is_zero());
+  # When the exponent 'e' is negative, use the following relation, which is
+  # based on finding the multiplicative inverse 'd' of 'b' modulo 'm':
+  #
+  #    b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m)
 
-  # check exponent for valid values
-  if ($exp->{sign} =~ /\w/) 
-    {
-    # i.e., if it's NaN, +inf, or -inf...
-    return $num->bnan();
-    }
+  $num->bmodinv($mod) if ($exp->{sign} eq '-');
 
-  $num->bmodinv ($mod) if ($exp->{sign} eq '-');
+  # Check for valid input. All operands must be finite, and the modulus must be
+  # non-zero.
 
-  # check num for valid values (also NaN if there was no inverse but $exp < 0)
-  return $num->bnan() if $num->{sign} !~ /^[+-]$/;
+  return $num->bnan() if ($num->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
+                          $exp->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
+                          $mod->{sign} =~ /NaN|inf/ ||  # NaN, -inf, +inf
+                          $mod->is_zero());
 
-  # $mod is positive, sign on $exp is ignored, result also positive
-  $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
-  $num;
+  # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
+  # value is zero, the output is also zero, regardless of the signs on 'a' and
+  # 'm'.
+
+  my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value});
+  my $sign  = '+';
+
+  # If the resulting value is non-zero, we have four special cases, depending
+  # on the signs on 'a' and 'm'.
+
+  unless ($CALC->_is_zero($num->{value})) {
+
+      # There is a negative sign on 'a' (= $num**$exp) only if the number we
+      # are exponentiating ($num) is negative and the exponent ($exp) is odd.
+
+      if ($num->{sign} eq '-' && $exp->is_odd()) {
+
+          # When both the number 'a' and the modulus 'm' have a negative sign,
+          # use this relation:
+          #
+          #    -a (mod -m) = -(a (mod m))
+
+          if ($mod->{sign} eq '-') {
+              $sign = '-';
+          }
+
+          # When only the number 'a' has a negative sign, use this relation:
+          #
+          #    -a (mod m) = m - (a (mod m))
+
+          else {
+              # Use copy of $mod since _sub() modifies the first argument.
+              my $mod = $CALC->_copy($mod->{value});
+              $value = $CALC->_sub($mod, $num->{value});
+              $sign  = '+';
+          }
+
+      } else {
+
+          # When only the modulus 'm' has a negative sign, use this relation:
+          #
+          #    a (mod -m) = (a (mod m)) - m
+          #               = -(m - (a (mod m)))
+
+          if ($mod->{sign} eq '-') {
+              my $mod = $CALC->_copy($mod->{value});
+              $value = $CALC->_sub($mod, $num->{value});
+              $sign  = '-';
+          }
+
+          # When neither the number 'a' nor the modulus 'm' have a negative
+          # sign, directly return the already computed value.
+          #
+          #    (a (mod m))
+
+      }
+
+  }
+
+  $num->{value} = $value;
+  $num->{sign}  = $sign;
+
+  return $num;
   }
 
 ###############################################################################
@@ -3212,9 +3271,8 @@ Math::BigInt - Arbitrary size integer/float math package
   $x->bmuladd($y,$z);	# $x = $x * $y + $z
 
   $x->bmod($y);		   # modulus (x % y)
-  $x->bmodpow($exp,$mod);  # modular exponentiation (($num**$exp) % $mod)
-  $x->bmodinv($mod);	   # the inverse of $x in the given modulus $mod
-
+  $x->bmodpow($y,$mod);    # modular exponentiation (($x ** $y) % $mod)
+  $x->bmodinv($mod);       # modular multiplicative inverse
   $x->bpow($y);		   # power of arguments (x ** y)
   $x->blsft($y);	   # left shift in base 2
   $x->brsft($y);	   # right shift in base 2
diff --git a/dist/Math-BigInt/t/bare_mbi.t b/dist/Math-BigInt/t/bare_mbi.t
index 5f4bf5bfcb..a73fd12337 100644
--- a/dist/Math-BigInt/t/bare_mbi.t
+++ b/dist/Math-BigInt/t/bare_mbi.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3285;
+use Test::More tests => 3619;
 
 BEGIN { unshift @INC, 't'; }
 
diff --git a/dist/Math-BigInt/t/bigintpm.inc b/dist/Math-BigInt/t/bigintpm.inc
index 47daa409a0..da127c3ae1 100644
--- a/dist/Math-BigInt/t/bigintpm.inc
+++ b/dist/Math-BigInt/t/bigintpm.inc
@@ -1710,6 +1710,27 @@ abc:5:NaN
 1234567891:13:6
 -1234567891:13:7
 324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902
+-2:1:0
+-1:1:0
+0:1:0
+1:1:0
+2:1:0
+3:1:0
+4:1:0
+-2:3:1
+-1:3:2
+0:3:NaN
+1:3:1
+2:3:2
+3:3:NaN
+4:3:1
+-2:4:NaN
+-1:4:3
+0:4:NaN
+1:4:1
+2:4:NaN
+3:4:3
+4:4:NaN
 ## bmodinv Error cases / useless use of function
 inf:5:NaN
 5:inf:NaN
@@ -1729,15 +1750,161 @@ abc:5:5:NaN
 # bmodpow Expected results
 0:0:2:1
 1:0:2:1
-0:0:1:0
 0:3:5:0
-8:7:5032:3840
+-2:-2:1:0
+-1:-2:1:0
+0:-2:1:0
+1:-2:1:0
+2:-2:1:0
+3:-2:1:0
+4:-2:1:0
+-2:-1:1:0
+-1:-1:1:0
+0:-1:1:0
+1:-1:1:0
+2:-1:1:0
+3:-1:1:0
+4:-1:1:0
+-2:0:1:0
+-1:0:1:0
+0:0:1:0
+1:0:1:0
+2:0:1:0
+3:0:1:0
+4:0:1:0
+-2:1:1:0
+-1:1:1:0
+0:1:1:0
+1:1:1:0
+2:1:1:0
+3:1:1:0
+4:1:1:0
+-2:2:1:0
+-1:2:1:0
+0:2:1:0
+1:2:1:0
+2:2:1:0
+3:2:1:0
+4:2:1:0
+-2:3:1:0
+-1:3:1:0
+0:3:1:0
+1:3:1:0
+2:3:1:0
+3:3:1:0
+4:3:1:0
+-2:4:1:0
+-1:4:1:0
+0:4:1:0
+1:4:1:0
+2:4:1:0
+3:4:1:0
+4:4:1:0
+-2:-2:3:1
+-1:-2:3:1
+0:-2:3:NaN
+1:-2:3:1
+2:-2:3:1
+3:-2:3:NaN
+4:-2:3:1
+-2:-1:3:1
+-1:-1:3:2
+0:-1:3:NaN
+1:-1:3:1
+2:-1:3:2
+3:-1:3:NaN
+4:-1:3:1
+-2:0:3:1
+-1:0:3:1
+0:0:3:1
+1:0:3:1
+2:0:3:1
+3:0:3:1
+4:0:3:1
+-2:1:3:1
+-1:1:3:2
+0:1:3:0
+1:1:3:1
+2:1:3:2
+3:1:3:0
+4:1:3:1
+-2:2:3:1
+-1:2:3:1
+0:2:3:0
+1:2:3:1
+2:2:3:1
+3:2:3:0
+4:2:3:1
+-2:3:3:1
+-1:3:3:2
+0:3:3:0
+1:3:3:1
+2:3:3:2
+3:3:3:0
+4:3:3:1
+-2:4:3:1
+-1:4:3:1
+0:4:3:0
+1:4:3:1
+2:4:3:1
+3:4:3:0
+4:4:3:1
+-2:-2:4:NaN
+-1:-2:4:1
+0:-2:4:NaN
+1:-2:4:1
+2:-2:4:NaN
+3:-2:4:1
+4:-2:4:NaN
+-2:-1:4:NaN
+-1:-1:4:3
+0:-1:4:NaN
+1:-1:4:1
+2:-1:4:NaN
+3:-1:4:3
+4:-1:4:NaN
+-2:0:4:1
+-1:0:4:1
+0:0:4:1
+1:0:4:1
+2:0:4:1
+3:0:4:1
+4:0:4:1
+-2:1:4:2
+-1:1:4:3
+0:1:4:0
+1:1:4:1
+2:1:4:2
+3:1:4:3
+4:1:4:0
+-2:2:4:0
+-1:2:4:1
+0:2:4:0
+1:2:4:1
+2:2:4:0
+3:2:4:1
+4:2:4:0
+-2:3:4:0
+-1:3:4:3
+0:3:4:0
+1:3:4:1
+2:3:4:0
+3:3:4:3
+4:3:4:0
+-2:4:4:0
+-1:4:4:1
+0:4:4:0
+1:4:4:1
+2:4:4:0
+3:4:4:1
+4:4:4:0
+8:-1:16:NaN
 8:-1:5033:4404
+8:7:5032:3840
+8:8:-5:-4
 1e50:1:1:0
 98436739867439843769485798542749827593285729587325:43698764986460981048259837659386739857456983759328457:6943857329857295827698367:3104744730915914415259518
 # bmodpow Error cases
-8:8:-5:NaN
-8:-1:16:NaN
 inf:5:13:NaN
 5:inf:13:NaN
 &bmod
diff --git a/dist/Math-BigInt/t/bigintpm.t b/dist/Math-BigInt/t/bigintpm.t
index 94f0327790..d16844b347 100644
--- a/dist/Math-BigInt/t/bigintpm.t
+++ b/dist/Math-BigInt/t/bigintpm.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3285 + 6;
+use Test::More tests => 3619 + 6;
 
 use Math::BigInt lib => 'Calc';
 
diff --git a/dist/Math-BigInt/t/sub_mbi.t b/dist/Math-BigInt/t/sub_mbi.t
index 9f10affa87..a999c0982b 100644
--- a/dist/Math-BigInt/t/sub_mbi.t
+++ b/dist/Math-BigInt/t/sub_mbi.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3285
+use Test::More tests => 3619
     + 5;	# +5 own tests
 
 BEGIN { unshift @INC, 't'; }