jobcore/perl/c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch
2024-02-12 01:19:32 +02:00

443 lines
15 KiB
Diff

From c8e5f82f10959085f7ce3ec74b3caaaf72497693 Mon Sep 17 00:00:00 2001
From: Peter John Acklam <pjacklam@gmail.com>
Date: Tue, 5 Jul 2022 15:55:26 +0200
Subject: [PATCH] Improve handling of accuracy and precision
- More robust handling of input arguments to accuracy() and precision()
- Skip rounding only when the accuracy or precision is undefined.
- When the accuracy and/or precision is undefined, set the corresponding
instance value(s) to undef rather than deleting.
---
lib/Math/BigFloat.pm | 116 +++++++++++++++++++++----------------------
lib/Math/BigInt.pm | 49 +++++++++---------
2 files changed, 83 insertions(+), 82 deletions(-)
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index b17b06f..6800f62 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -2189,16 +2189,16 @@ sub bdiv {
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- delete $x->{_a}; # clear before round
+ $x->{_a} = undef; # clear before round
$x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- delete $x->{_p}; # clear before round
+ $x->{_p} = undef; # clear before round
$x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
if (wantarray) {
@@ -2208,8 +2208,8 @@ sub bdiv {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $rem->{_a};
- delete $rem->{_p};
+ $rem->{_a} = undef;
+ $rem->{_p} = undef;
}
$x = $downgrade -> new($x -> bdstr(), @r)
if defined($downgrade) && $x -> is_int();
@@ -2565,8 +2565,8 @@ sub blog {
if ($done) {
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
return $downgrade -> new($x -> bdstr(), @r)
if defined($downgrade) && $x->is_int();
@@ -2584,8 +2584,8 @@ sub blog {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
$done = 0;
@@ -2626,8 +2626,8 @@ sub blog {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -2688,8 +2688,8 @@ sub bexp {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -2810,8 +2810,8 @@ sub bexp {
}
} else {
# else just round the already computed result
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
$x = $x->bround($params[0], $params[2]); # then round accordingly
@@ -2821,8 +2821,8 @@ sub bexp {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -2910,8 +2910,8 @@ sub bsin {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -2926,8 +2926,8 @@ sub bsin {
my $sign = 1; # start with -=
my $below = $class->new(6);
my $factorial = $class->new(4);
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
my $limit = $class->new("1E-". ($scale-1));
while (1) {
@@ -2959,8 +2959,8 @@ sub bsin {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -3014,8 +3014,8 @@ sub bcos {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
my $over = $x * $x; # X ^ 2
my $x2 = $over->copy(); # X ^ 2; difference between terms
@@ -3023,8 +3023,8 @@ sub bcos {
my $below = $class->new(2);
my $factorial = $class->new(3);
$x = $x->bone();
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
my $limit = $class->new("1E-". ($scale-1));
#my $steps = 0;
@@ -3057,8 +3057,8 @@ sub bcos {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -3167,8 +3167,8 @@ sub batan {
$$pbr = undef;
# We also need to disable any set A or P on $x (_find_round_parameters
# took them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -3183,8 +3183,8 @@ sub batan {
my $sign = 1; # start with -=
my $below = $class->new(3);
my $two = $class->new(2);
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
my $limit = $class->new("1E-". ($scale-1));
#my $steps = 0;
@@ -3225,8 +3225,8 @@ sub batan {
}
if ($fallback) {
# Clear a/p after round, since user did not request it.
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
@@ -3322,8 +3322,8 @@ sub batan2 {
$y = $y -> round(@r);
if ($fallback) {
- delete $y->{_a};
- delete $y->{_p};
+ $y->{_a} = undef;
+ $y->{_p} = undef;
}
return $y;
@@ -3380,8 +3380,8 @@ sub bsqrt {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -3414,8 +3414,8 @@ sub bsqrt {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# re-enable A and P, upgrade is taken care of by "local"
${"$class\::accuracy"} = $ab;
@@ -3496,8 +3496,8 @@ sub bsqrt {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -3567,8 +3567,8 @@ sub broot {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -3623,8 +3623,8 @@ sub broot {
}
if ($done == 0) {
my $u = $class->bone()->bdiv($y, $scale+4);
- delete $u->{_a};
- delete $u->{_p};
+ $u->{_a} = undef;
+ $u->{_p} = undef;
$x = $x->bpow($u, $scale+4); # el cheapo
}
}
@@ -3638,8 +3638,8 @@ sub broot {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
@@ -3995,7 +3995,7 @@ sub bround {
$m = $m->bround($scale, $mode); # round mantissa
$x->{_m} = $m->{value}; # get our mantissa back
$x->{_a} = $scale; # remember rounding
- delete $x->{_p}; # and clear P
+ $x->{_p} = undef; # and clear P
# bnorm() downgrades if necessary, so no need to check whether to downgrade.
$x->bnorm(); # del trailing zeros gen. by bround()
@@ -4040,7 +4040,7 @@ sub bfround {
}
$x->{_p} = $scale; # remember round in any case
- delete $x->{_a}; # and clear A
+ $x->{_a} = undef; # and clear A
if ($scale < 0) {
# round right from the '.'
@@ -5520,8 +5520,8 @@ sub _log {
last if $next->bacmp($limit) <= 0;
- delete $next->{_a};
- delete $next->{_p};
+ $next->{_a} = undef;
+ $next->{_p} = undef;
$x = $x->badd($next);
# calculate things for the next term
$over *= $u;
@@ -5792,8 +5792,8 @@ sub _pow {
$$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
# Disabling upgrading and downgrading is no longer necessary to avoid an
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
@@ -5843,8 +5843,8 @@ sub _pow {
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a};
- delete $x->{_p};
+ $x->{_a} = undef;
+ $x->{_p} = undef;
}
# restore globals
$$abr = $ab;
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 4dd8fec..c355c7a 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -350,27 +350,27 @@ sub accuracy {
if (@_ > 0) {
my $a = shift;
if (defined $a) {
- $a = $a->numify() if ref($a) && $a->can('numify');
+ $a = $a -> can('numify') ? $a -> numify() : 0 + "$a" if ref($a);
# also croak on non-numerical
- if (!$a || $a <= 0) {
- croak('Argument to accuracy must be greater than zero');
- }
- if (int($a) != $a) {
- croak('Argument to accuracy must be an integer');
- }
+ croak "accuracy must be a number, not '$a'"
+ unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
+ croak "accuracy must be an integer, not '$a'"
+ if $a != int $a;
+ croak "accuracy must be greater than zero, not '$a'"
+ if $a <= 0;
}
if (ref($x)) {
# Set instance variable.
- $x = $x->bround($a) if $a; # not for undef, 0
- $x->{_a} = $a; # set/overwrite, even if not rounded
- delete $x->{_p}; # clear P
+ $x = $x->bround($a) if defined $a;
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ $x->{_p} = undef; # clear P
# Why return class variable here? Fixme!
$a = ${"${class}::accuracy"} unless defined $a;
} else {
# Set class variable.
- ${"${class}::accuracy"} = $a; # set global A
- ${"${class}::precision"} = undef; # clear global P
+ ${"${class}::accuracy"} = $a; # set global A
+ ${"${class}::precision"} = undef; # clear global P
}
return $a; # shortcut
@@ -396,23 +396,24 @@ sub precision {
if (@_ > 0) {
my $p = shift;
if (defined $p) {
- $p = $p->numify() if ref($p) && $p->can('numify');
- if ($p != int $p) {
- croak('Argument to precision must be an integer');
- }
+ $p = $p -> can('numify') ? $p -> numify() : 0 + "$p" if ref($p);
+ croak "precision must be a number, not '$p'"
+ unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
+ croak "precision must be an integer, not '$p'"
+ if $p != int $p;
}
if (ref($x)) {
# Set instance variable.
- $x = $x->bfround($p) if $p; # not for undef, 0
- $x->{_p} = $p; # set/overwrite, even if not rounded
- delete $x->{_a}; # clear A
+ $x = $x->bfround($p) if defined $p;
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ $x->{_a} = undef; # clear A
# Why return class variable here? Fixme!
$p = ${"${class}::precision"} unless defined $p;
} else {
# Set class variable.
- ${"${class}::precision"} = $p; # set global P
- ${"${class}::accuracy"} = undef; # clear global A
+ ${"${class}::precision"} = $p; # set global P
+ ${"${class}::accuracy"} = undef; # clear global A
}
return $p; # shortcut
@@ -3770,7 +3771,7 @@ sub bfround {
# no-op for Math::BigInt objects if $n <= 0
$x = $x->bround($x->length()-$scale, $mode) if $scale > 0;
- delete $x->{_a}; # delete to save memory
+ $x->{_a} = undef;
$x->{_p} = $scale; # store new _p
$x;
}
@@ -4003,8 +4004,8 @@ sub mantissa {
return $class->new($x->{sign}, @r);
}
my $m = $x->copy();
- delete $m->{_p};
- delete $m->{_a};
+ $m -> precision(undef);
+ $m -> accuracy(undef);
# that's a bit inefficient:
my $zeros = $LIB->_zeros($m->{value});