This commit is contained in:
joborun linux 2024-02-12 01:19:32 +02:00
parent 6fe7900209
commit 50ac102607
6 changed files with 857 additions and 18 deletions

View File

@ -0,0 +1,184 @@
From 441f53eb116a003c78acad32f133b16f2f4c0814 Mon Sep 17 00:00:00 2001
From: Peter John Acklam <pjacklam@gmail.com>
Date: Wed, 6 Jul 2022 13:11:15 +0200
Subject: [PATCH] Instance methods should return instance variables
- When accuracy() and precision() are used as instance methods, they
should return the instance variables, not the class variables.
- New instances should get the accuracy/precision from the class
variables, not from other instances. The only exception is for
instances created with copy().
- Adjust a few existing tests, and add more tests to confirm behaviour.
---
lib/Math/BigFloat.pm | 8 ++---
lib/Math/BigInt.pm | 4 +--
t/mbimbf.t | 71 +++++++++++++++++++++++++++++++++++-------
xt/author/sparts-mbf.t | 4 +--
4 files changed, 65 insertions(+), 22 deletions(-)
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 6800f62..0fabbee 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -4394,17 +4394,13 @@ sub sparts {
# Finite number.
- my $mant = $x -> copy();
+ my $mant = $class -> new($x);
$mant->{_es} = '+';
$mant->{_e} = $LIB->_zero();
$mant = $downgrade -> new($mant) if defined $downgrade;
return $mant unless wantarray;
- my $expo = bless { sign => $x -> {_es},
- _m => $LIB->_copy($x -> {_e}),
- _es => '+',
- _e => $LIB->_zero(),
- }, $class;
+ my $expo = $class -> new($x -> {_es} . $LIB->_str($x -> {_e}));
$expo = $downgrade -> new($expo) if defined $downgrade;
return ($mant, $expo);
}
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index c355c7a..c2dfe7c 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -377,7 +377,7 @@ sub accuracy {
}
# Return instance variable.
- return $x->{_a} if ref($x) && (defined($x->{_a}) || defined($x->{_p}));
+ return $x->{_a} if ref($x);
# Return class variable.
return ${"${class}::accuracy"};
@@ -420,7 +420,7 @@ sub precision {
}
# Return instance variable.
- return $x->{_p} if ref($x) && (defined($x->{_a}) || defined($x->{_p}));
+ return $x->{_p} if ref($x);
# Return class variable.
return ${"${class}::precision"};
diff --git a/t/mbimbf.t b/t/mbimbf.t
index 23599dd..064ca36 100644
--- a/t/mbimbf.t
+++ b/t/mbimbf.t
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Test::More tests => 712 # tests in require'd file
- + 26; # tests in this file
+ + 52; # tests in this file
use Math::BigInt only => 'Calc';
use Math::BigFloat;
@@ -58,24 +58,71 @@ foreach my $class (qw/Math::BigInt Math::BigFloat/) {
}
foreach my $class (qw/Math::BigInt Math::BigFloat/) {
- $class->accuracy(42);
+ my $x;
- # $x gets A of 42, too!
- my $x = $class->new(123);
+ # Accuracy
- # really?
- is($x->accuracy(), 42, '$x has A of 42');
+ # set and check the class accuracy
+ $class->accuracy(1);
+ is($class->accuracy(), 1, "$class has A of 1");
- # $x has no A, but the global is still in effect for $x so the return value
- # of that operation should be 42, not undef
- is($x->accuracy(undef), 42, '$x has A from global');
+ # a new instance gets the class accuracy
+ $x = $class->new(123);
+ is($x->accuracy(), 1, '$x has A of 1');
- # so $x should still have A = 42
- is($x->accuracy(), 42, '$x has still A of 42');
+ # set and check the instance accuracy
+ $x->accuracy(2);
+ is($x->accuracy(), 2, '$x has A of 2');
- # reset for further tests
+ # change the class accuracy
+ $class->accuracy(3);
+ is($class->accuracy(), 3, "$class has A of 3");
+
+ # verify that the instance accuracy hasn't changed
+ is($x->accuracy(), 2, '$x still has A of 2');
+
+ # change the instance accuracy
+ $x->accuracy(undef);
+ is($x->accuracy(), undef, '$x now has A of undef');
+
+ # check the class accuracy
+ is($class->accuracy(), 3, "$class still has A of 3");
+
+ # change the class accuracy again
$class->accuracy(undef);
+ is($class->accuracy(), undef, "$class now has A of undef");
+
+ # Precision
+
+ # set and check the class precision
+ $class->precision(1);
+ is($class->precision(), 1, "$class has A of 1");
+
+ # a new instance gets the class precision
+ $x = $class->new(123);
+ is($x->precision(), 1, '$x has A of 1');
+
+ # set and check the instance precision
+ $x->precision(2);
+ is($x->precision(), 2, '$x has A of 2');
+
+ # change the class precision
+ $class->precision(3);
+ is($class->precision(), 3, "$class has A of 3");
+
+ # verify that the instance precision hasn't changed
+ is($x->precision(), 2, '$x still has A of 2');
+
+ # change the instance precision
+ $x->precision(undef);
+ is($x->precision(), undef, '$x now has A of undef');
+
+ # check the class precision
+ is($class->precision(), 3, "$class still has A of 3");
+
+ # change the class precision again
$class->precision(undef);
+ is($class->precision(), undef, "$class now has A of undef");
}
# bug with blog(Math::BigFloat, Math::BigInt)
diff --git a/xt/author/sparts-mbf.t b/xt/author/sparts-mbf.t
index f67ec95..45c0d64 100644
--- a/xt/author/sparts-mbf.t
+++ b/xt/author/sparts-mbf.t
@@ -57,7 +57,7 @@ note(qq|\nVerify that accuracy depends on invocand, not class.\n\n|);
my ($mant, $expo) = $x -> sparts();
cmp_ok($mant, '==', 3, "value of significand");
cmp_ok($expo, '==', 0, "value of exponent");
- cmp_ok($mant -> accuracy(), '==', 10, "accuracy of significand");
+ cmp_ok($mant -> accuracy(), '==', 20, "accuracy of significand");
cmp_ok($expo -> accuracy(), '==', 20, "accuracy of exponent");
}
@@ -71,7 +71,7 @@ note(qq|\nVerify that precision depends on invocand, not class.\n\n|);
my ($mant, $expo) = $x -> sparts();
cmp_ok($mant, '==', 3, "value of significand");
cmp_ok($expo, '==', 0, "value of exponent");
- cmp_ok($mant -> precision(), '==', 10, "precision of significand");
+ cmp_ok($mant -> precision(), '==', 20, "precision of significand");
cmp_ok($expo -> precision(), '==', 20, "precision of exponent");
}

View File

@ -0,0 +1,170 @@
From 5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5 Mon Sep 17 00:00:00 2001
From: Peter John Acklam <pjacklam@gmail.com>
Date: Fri, 31 Mar 2023 15:09:35 +0200
Subject: [PATCH] Fix CPAN RT #146411
- Avoid infinite recursion in bitwise operations. This happened when
arguments were upgraded and downgraded and upgraded again ad
infinitum.
- Add tests to verify the fix.
---
lib/Math/BigFloat.pm | 70 ++++++++++++++++++++++++--------------------
t/upgrade.inc | 6 ++++
t/upgrade.t | 2 +-
3 files changed, 45 insertions(+), 33 deletions(-)
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 0fabbee..fd08990 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -3856,16 +3856,18 @@ sub band {
return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
- my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp = $xtmp -> band($y);
+ my $xint = $x -> as_int(); # to Math::BigInt
+ my $yint = $y -> as_int(); # to Math::BigInt
- return $xtmp -> round(@r) if defined $downgrade;
+ $xint = $xint -> band($yint);
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
- $x -> {sign} = $xtmp -> {sign};
- $x -> {_m} = $xtmp -> {_m};
- $x -> {_es} = $xtmp -> {_es};
- $x -> {_e} = $xtmp -> {_e};
+ return $xint -> round(@r) if defined $downgrade;
+
+ my $xflt = $class -> new($xint); # back to Math::BigFloat
+ $x -> {sign} = $xflt -> {sign};
+ $x -> {_m} = $xflt -> {_m};
+ $x -> {_es} = $xflt -> {_es};
+ $x -> {_e} = $xflt -> {_e};
return $x -> round(@r);
}
@@ -3879,16 +3881,18 @@ sub bior {
return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
- my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp = $xtmp -> bior($y);
+ my $xint = $x -> as_int(); # to Math::BigInt
+ my $yint = $y -> as_int(); # to Math::BigInt
+
+ $xint = $xint -> bior($yint);
- return $xtmp -> round(@r) if defined $downgrade;
+ return $xint -> round(@r) if defined $downgrade;
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
- $x -> {sign} = $xtmp -> {sign};
- $x -> {_m} = $xtmp -> {_m};
- $x -> {_es} = $xtmp -> {_es};
- $x -> {_e} = $xtmp -> {_e};
+ my $xflt = $class -> new($xint); # back to Math::BigFloat
+ $x -> {sign} = $xflt -> {sign};
+ $x -> {_m} = $xflt -> {_m};
+ $x -> {_es} = $xflt -> {_es};
+ $x -> {_e} = $xflt -> {_e};
return $x -> round(@r);
}
@@ -3902,16 +3906,18 @@ sub bxor {
return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
- my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp = $xtmp -> bxor($y);
+ my $xint = $x -> as_int(); # to Math::BigInt
+ my $yint = $y -> as_int(); # to Math::BigInt
+
+ $xint = $xint -> bxor($yint);
- return $xtmp -> round(@r) if defined $downgrade;
+ return $xint -> round(@r) if defined $downgrade;
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
- $x -> {sign} = $xtmp -> {sign};
- $x -> {_m} = $xtmp -> {_m};
- $x -> {_es} = $xtmp -> {_es};
- $x -> {_e} = $xtmp -> {_e};
+ my $xflt = $class -> new($xint); # back to Math::BigFloat
+ $x -> {sign} = $xflt -> {sign};
+ $x -> {_m} = $xflt -> {_m};
+ $x -> {_es} = $xflt -> {_es};
+ $x -> {_e} = $xflt -> {_e};
return $x -> round(@r);
}
@@ -3923,16 +3929,16 @@ sub bnot {
return $x -> bnan(@r) if $x -> is_nan();
- my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp = $xtmp -> bnot();
+ my $xint = $x -> as_int(); # to Math::BigInt
+ $xint = $xint -> bnot();
- return $xtmp -> round(@r) if defined $downgrade;
+ return $xint -> round(@r) if defined $downgrade;
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
- $x -> {sign} = $xtmp -> {sign};
- $x -> {_m} = $xtmp -> {_m};
- $x -> {_es} = $xtmp -> {_es};
- $x -> {_e} = $xtmp -> {_e};
+ my $xflt = $class -> new($xint); # back to Math::BigFloat
+ $x -> {sign} = $xflt -> {sign};
+ $x -> {_m} = $xflt -> {_m};
+ $x -> {_es} = $xflt -> {_es};
+ $x -> {_e} = $xflt -> {_e};
return $x -> round(@r);
}
diff --git a/t/upgrade.inc b/t/upgrade.inc
index d8bd119..dcd2ad6 100644
--- a/t/upgrade.inc
+++ b/t/upgrade.inc
@@ -1108,6 +1108,8 @@ abc:0:NaN
-7:-4:-8
-7:4:0
-4:7:4
+1:0.5:0
+
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0x0xFFFF
0xFFFFFF:0xFFFFFF:0x0xFFFFFF
@@ -1140,6 +1142,8 @@ abc:0:NaN
-6:-6:-6
-7:4:-3
-4:7:-1
+1:0.5:1
+
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0x0xFFFF
0xFFFFFF:0xFFFFFF:0x0xFFFFFF
@@ -1189,6 +1193,8 @@ abc:0:NaN
-4:7:-5
4:-7:-3
-4:-7:5
+1:0.5:1
+
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0
0xFFFFFF:0xFFFFFF:0
diff --git a/t/upgrade.t b/t/upgrade.t
index 132c9c5..43e562f 100644
--- a/t/upgrade.t
+++ b/t/upgrade.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 2134 # tests in require'd file
+use Test::More tests => 2140 # tests in require'd file
+ 6; # tests in this file
use Math::BigInt;

View File

@ -6,13 +6,14 @@
#-----------------------------------------| DESCRIPTION |---------------------------------------
pkgname=perl
pkgver=5.38.1
pkgver=5.38.2
_baseversion="${pkgver%.*}"
pkgrel=01
pkgdesc="A highly capable, feature-rich programming language"
groups=( jobbot )
url="https://www.perl.org"
depends=('gdbm>=1.17' 'db5.3' 'db' 'glibc' 'libxcrypt' 'libcrypt.so')
depends=('gdbm>=1.17' 'db5.3' 'glibc' 'libxcrypt' 'libcrypt.so')
makedepends=('patchutils')
checkdepends=('procps-ng')
# NOTE: This array is automatically generated by `./patchprov`.
# If you want to add entries, do so in the next array.
@ -80,7 +81,7 @@ provides=('perl-archive-tar=2.40'
'perl-math-complex=1.62'
'perl-memoize=1.16'
'perl-mime-base64=3.16_01'
'perl-module-corelist=5.20231125'
'perl-module-corelist=5.20231129'
'perl-module-load-conditional=0.74'
'perl-module-load=0.36'
'perl-module-loaded=0.08'
@ -132,10 +133,12 @@ provides=('perl-archive-tar=2.40'
# Add your own provides here
provides=("${provides[@]}")
source=(https://www.cpan.org/src/5.0/perl-${pkgver}.tar.xz
# https://github.com/andk/cpanpm/commit/9c98370287.patch
https://github.com/pjacklam/p5-Math-BigInt/commit/c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch
https://github.com/pjacklam/p5-Math-BigInt/commit/441f53eb116a003c78acad32f133b16f2f4c0814.patch
https://github.com/pjacklam/p5-Math-BigInt/commit/5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5.patch
sha256.txt::https://www.cpan.org/src/5.0/perl-$pkgver.tar.xz.sha256.txt
config.over
db_config.in
# db_config.in
perlbin.csh
perlbin.fish
perlbin.sh
@ -146,10 +149,24 @@ options=('makeflags' '!purge' 'emptydirs')
prepare() {
cd "${pkgname}-${pkgver}"
# Temporarily make files to be patched writable.
chmod +w cpan/Math-BigInt/{lib/Math/Big{Float,Int}.pm,t/{mbimbf.t,upgrade.{inc,t}}}
# p5-Math-BigInt:Improve handling of accuracy and precision
filterdiff -p1 ../5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5.patch \
-x xt/author/sparts-mbf.t | patch -Np1 -d cpan/Math-BigInt/
# p5-Math-BigInt:Instance methods should return instance variables
filterdiff -p1 ../441f53eb116a003c78acad32f133b16f2f4c0814.patch \
-x xt/author/sparts-mbf.t | patch -Np1 -d cpan/Math-BigInt/
# p5-Math-BigInt:Fix CPAN RT #146411
patch -Np1 -i "$srcdir"/c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch \
-d cpan/Math-BigInt/
# Remove temporary write permission.
chmod -w cpan/Math-BigInt/{lib/Math/Big{Float,Int}.pm,t/{mbimbf.t,upgrade.{inc,t}}}
# reproducible patchlevel_date
[ -n "${SOURCE_DATE_EPOCH}" ] && touch -h -d @$SOURCE_DATE_EPOCH patchlevel.h
cp -f ../db_config.in ./cpan/DB_File/config.in
# cp -f ../db_config.in ./cpan/DB_File/config.in
# Fix test error in 5.38.1
if [[ "$pkgver" == "5.38.1" ]]; then
@ -178,7 +195,9 @@ build() {
-Dvendorscript=/usr/bin/vendor_perl \
-Dinc_version_list=none \
-Dman1ext=1perl -Dman3ext=3perl \
-Dlddlflags="-shared ${LDFLAGS}" -Dldflags="${LDFLAGS}"
-Dlddlflags="-shared ${LDFLAGS}" -Dldflags="${LDFLAGS}" \
-Dloclibpth="/usr/lib/db5.3" -Dlocincpth="/usr/include/db5.3"
make
}
@ -241,13 +260,17 @@ license=('GPL' 'PerlArtistic')
# https://www.cpan.org/src/5.0/perl-$pkgver.tar.xz.sha256.txt
sha256sums=(6a82c7930563086e78cb84d9c265e6b212ee65d509d19eedcd23ab8c1ba3f046 # perl-5.38.1.tar.xz
sha256sums=(d91115e90b896520e83d4de6b52f8254ef2b70a8d545ffab33200ea9f1cf29e8 # perl-5.38.2.tar.xz
0f3c63d553c9a82ad4b39d2e0cf410d713b0795a22f818455d81eb46c341fb85 # c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch
8bfd02a6ce8d1949448f3d1592e2b2fc7063d0c1a3a371ab9f00404628f3ae28 # 441f53eb116a003c78acad32f133b16f2f4c0814.patch
1658523b8554a24bd82886659440faa890c63d4be57cc1e1ef92c88b075487aa # 5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5.patch
57bdfe28ad65b2c2953dfd36586b67bc524f72bd4b29028f26223c812ace0ef5 # sha256.txt
84c7fae94f591f25d6568dd300f57bfe4924092559ab2d96f1038e67c353d190 # config.over
898dd20de9f9438cdcc0e5ca61fabea696a6eb0226647500f222dc4f8d8377af # db_config.in
# 898dd20de9f9438cdcc0e5ca61fabea696a6eb0226647500f222dc4f8d8377af # db_config.in
3834ddced7051fd6e2d189db48c9266efe21bad467d2c6700c9c232830f6bfd9 # perlbin.csh
9b49a13607df8966a3f86f698d25f4b577be66405cc08f98869a03295617d3d1 # perlbin.fish
35491e903f0d93df995cda3c11a900a7e96df699d53f5ba49e1379150aaf0fbb # perlbin.sh
786f3c7938b0738337f7d47112ea7b84fd0e2d6c1af331b7d5e67b9865d6d2b4 # detect-old-perl-modules.hook
c5db3dcd1db71724fa4df5db34586688aa8db92ac6ffcbddaaa213c71cceff20) # detect-old-perl-modules.sh
##

View File

@ -5,14 +5,15 @@
# Contributor: francois <francois.archlinux.org>
pkgname=perl
pkgver=5.38.1
pkgver=5.38.2
_baseversion="${pkgver%.*}"
pkgrel=1
pkgdesc="A highly capable, feature-rich programming language"
arch=(x86_64)
license=('GPL' 'PerlArtistic')
url="https://www.perl.org"
depends=('gdbm>=1.17' 'db5.3' 'db' 'glibc' 'libxcrypt' 'libcrypt.so')
depends=('gdbm>=1.17' 'db5.3' 'glibc' 'libxcrypt' 'libcrypt.so')
makedepends=('patchutils')
checkdepends=('procps-ng')
# NOTE: This array is automatically generated by `./patchprov`.
# If you want to add entries, do so in the next array.
@ -80,7 +81,7 @@ provides=('perl-archive-tar=2.40'
'perl-math-complex=1.62'
'perl-memoize=1.16'
'perl-mime-base64=3.16_01'
'perl-module-corelist=5.20231125'
'perl-module-corelist=5.20231129'
'perl-module-load-conditional=0.74'
'perl-module-load=0.36'
'perl-module-loaded=0.08'
@ -132,17 +133,21 @@ provides=('perl-archive-tar=2.40'
# Add your own provides here
provides=("${provides[@]}")
source=(https://www.cpan.org/src/5.0/perl-${pkgver}.tar.xz
https://github.com/pjacklam/p5-Math-BigInt/commit/c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch
https://github.com/pjacklam/p5-Math-BigInt/commit/441f53eb116a003c78acad32f133b16f2f4c0814.patch
https://github.com/pjacklam/p5-Math-BigInt/commit/5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5.patch
config.over
db_config.in
perlbin.sh
perlbin.csh
perlbin.fish
detect-old-perl-modules.sh
detect-old-perl-modules.hook)
options=('makeflags' '!purge' 'emptydirs')
sha512sums=('720b2c2707f219509e652bc3d80f9ce82bec85f882dee9ff88b6bc5183064d66333651830daeb92a6e96bbe5d9d48581ab8496ce9427f8db6103fc438e2c05db'
sha512sums=('0ca51e447c7a18639627c281a1c7ae6662c773745ea3c86bede46336d5514ecc97ded2c61166e1ac15635581489dc596368907aa3a775b34db225b76d7402d10'
'0327bb66f2cff72e0a81723b09204088afb558530f8b1a69dd50cb8f50fff138f14c5d02d7e7ffa69aafcffce3e8e3d34c44dc693b194ec8d8a7d3aded081865'
'a01b581b5af7899cafdc860d685741e782d97c7b56b3fc4bfb526ee0b3711f92f0ba4027fe2863190e6f10fa91a441b0185ad0a82174b254baacfbb9969bc9a6'
'470ae0f4624e6493ecb66aadbd282f1560e315dbe282264717c768d182cace4c23690b330c318821063155a6f2b1aa19c4fe7126ebf32e9e6953078990b81e9e'
'1c924b5bf7413d097f62638a574d7decf36d98598b84cdb5fb31ff633b6f953371e14b004a2558a1a0b74b6b60b90b481af0f68555a49208fe6b226381fed79f'
'444e03c9a6040c1b4f19872d849e93322ffad40262339edb0b7961d2de47a161f01074f2d5418a057fd62e900ff1fbf5ea8ba4e3384aaa86fda84c80d0550a2b'
'6ed5bc6dbdc47bc7f4c0fedbe18deaf35ab02a2e6700988beb545954bb1d0fe20ff1a4de39d6d9fc882ef1741f7bf6d85ba165d0cd8dc0d9939b789c894f48a1'
'53eb0cddfd637014f3d3a101665db8dcafe5ac5bf3d319a259974334eb89c1c405097518ae96b6d18e520194633c7be57c9b2cd9ae6398443eb08f1a2008d112'
'881e2efe05ba818cd7300f126800b56bb0685cb5c9c5fb7e67ef6aaf5abd17d2391a979d5d16d109c5111f4b35504ba83d19b0e6eda4431e8421fcbea19d2f1a'
@ -153,10 +158,22 @@ sha512sums=('720b2c2707f219509e652bc3d80f9ce82bec85f882dee9ff88b6bc5183064d66333
prepare() {
cd "${pkgname}-${pkgver}"
# Temporarily make files to be patched writable.
chmod +w cpan/Math-BigInt/{lib/Math/Big{Float,Int}.pm,t/{mbimbf.t,upgrade.{inc,t}}}
# p5-Math-BigInt:Improve handling of accuracy and precision
filterdiff -p1 ../5020d66cc0ece2a5fbf5cb182ab7ab62c8adade5.patch \
-x xt/author/sparts-mbf.t | patch -Np1 -d cpan/Math-BigInt/
# p5-Math-BigInt:Instance methods should return instance variables
filterdiff -p1 ../441f53eb116a003c78acad32f133b16f2f4c0814.patch \
-x xt/author/sparts-mbf.t | patch -Np1 -d cpan/Math-BigInt/
# p5-Math-BigInt:Fix CPAN RT #146411
patch -Np1 -i "$srcdir"/c8e5f82f10959085f7ce3ec74b3caaaf72497693.patch \
-d cpan/Math-BigInt/
# Remove temporary write permission.
chmod -w cpan/Math-BigInt/{lib/Math/Big{Float,Int}.pm,t/{mbimbf.t,upgrade.{inc,t}}}
# reproducible patchlevel_date
[ -n "${SOURCE_DATE_EPOCH}" ] && touch -h -d @$SOURCE_DATE_EPOCH patchlevel.h
cp -f ../db_config.in ./cpan/DB_File/config.in
# Fix test error in 5.38.1
if [[ "$pkgver" == "5.38.1" ]]; then
@ -184,7 +201,8 @@ build() {
-Dvendorscript=/usr/bin/vendor_perl \
-Dinc_version_list=none \
-Dman1ext=1perl -Dman3ext=3perl \
-Dlddlflags="-shared ${LDFLAGS}" -Dldflags="${LDFLAGS}"
-Dlddlflags="-shared ${LDFLAGS}" -Dldflags="${LDFLAGS}" \
-Dloclibpth="/usr/lib/db5.3" -Dlocincpth="/usr/include/db5.3"
make
}

View File

@ -0,0 +1,443 @@
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});

View File

@ -1,3 +1,4 @@
db5.3
patchutils