diff options
85 files changed, 5517 insertions, 538 deletions
@@ -28,6 +28,215 @@ example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ Version v5.7.X Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 15449] By: jhi on 2002/03/23 20:44:57 + Log: Subject: perldoc -m [PATCH] + From: "John L. Allen" <allen@grumman.com> + Date: Fri, 22 Mar 2002 15:38:35 -0500 (EST) + Message-ID: <Pine.SOL.3.91.1020322151516.25645A-100000@gateway.grumman.com> + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 15448] By: jhi on 2002/03/23 20:42:30 + Log: Subject: Re: Copious warnings from Sys::Syslog + From: andreas.koenig@anima.de (Andreas J. Koenig) + Date: Sat, 23 Mar 2002 06:47:08 +0100 + Message-ID: <m31yebvns3.fsf@anima.de> + Branch: perl + ! ext/Sys/Syslog/Syslog.pm +____________________________________________________________________________ +[ 15447] By: jhi on 2002/03/23 20:34:43 + Log: Upgrade to Math::BigInt 1.55, from Tels. + Branch: perl + + lib/Math/BigInt/t/mbi_rand.t lib/Math/BigInt/t/use_lib1.t + + lib/Math/BigInt/t/use_lib2.t lib/Math/BigInt/t/use_lib3.t + + lib/Math/BigInt/t/use_lib4.t + ! MANIFEST lib/Math/BigFloat.pm lib/Math/BigInt.pm + ! lib/Math/BigInt/Calc.pm lib/Math/BigInt/t/bare_mbf.t + ! lib/Math/BigInt/t/bare_mbi.t lib/Math/BigInt/t/bigfltpm.inc + ! lib/Math/BigInt/t/bigfltpm.t lib/Math/BigInt/t/bigintpm.inc + ! lib/Math/BigInt/t/bigintpm.t lib/Math/BigInt/t/config.t + ! lib/Math/BigInt/t/constant.t lib/Math/BigInt/t/sub_mbf.t + ! lib/Math/BigInt/t/sub_mbi.t lib/Math/BigInt/t/upgrade.inc + ! lib/Math/BigInt/t/upgrade.t +____________________________________________________________________________ +[ 15446] By: jhi on 2002/03/23 19:50:02 + Log: Upgrade to Encode 0.97, from Dan Kogai. + Branch: perl + ! ext/Encode/AUTHORS ext/Encode/Byte/Makefile.PL + ! ext/Encode/CN/CN.pm ext/Encode/CN/Makefile.PL + ! ext/Encode/Changes ext/Encode/EBCDIC/Makefile.PL + ! ext/Encode/Encode.pm ext/Encode/Encode.xs + ! ext/Encode/JP/Makefile.PL ext/Encode/KR/KR.pm + ! ext/Encode/KR/Makefile.PL ext/Encode/Makefile.PL + ! ext/Encode/Symbol/Makefile.PL ext/Encode/TW/Makefile.PL + ! ext/Encode/TW/TW.pm ext/Encode/compile ext/Encode/t/CN.t + ! ext/Encode/t/Encode.t ext/Encode/t/JP.t ext/Encode/t/TW.t + ! ext/Encode/t/Tcl.t +____________________________________________________________________________ +[ 15445] By: jhi on 2002/03/23 17:33:08 + Log: Slight tweaks on #15443. + Branch: perl + ! pod/perlvar.pod +____________________________________________________________________________ +[ 15444] By: nick on 2002/03/23 17:30:42 + Log: Integrate mainline + Branch: perlio + +> ext/Encode/Byte/Byte.pm ext/Encode/Byte/Makefile.PL + +> ext/Encode/EBCDIC/EBCDIC.pm ext/Encode/EBCDIC/Makefile.PL + +> ext/Encode/Symbol/Makefile.PL ext/Encode/Symbol/Symbol.pm + !> (integrate 50 files) +____________________________________________________________________________ +[ 15443] By: jhi on 2002/03/23 17:30:09 + Log: Subject: patch [bleadperl]: Document %! special variable + From: mjd@plover.com + Date: 23 Mar 2002 18:25:44 -0000 + Message-ID: <20020323182544.11741.qmail@plover.com> + Branch: perl + ! pod/perlvar.pod +____________________________________________________________________________ +[ 15442] By: jhi on 2002/03/23 17:17:47 + Log: Since the Encode::JP is unsupported under EBCDIC we + cannot run this test (aliases as such should work fine). + Branch: perl + ! ext/Encode/t/Aliases.t +____________________________________________________________________________ +[ 15441] By: jhi on 2002/03/23 17:15:15 + Log: EBCDIC: the sorting order is different under + byte-EBCDIC and Unicode. + Branch: perl + ! t/op/utfhash.t +____________________________________________________________________________ +[ 15440] By: jhi on 2002/03/23 17:09:17 + Log: EBCDIC: the character codes are different. + Branch: perl + ! lib/Pod/t/pod2html-lib.pl +____________________________________________________________________________ +[ 15439] By: jhi on 2002/03/23 03:05:11 + Log: Purify: #15434 got the test the wrong. + (Is there an approved way of testing "is this an unop"?) + Branch: perl + ! op.c +____________________________________________________________________________ +[ 15438] By: jhi on 2002/03/23 01:40:53 + Log: Purify: Array bounds read: could read one character past the end. + Branch: perl + ! pp_pack.c +____________________________________________________________________________ +[ 15437] By: jhi on 2002/03/23 01:22:10 + Log: Purify: Array bounds read: reading one byte before the buffer. + Branch: perl + ! util.c +____________________________________________________________________________ +[ 15436] By: jhi on 2002/03/23 01:14:24 + Log: Purify: Unitialized memory read. Too many code paths + to keep track of, I guess. + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 15435] By: jhi on 2002/03/23 01:00:31 + Log: Purify: Array bounds write: pre-extend the strxfrm + buffer by a factor of four (suggested maximum by HP-UX; + Solaris suggests using 1 + strxfrm(NULL, s, 0) but I don't + know how portable that is; locale.c uses yet another trick + (not a particularly good trick, I might add)) + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 15434] By: jhi on 2002/03/23 00:48:23 + Log: Purify: Array bounds read: o->op_last was accessed + for unops (via newUNOP() and ck_eof()). + (analysis okay, patch bad: see #15439) + Branch: perl + ! op.c +____________________________________________________________________________ +[ 15433] By: jhi on 2002/03/22 23:19:34 + Log: Subject: [PATCH] vms/test.com, File::Find tests + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 22 Mar 2002 16:52:59 -0600 + Message-Id: <5.1.0.14.2.20020322162822.01ad96b8@exchi01> + Branch: perl + ! vms/test.com +____________________________________________________________________________ +[ 15432] By: jhi on 2002/03/22 23:18:44 + Log: Subject: [PATCH] Re: [ID 20020322.002] install man errors + From: Michael G Schwern <schwern@pobox.com> + Date: Fri, 22 Mar 2002 18:08:19 -0500 + Message-ID: <20020322230819.GB16454@blackrider> + Branch: perl + ! ext/Sys/Syslog/Syslog.pm +____________________________________________________________________________ +[ 15431] By: jhi on 2002/03/22 21:52:56 + Log: Update the information on Encode. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 15430] By: jhi on 2002/03/22 21:48:28 + Log: Upgrade to Encode 0.96, from Dan Kogai. + Branch: perl + + ext/Encode/Byte/Byte.pm ext/Encode/Byte/Makefile.PL + + ext/Encode/EBCDIC/EBCDIC.pm ext/Encode/EBCDIC/Makefile.PL + + ext/Encode/Symbol/Makefile.PL ext/Encode/Symbol/Symbol.pm + ! MANIFEST ext/Encode/AUTHORS ext/Encode/CN/CN.pm + ! ext/Encode/Changes ext/Encode/Encode.pm ext/Encode/Encode.xs + ! ext/Encode/JP/JP.pm ext/Encode/KR/KR.pm ext/Encode/MANIFEST + ! ext/Encode/Makefile.PL ext/Encode/TW/TW.pm + ! ext/Encode/lib/Encode/Alias.pm + ! ext/Encode/lib/Encode/Encoding.pm + ! ext/Encode/lib/Encode/Internal.pm + ! ext/Encode/lib/Encode/Supported.pod ext/Encode/t/Aliases.t +____________________________________________________________________________ +[ 15429] By: jhi on 2002/03/22 20:52:18 + Log: Subject: [PATCH] h2xs.t fix for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 22 Mar 2002 15:47:38 -0600 + Message-Id: <5.1.0.14.2.20020322154432.01ad4930@exchi01> + Branch: perl + ! lib/h2xs.t +____________________________________________________________________________ +[ 15428] By: jhi on 2002/03/22 20:50:42 + Log: One more pass. + Branch: perl + ! epoc/config.sh +____________________________________________________________________________ +[ 15427] By: jhi on 2002/03/22 20:46:43 + Log: Even better version from Olaf Flebbe. + Branch: perl + ! epoc/config.sh pp_sys.c util.c +____________________________________________________________________________ +[ 15426] By: jhi on 2002/03/22 20:34:28 + Log: EPOC update from Olaf Flebbe. + Branch: perl + ! epoc/config.sh epoc/createpkg.pl epoc/epoc.c epoc/epoc_stubs.c + ! epoc/epocish.c epoc/epocish.h pp_sys.c util.c +____________________________________________________________________________ +[ 15425] By: jhi on 2002/03/22 20:03:33 + Log: Tweak from John P. Linderman. + Branch: perl + ! pod/perlhack.pod +____________________________________________________________________________ +[ 15424] By: jhi on 2002/03/22 17:08:36 + Log: Subject: [PATCH pod/perlfunc.pod] doc fix + From: Stas Bekman <stas@stason.org> + Date: Sat, 23 Mar 2002 01:42:44 +0800 (SGT) + Message-ID: <Pine.LNX.4.44.0203230138520.8695-100000@hope.stason.org> + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 15423] By: jhi on 2002/03/22 17:06:42 + Log: Subject: [PATCH] check sysconf's return value in reentr.c + From: <slaven.rezic@berlin.de> + Date: Fri, 22 Mar 2002 18:30:36 +0100 + Message-Id: <20020322173246.SOLG27460.mailoutvl21@[192.168.139.30]> + + (plus use 4k instead 2k as the "usual" size) + Branch: perl + ! reentr.c reentr.pl +____________________________________________________________________________ +[ 15422] By: jhi on 2002/03/22 15:23:38 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 15421] By: jhi on 2002/03/22 15:18:30 Log: Forgot from #15416. Branch: perl @@ -893,10 +893,22 @@ lib/base.pm Establish IS-A relationship at compile time lib/Benchmark.pm Measure execution time lib/Benchmark.t See if Benchmark works lib/bigfloat.pl An arbitrary precision floating point package -lib/bigfloat.t See if bigfloat.pl works +lib/bigfloatpl.t See if bigfloat.pl works lib/bigint.pl An arbitrary precision integer arithmetic package -lib/bigint.t See if bigint.pl works +lib/bigint.pm bignum +lib/bigintpl.t See if bigint.pl works +lib/bignum.pm bignum +lib/bignum/t/bigint.t See if bignum works +lib/bignum/t/bignum.t See if bignum works +lib/bignum/t/bigrat.t See if bignum works +lib/bignum/t/bn_lite.t See if bignum works +lib/bignum/t/br_lite.t See if bignum works +lib/bignum/t/option_a.t See if bignum works +lib/bignum/t/option_l.t See if bignum works +lib/bignum/t/option_p.t See if bignum works +lib/bignum/t/trace.t See if bignum works lib/bigrat.pl An arbitrary precision rational arithmetic package +lib/bigrat.pm bignum lib/blib.pm For "use blib" lib/blib.t blib.pm test lib/bytes.pm Pragma to enable byte operations @@ -1158,6 +1170,7 @@ lib/Locale/Script.pm Locale::Codes lib/Locale/Script.pod Locale::Codes documentation lib/look.pl A "look" equivalent lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package +lib/Math/BigFloat/Trace.pm bignum tracing lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc @@ -1175,6 +1188,7 @@ lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling lib/Math/BigInt/t/isa.t Test for Math::BigInt inheritance lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precicion and fallback, round_mode tests lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode +lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly lib/Math/BigInt/t/require.t Test if require Math::BigInt works lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt @@ -1182,6 +1196,17 @@ lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works +lib/Math/BigInt/t/use_lib1.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib2.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib3.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib4.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/Trace.pm bignum tracing +lib/Math/BigRat.pm Math::BigRat +lib/Math/BigRat/t/bigfltpm.inc Math::BigRat test +lib/Math/BigRat/t/bigfltrt.t Math::BigRat test +lib/Math/BigRat/t/bigrat.t Math::BigRat test +lib/Math/BigRat/t/bigratpm.inc Math::BigRat test +lib/Math/BigRat/t/bigratpm.t Math::BigRat test lib/Math/Complex.pm A Complex package lib/Math/Complex.t See if Math::Complex works lib/Math/Trig.pm A simple interface to complex trigonometry @@ -2242,6 +2267,7 @@ t/lib/locale/utf8 Part of locale.t in UTF8 t/lib/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test t/lib/Math/BigInt/BareCalc.pm Bigint's simulation of Calc t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test +t/lib/Math/BigRat/Test.pm Math::BigRat test helper t/lib/sample-tests/bailout Test data for Test::Harness t/lib/sample-tests/combined Test data for Test::Harness t/lib/sample-tests/descriptive Test data for Test::Harness diff --git a/configure.com b/configure.com index d7d0479fa7..cfa695cac5 100644 --- a/configure.com +++ b/configure.com @@ -4943,24 +4943,29 @@ $ GOSUB compile $ nv_preserves_uv_bits = tmp $ ENDIF $! -$ echo4 "Checking whether your kill() uses SYS$FORCEX..." +$ echo4 "Checking if kill() uses SYS$FORCEX or can't be called from a signal handler..." $ kill_by_sigprc = "undef" $ OS $ WS "#include <stdio.h>" $ WS "#include <signal.h>" $ WS "#include <unistd.h>" -$ WS "void handler(int s) { printf(""%d\n"",s); } " +$ WS "void handler1(int s) { printf(""%d"",s); kill(getpid(),2); }" +$ WS "void handler2(int s) { printf(""%d"",s); }" $ WS "main(){" $ WS " printf(""0"");" -$ WS " signal(1,handler); kill(getpid(),1);" +$ WS " signal(1,handler1);" +$ WS " signal(2,handler2);" +$ WS " kill(getpid(),1);" +$ WS " sleep(1);" +$ WS " printf(""\n"");" $ WS "}" $ CS $ ON ERROR THEN CONTINUE $ GOSUB compile -$ IF tmp .NES. "01" +$ IF tmp .NES. "012" $ THEN -$ echo4 "Yes, it does." -$ echo4 "Checking whether we can use SYS$SIGPRC instead" +$ echo4 "Yes, it has at least one of those limitations." +$ echo4 "Checking whether we can use SYS$SIGPRC instead..." $ OS $ WS "#include <stdio.h>" $ WS "#include <lib$routines.h>" @@ -906,9 +906,9 @@ Ap |void |reginitcolors Apd |char* |sv_2pv_nolen |SV* sv Apd |char* |sv_2pvutf8_nolen|SV* sv Apd |char* |sv_2pvbyte_nolen|SV* sv -Apd |char* |sv_pv |SV *sv -Apd |char* |sv_pvutf8 |SV *sv -Apd |char* |sv_pvbyte |SV *sv +Amd |char* |sv_pv |SV *sv +Amd |char* |sv_pvutf8 |SV *sv +Amd |char* |sv_pvbyte |SV *sv Amd |STRLEN |sv_utf8_upgrade|SV *sv ApdM |bool |sv_utf8_downgrade|SV *sv|bool fail_ok Apd |void |sv_utf8_encode |SV *sv @@ -855,9 +855,6 @@ #define sv_2pv_nolen Perl_sv_2pv_nolen #define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen #define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen -#define sv_pv Perl_sv_pv -#define sv_pvutf8 Perl_sv_pvutf8 -#define sv_pvbyte Perl_sv_pvbyte #define sv_utf8_downgrade Perl_sv_utf8_downgrade #define sv_utf8_encode Perl_sv_utf8_encode #define sv_utf8_decode Perl_sv_utf8_decode @@ -2406,9 +2403,6 @@ #define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a) #define sv_2pvutf8_nolen(a) Perl_sv_2pvutf8_nolen(aTHX_ a) #define sv_2pvbyte_nolen(a) Perl_sv_2pvbyte_nolen(aTHX_ a) -#define sv_pv(a) Perl_sv_pv(aTHX_ a) -#define sv_pvutf8(a) Perl_sv_pvutf8(aTHX_ a) -#define sv_pvbyte(a) Perl_sv_pvbyte(aTHX_ a) #define sv_utf8_downgrade(a,b) Perl_sv_utf8_downgrade(aTHX_ a,b) #define sv_utf8_encode(a) Perl_sv_utf8_encode(aTHX_ a) #define sv_utf8_decode(a) Perl_sv_utf8_decode(aTHX_ a) diff --git a/ext/Encode/AUTHORS b/ext/Encode/AUTHORS index 5b65c8a555..ad4064d1aa 100644 --- a/ext/Encode/AUTHORS +++ b/ext/Encode/AUTHORS @@ -12,8 +12,11 @@ Anton Tagunov <tagunov@motor.ru> Autrijus Tang <autrijus@autrijus.org> Dan Kogai <dankogai@dan.co.jp> +Gerrit P. Haase <gp@familiehaase.de> Jarkko Hietaniemi <jhi@iki.fi> Michael G Schwern <schwern@pobox.com> +Nicholas Clark <nick@ccl4.org> Nick Ing-Simmons <nick@ing-simmons.net> Paul Marquess <paul_marquess@yahoo.co.uk> SADAHIRO Tomoyuki <SADAHIRO@cpan.org> +Spider Boardman <spider@web.zk3.dec.com> diff --git a/ext/Encode/Byte/Makefile.PL b/ext/Encode/Byte/Makefile.PL index a49b4f10fc..590a0d0a37 100644 --- a/ext/Encode/Byte/Makefile.PL +++ b/ext/Encode/Byte/Makefile.PL @@ -4,13 +4,13 @@ use ExtUtils::MakeMaker; my $name = 'Byte'; my %tables = ( - '8bit' => + byte_t => [ - 'ascii.ucm', + # 'ascii.ucm', 'koi8-r.ucm', 'viscii.ucm', ], - Mac => + mac_t => [ qw(macCentEuro.enc macCroatian.enc macCyrillic.enc macDingbats.enc @@ -19,7 +19,6 @@ my %tables = ( macSami.enc macThai.enc macTurkish.enc macUkraine.enc), ], - ); opendir(ENC,'../Encode'); @@ -27,7 +26,7 @@ while (defined(my $file = readdir(ENC))) { if ($file =~ /(8859|ibm).*\.ucm/io) { - push(@{$tables{$1}},$file); + push(@{$tables{$1."_t"}},$file) unless $file eq '8859-1.ucm'; } } closedir(ENC); diff --git a/ext/Encode/CN/CN.pm b/ext/Encode/CN/CN.pm index 9fbe8433ed..51d90bb5ec 100644 --- a/ext/Encode/CN/CN.pm +++ b/ext/Encode/CN/CN.pm @@ -1,5 +1,10 @@ package Encode::CN; -our $VERSION = do { my @r = (q$Revision: 0.96 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +BEGIN { + if (ord("A") == 193) { + die "Encode::CN not supported on EBCDIC\n"; + } +} +our $VERSION = do { my @r = (q$Revision: 0.97 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode; use Encode::CN::HZ; diff --git a/ext/Encode/CN/Makefile.PL b/ext/Encode/CN/Makefile.PL index 4dadad4a69..9fa4d067cd 100644 --- a/ext/Encode/CN/Makefile.PL +++ b/ext/Encode/CN/Makefile.PL @@ -2,11 +2,11 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; -my %tables = (EUC_CN => ['euc-cn.enc'], - GB2312 => ['gb2312.enc'], - GB12345 => ['gb12345.enc'], - CP936 => ['cp936.enc'], - 'ISO_IR_165' => ['iso-ir-165.enc'], +my %tables = (euc_cn_t => ['euc-cn.enc'], + '2312_t' => ['gb2312.enc'], + '12345_t' => ['gb12345.enc'], + cp_cn_t => ['cp936.enc'], + ir_165_t => ['iso-ir-165.enc'], ); my $name = 'CN'; diff --git a/ext/Encode/Changes b/ext/Encode/Changes index 2f7ac079d7..a981280638 100644 --- a/ext/Encode/Changes +++ b/ext/Encode/Changes @@ -1,8 +1,60 @@ # Revision history for Perl extension Encode. # -# $Id: Changes,v 0.96 2002/03/22 22:22:53 dankogai Exp dankogai $ +# $Id: Changes,v 0.97 2002/03/23 20:24:42 dankogai Exp dankogai $ # +0.97 Sun Mar 24 2002 +! CN/CN.pm +! KR/KR.pm +! TW/TW.pm + EBCDIC detection mechanism installed as in JP/JP.pm + Message-Id: <20020323211847.G19148@alpha.hut.fi> +! Byte/Makefile.PL +! CN/Makefile.PL +! EBCDIC/Makefile.PL +! JP/Makefile.PL +! KR/Makefile.PL +! Symbol/Makefile.PL +! TW/Makefile.PL + Now all table files used by compile are postfixed '_t' to avoid + namespace collisions in case insensitive file systems once for all! + inspired by: + Message-ID: <58290227735.20020323195659@familiehaase.de> +! t/Aliases.t + Since the Encode::JP is unsupported under EBCDIC we + cannot run this test (aliases as such should work fine) -- jhi + Message-Id: <20020323202119.D19148@alpha.hut.fi> +! Byte/Makefile.PL + duplicate occurance of ascii.ucm and 8859-1.ucm + causes MacOS X dlyd to cloak +! t/CN.t +! t/Encode.t +! t/JP.t +! t/TW.t +! t/Tcl.t + < chdir 't' if -d 't'; + --- + > if (! -d 'blib' and -d 't'){ chdir 't' }; + When you are "make test"-ing on Encode/ directory, you must not + change $ENV{PWD}. t/JP.t has been fixed before but others somehow + remain unchanced. Also the situation detection was made simpler + in t/JP.t, which was originally; + > chdir 't' if -d 't' and $ENV{PWD} !~ m,/Encode[^/]*$,o; +! Encode.pm + "Use of uninitialized value in string eq at Encode.pm line 96." +! Symbol/Makefile.PL +! EBCDIC/Makefile.PL +! AUTHOR + -- Problem on case insensitive file systems + "coexist of ebcdic.c <> EBCDIC.c on Cygwin not possible" + Message-ID: <88254111953.20020323095503@familiehaase.de> +! compile +! AUTHOR + "So I think it's a bug in gcc, not perl. But it still needs to be + worked around." + Message-Id: <20020323145840.GD304@Bagpuss.unfortu.net> + Message-Id: <20020323170509.C96475@plum.flirble.org> + 0.96 Sat Mar 23 2002 ! TW/TW.pm ! lib/Encode/Encoding.pm diff --git a/ext/Encode/EBCDIC/Makefile.PL b/ext/Encode/EBCDIC/Makefile.PL index 607406c18a..1830a2663c 100644 --- a/ext/Encode/EBCDIC/Makefile.PL +++ b/ext/Encode/EBCDIC/Makefile.PL @@ -4,7 +4,7 @@ use ExtUtils::MakeMaker; my $name = 'EBCDIC'; my %tables = ( - ebcdic => ['cp1047.ucm','cp37.ucm','posix-bc.ucm'], + ebcdic_t => ['cp1047.ucm','cp37.ucm','posix-bc.ucm'], ); WriteMakefile( diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index be7547fc9c..7886c63826 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -1,6 +1,6 @@ package Encode; use strict; -our $VERSION = do { my @r = (q$Revision: 0.96 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +our $VERSION = do { my @r = (q$Revision: 0.97 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; our $DEBUG = 0; require DynaLoader; @@ -93,7 +93,7 @@ for my $k (qw(centeuro croatian cyrillic dingbats greek sub encodings { my $class = shift; - my @modules = ($_[0] eq ":all") ? values %ExtModule : @_; + my @modules = (@_ and $_[0] eq ":all") ? values %ExtModule : @_; for my $m (@modules) { $DEBUG and warn "about to require $m;"; diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index 68474b6318..e4f7b10cbd 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -8,7 +8,7 @@ /* #include "8859.h" */ /* #include "EBCDIC.h" */ /* #include "Symbols.h" */ -#include "defcodes.h" +#include "def_t.h" #define UNIMPLEMENTED(x,y) y x (SV *sv, char *encoding) {dTHX; \ Perl_croak(aTHX_ "panic_unimplemented"); \ @@ -793,5 +793,5 @@ BOOT: /* #include "8859_def.h" */ /* #include "EBCDIC_def.h" */ /* #include "Symbols_def.h" */ -#include "defcodes_def.h" +#include "def_t_def.h" } diff --git a/ext/Encode/JP/Makefile.PL b/ext/Encode/JP/Makefile.PL index cb98de2b63..75c4125070 100644 --- a/ext/Encode/JP/Makefile.PL +++ b/ext/Encode/JP/Makefile.PL @@ -3,10 +3,10 @@ use strict; use ExtUtils::MakeMaker; my %tables = ( - EUC_JP => ['euc-jp.ucm'], - SHIFTJIS => ['shiftjis.enc'], - MACJAPAN => ['macJapan.enc'], - CP932 => ['cp932.enc'], + euc_jp_t => ['euc-jp.ucm'], + sjis_t => ['shiftjis.enc'], + mac_jp_t => ['macJapan.enc'], + cp_jp_t => ['cp932.enc'], ); my $name = 'JP'; diff --git a/ext/Encode/KR/KR.pm b/ext/Encode/KR/KR.pm index e920cf7631..7dcafd0441 100644 --- a/ext/Encode/KR/KR.pm +++ b/ext/Encode/KR/KR.pm @@ -1,5 +1,10 @@ package Encode::KR; -our $VERSION = do { my @r = (q$Revision: 0.96 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +BEGIN { + if (ord("A") == 193) { + die "Encode::KR not supported on EBCDIC\n"; + } +} +our $VERSION = do { my @r = (q$Revision: 0.97 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode; use XSLoader; diff --git a/ext/Encode/KR/Makefile.PL b/ext/Encode/KR/Makefile.PL index 9b8303d506..ffe4ae4c77 100644 --- a/ext/Encode/KR/Makefile.PL +++ b/ext/Encode/KR/Makefile.PL @@ -2,9 +2,9 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; -my %tables = (EUC_KR => ['euc-kr.enc'], - KSC5601 => ['ksc5601.enc'], - CP949 => ['cp949.enc'], +my %tables = (euc_kr_t => ['euc-kr.enc'], + '5601_t' => ['ksc5601.enc'], + cp_kr_t => ['cp949.enc'], ); my $name = 'KR'; diff --git a/ext/Encode/Makefile.PL b/ext/Encode/Makefile.PL index 1afc7250ef..c2e77b2406 100644 --- a/ext/Encode/Makefile.PL +++ b/ext/Encode/Makefile.PL @@ -4,9 +4,9 @@ use ExtUtils::MakeMaker; my %tables = ( - defcodes => ['ascii.ucm', - '8859-1.ucm', - ] + def_t => ['ascii.ucm', + '8859-1.ucm', + ] ); WriteMakefile( diff --git a/ext/Encode/Symbol/Makefile.PL b/ext/Encode/Symbol/Makefile.PL index be99058ae1..79a3d6e6de 100644 --- a/ext/Encode/Symbol/Makefile.PL +++ b/ext/Encode/Symbol/Makefile.PL @@ -4,7 +4,7 @@ use ExtUtils::MakeMaker; my $name = 'Symbol'; my %tables = ( - symbol => ['symbol.ucm','dingbats.ucm'], + symbol_t => ['symbol.ucm','dingbats.ucm'], ); WriteMakefile( diff --git a/ext/Encode/TW/Makefile.PL b/ext/Encode/TW/Makefile.PL index 003428e6e8..20968b53cd 100644 --- a/ext/Encode/TW/Makefile.PL +++ b/ext/Encode/TW/Makefile.PL @@ -2,9 +2,9 @@ use 5.7.2; use strict; use ExtUtils::MakeMaker; -my %tables = ('BIG5' => ['big5.enc'], - 'BIG5_HKSCS' => ['big5-hkscs.enc'], - 'CP950' => ['cp950.enc'], +my %tables = (big5_t => ['big5.enc'], + big5_hk_t => ['big5-hkscs.enc'], + cp_tw_t => ['cp950.enc'], ); my $name = 'TW'; diff --git a/ext/Encode/TW/TW.pm b/ext/Encode/TW/TW.pm index 58764ba24b..b44c8d2acb 100644 --- a/ext/Encode/TW/TW.pm +++ b/ext/Encode/TW/TW.pm @@ -1,5 +1,10 @@ package Encode::TW; -our $VERSION = do { my @r = (q$Revision: 0.96 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +BEGIN { + if (ord("A") == 193) { + die "Encode::TW not supported on EBCDIC\n"; + } +} +our $VERSION = do { my @r = (q$Revision: 0.97 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; use Encode; use XSLoader; diff --git a/ext/Encode/compile b/ext/Encode/compile index a76676b288..76deee95c9 100755 --- a/ext/Encode/compile +++ b/ext/Encode/compile @@ -592,7 +592,11 @@ sub outstring { next unless (my $i = index($o,$s)) >= 0; $sym = $strings{$o}; - $sym .= sprintf("+0x%02x",$i) if ($i); + # gcc things that 0x0e+0x10 (anything with e+) starts to look like + # a hexadecimal floating point constant. Silly gcc. Only p + # introduces a floating point constant. Put the space in to stop it + # getting confused. + $sym .= sprintf(" +0x%02x",$i) if ($i); $subsave += length($s); return $strings{$s} = $sym; } diff --git a/ext/Encode/t/Aliases.t b/ext/Encode/t/Aliases.t index 70dd09f345..3640f4b097 100644 --- a/ext/Encode/t/Aliases.t +++ b/ext/Encode/t/Aliases.t @@ -4,6 +4,13 @@ use strict; use Encode; use Encode::Alias; +BEGIN { + if (ord("A") == 193) { + print "1..0 # Skip: EBCDIC\n"; + exit 0; + } +} + my %a2c; BEGIN { diff --git a/ext/Encode/t/CN.t b/ext/Encode/t/CN.t index 671ee05dd0..e995391180 100644 --- a/ext/Encode/t/CN.t +++ b/ext/Encode/t/CN.t @@ -1,5 +1,5 @@ BEGIN { - chdir 't' if -d 't'; + if (! -d 'blib' and -d 't'){ chdir 't' }; unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bEncode\b/) { diff --git a/ext/Encode/t/Encode.t b/ext/Encode/t/Encode.t index 9c21578290..4e396e13e8 100644 --- a/ext/Encode/t/Encode.t +++ b/ext/Encode/t/Encode.t @@ -1,5 +1,5 @@ BEGIN { - chdir 't' if -d 't'; + if (! -d 'blib' and -d 't'){ chdir 't' }; unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bEncode\b/) { diff --git a/ext/Encode/t/JP.t b/ext/Encode/t/JP.t index 733aeb9a15..457f20400f 100644 --- a/ext/Encode/t/JP.t +++ b/ext/Encode/t/JP.t @@ -1,4 +1,5 @@ BEGIN { + if (! -d 'blib' and -d 't'){ chdir 't' }; chdir 't' if -d 't' and $ENV{PWD} !~ m,/Encode[^/]*$,o; unshift @INC, '../lib'; require Config; import Config; diff --git a/ext/Encode/t/TW.t b/ext/Encode/t/TW.t index a902d23ace..830eb8686a 100644 --- a/ext/Encode/t/TW.t +++ b/ext/Encode/t/TW.t @@ -1,5 +1,5 @@ BEGIN { - chdir 't' if -d 't'; + if (! -d 'blib' and -d 't'){ chdir 't' }; unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bEncode\b/) { diff --git a/ext/Encode/t/Tcl.t b/ext/Encode/t/Tcl.t index 96dc2141f4..5de9436b07 100644 --- a/ext/Encode/t/Tcl.t +++ b/ext/Encode/t/Tcl.t @@ -1,5 +1,5 @@ BEGIN { - chdir 't' if -d 't'; + if (! -d 'blib' and -d 't'){ chdir 't' }; unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bEncode\b/) { diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm index 6fe349d172..edd813ad8a 100644 --- a/ext/Sys/Syslog/Syslog.pm +++ b/ext/Sys/Syslog/Syslog.pm @@ -7,7 +7,7 @@ use Carp; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(openlog closelog setlogmask syslog); @EXPORT_OK = qw(setlogsock); -$VERSION = '0.02'; +$VERSION = '0.03'; # it would be nice to try stream/unix first, since that will be # most efficient. However streams are dodgy - see _syslog_send_stream @@ -316,7 +316,7 @@ sub syslog { disconnect(); } &connect unless $connected; - $failed = undef if ($current_proto eq $failed); + $failed = undef if ($current_proto && $failed && $current_proto eq $failed); if ($syslog_send) { if (&{$syslog_send}($buf)) { $transmit_ok++; @@ -400,7 +400,7 @@ sub connect { $transmit_ok = 0; if ($connected) { - $current_proto = $proto; + $current_proto = $proto; local($old) = select(SYSLOG); $| = 1; select($old); } else { @fallbackMethods = (); @@ -442,7 +442,7 @@ sub connect_tcp { } setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1); setsockopt(SYSLOG, IPPROTO_TCP, TCP_NODELAY, 1); - if (!connect(SYSLOG,$that)) { + if (!CORE::connect(SYSLOG,$that)) { push(@{$errs}, "tcp connect: $!"); return 0; } @@ -477,7 +477,7 @@ sub connect_udp { push(@{$errs}, "udp socket: $!"); return 0; } - if (!connect(SYSLOG,$that)) { + if (!CORE::connect(SYSLOG,$that)) { push(@{$errs}, "udp connect: $!"); return 0; } @@ -526,12 +526,12 @@ sub connect_unix { push(@{$errs}, "unix stream socket: $!"); return 0; } - if (!connect(SYSLOG,$that)) { + if (!CORE::connect(SYSLOG,$that)) { if (!socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0)) { push(@{$errs}, "unix dgram socket: $!"); return 0; } - if (!connect(SYSLOG,$that)) { + if (!CORE::connect(SYSLOG,$that)) { push(@{$errs}, "unix dgram connect: $!"); return 0; } diff --git a/ext/Unicode/Normalize/README b/ext/Unicode/Normalize/README index 1f28333ca2..d24f0c7bfe 100644 --- a/ext/Unicode/Normalize/README +++ b/ext/Unicode/Normalize/README @@ -1,4 +1,4 @@ -Unicode/Normalize version 0.15 +Unicode/Normalize version 0.16 =================================== Unicode::Normalize - normalized forms of Unicode text diff --git a/global.sym b/global.sym index d826bc6fc7..f86942ef7b 100644 --- a/global.sym +++ b/global.sym @@ -573,9 +573,6 @@ Perl_reginitcolors Perl_sv_2pv_nolen Perl_sv_2pvutf8_nolen Perl_sv_2pvbyte_nolen -Perl_sv_pv -Perl_sv_pvutf8 -Perl_sv_pvbyte Perl_sv_utf8_downgrade Perl_sv_utf8_encode Perl_sv_utf8_decode diff --git a/lib/ExtUtils/MM_NW5.pm b/lib/ExtUtils/MM_NW5.pm index 59080df5f5..5b00186d7f 100644 --- a/lib/ExtUtils/MM_NW5.pm +++ b/lib/ExtUtils/MM_NW5.pm @@ -25,6 +25,7 @@ use Config; use File::Basename; require Exporter; +use ExtUtils::MakeMaker; Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index ad6588e9bc..d47b5f1f2a 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -12,15 +12,16 @@ package Math::BigFloat; # _p: precision # _f: flags, used to signal MBI not to touch our private parts -$VERSION = '1.30'; +$VERSION = '1.31'; require 5.005; use Exporter; -use Math::BigInt qw/objectify/; +use File::Spec; +# use Math::BigInt; @ISA = qw( Exporter Math::BigInt); use strict; use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/; -use vars qw/$upgrade $downgrade/; +use vars qw/$upgrade $downgrade $MBI/; my $class = "Math::BigFloat"; use overload @@ -48,16 +49,21 @@ $div_scale = 40; $upgrade = undef; $downgrade = undef; +$MBI = 'Math::BigInt'; # the package we are using for our private parts + # changable by use Math::BigFloat with => 'package' ############################################################################## # the old code had $rnd_mode, so we need to support it, too -$rnd_mode = 'even'; sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } sub FETCH { return $round_mode; } sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } -BEGIN { tie $rnd_mode, 'Math::BigFloat'; } +BEGIN + { + $rnd_mode = 'even'; + tie $rnd_mode, 'Math::BigFloat'; + } ############################################################################## @@ -104,7 +110,7 @@ sub new if ((ref($wanted)) && (ref($wanted) ne $class)) { $self->{_m} = $wanted->as_number(); # get us a bigint copy - $self->{_e} = Math::BigInt->bzero(); + $self->{_e} = $MBI->bzero(); $self->{_m}->babs(); $self->{sign} = $wanted->sign(); return $self->bnorm(); @@ -115,8 +121,8 @@ sub new { return $downgrade->new($wanted) if $downgrade; - $self->{_e} = Math::BigInt->bzero(); - $self->{_m} = Math::BigInt->bzero(); + $self->{_e} = $MBI->bzero(); + $self->{_m} = $MBI->bzero(); $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self->bnorm(); @@ -129,16 +135,16 @@ sub new return $downgrade->bnan() if $downgrade; - $self->{_e} = Math::BigInt->bzero(); - $self->{_m} = Math::BigInt->bzero(); + $self->{_e} = $MBI->bzero(); + $self->{_m} = $MBI->bzero(); $self->{sign} = $nan; } else { # make integer from mantissa by adjusting exp, then convert to bigint # undef,undef to signal MBI that we don't need no bloody rounding - $self->{_e} = Math::BigInt->new("$$es$$ev",undef,undef); # exponent - $self->{_m} = Math::BigInt->new("$$miv$$mfv",undef,undef); # create mant. + $self->{_e} = $MBI->new("$$es$$ev",undef,undef); # exponent + $self->{_m} = $MBI->new("$$miv$$mfv",undef,undef); # create mant. # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0; $self->{sign} = $$mis; @@ -163,39 +169,39 @@ sub _bnan { # used by parent class bone() to initialize number to 1 my $self = shift; - $self->{_m} = Math::BigInt->bzero(); - $self->{_e} = Math::BigInt->bzero(); + $self->{_m} = $MBI->bzero(); + $self->{_e} = $MBI->bzero(); } sub _binf { # used by parent class bone() to initialize number to 1 my $self = shift; - $self->{_m} = Math::BigInt->bzero(); - $self->{_e} = Math::BigInt->bzero(); + $self->{_m} = $MBI->bzero(); + $self->{_e} = $MBI->bzero(); } sub _bone { # used by parent class bone() to initialize number to 1 my $self = shift; - $self->{_m} = Math::BigInt->bone(); - $self->{_e} = Math::BigInt->bzero(); + $self->{_m} = $MBI->bone(); + $self->{_e} = $MBI->bzero(); } sub _bzero { # used by parent class bone() to initialize number to 1 my $self = shift; - $self->{_m} = Math::BigInt->bzero(); - $self->{_e} = Math::BigInt->bone(); + $self->{_m} = $MBI->bzero(); + $self->{_e} = $MBI->bone(); } sub isa { my ($self,$class) = @_; - return if $class eq 'Math::BigInt'; # we aren't - return UNIVERSAL::isa($self,$class); + return if $class =~ /^Math::BigInt/; # we aren't one of these + UNIVERSAL::isa($self,$class); } ############################################################################## @@ -264,7 +270,7 @@ sub bstr my $zeros = -$x->{_p} + $cad; $es .= $dot.'0' x $zeros if $zeros > 0; } - return $es; + $es; } sub bsstr @@ -285,7 +291,7 @@ sub bsstr } my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-'; my $sep = 'e'.$sign; - return $x->{_m}->bstr().$sep.$x->{_e}->bstr(); + $x->{_m}->bstr().$sep.$x->{_e}->bstr(); } sub numify @@ -293,7 +299,7 @@ sub numify # Make a number from a BigFloat object # simple return string and let Perl's atoi()/atof() handle the rest my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return $x->bsstr(); + $x->bsstr(); } ############################################################################## @@ -429,8 +435,7 @@ sub badd return $x if $x->{sign} eq $y->{sign}; return $x->bnan(); } - # +-inf + something => +inf - # something +-inf => +-inf + # +-inf + something => +inf; something +-inf => +-inf $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; return $x; } @@ -448,11 +453,10 @@ sub badd # take lower of the two e's and adapt m1 to it to match m2 my $e = $y->{_e}; - $e = Math::BigInt::bzero() if !defined $e; # if no BFLOAT ? - $e = $e->copy(); # make copy (didn't do it yet) + $e = $MBI->bzero() if !defined $e; # if no BFLOAT ? + $e = $e->copy(); # make copy (didn't do it yet) $e->bsub($x->{_e}); my $add = $y->{_m}->copy(); -# if ($e < 0) # < 0 if ($e->{sign} eq '-') # < 0 { my $e1 = $e->copy()->babs(); @@ -460,7 +464,6 @@ sub badd $x->{_m}->blsft($e1,10); $x->{_e} += $e; # need the sign of e } -# if ($e > 0) # > 0 elsif (!$e->is_zero()) # > 0 { #$add *= (10 ** $e); @@ -947,13 +950,12 @@ sub bmod { $x->{_m}->blsft($x->{_e},10); } - $x->{_e} = Math::BigInt->bzero() unless $x->{_e}->is_zero(); + $x->{_e} = $MBI->bzero() unless $x->{_e}->is_zero(); $x->{_e}->bsub($shiftx) if $shiftx != 0; $x->{_e}->bsub($shifty) if $shifty != 0; # now mantissas are equalized, exponent of $x is adjusted, so calc result -# $ym->{sign} = '-' if $neg; # bmod() will make the correction for us $x->{_m}->bmod($ym); @@ -1023,7 +1025,7 @@ sub bsqrt && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head? { # exact result - $x->{_m} = $gs; $x->{_e} = Math::BigInt->bzero(); $x->bnorm(); + $x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm(); # shortcut to not run trough _find_round_parameters again if (defined $params[1]) { @@ -1104,6 +1106,108 @@ sub bfac $x->bnorm()->round(@r); } +sub _pow2 + { + # Calculate a power where $y is a non-integer, like 2 ** 0.5 + my ($x,$y,$a,$p,$r) = @_; + my $self = ref($x); + + # we need to limit the accuracy to protect against overflow + my $fallback = 0; + my $scale = 0; + my @params = $x->_find_round_parameters($a,$p,$r); + + # no rounding at all, so must use fallback + if (scalar @params == 1) + { + # simulate old behaviour + $params[1] = $self->div_scale(); # and round to it as accuracy + $scale = $params[1]+4; # at least four more for proper round + $params[3] = $r; # round mode by caller or undef + $fallback = 1; # to clear a/p afterwards + } + else + { + # the 4 below is empirical, and there might be cases where it is not + # enough... + $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined + } + + # when user set globals, they would interfere with our calculation, so + # disable then and later re-enable them + no strict 'refs'; + my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; + my $pbr = "$self\::precision"; my $pb = $$pbr; $$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}; + # need to disable $upgrade in BigInt, to avoid deep recursion + local $Math::BigInt::upgrade = undef; + + # split the second argument into its integer and fraction part + # we calculate the result then from these two parts, like in + # 2 ** 2.4 == (2 ** 2) * (2 ** 0.4) + my $c = $self->new($y->as_number()); # integer part + my $d = $y-$c; # fractional part + my $xc = $x->copy(); # a temp. copy + + # now calculate binary fraction from the decimal fraction on the fly + # f.i. 0.654: + # 0.654 * 2 = 1.308 > 1 => 0.1 ( 1.308 - 1 = 0.308) + # 0.308 * 2 = 0.616 < 1 => 0.10 + # 0.616 * 2 = 1.232 > 1 => 0.101 ( 1.232 - 1 = 0.232) + # and so on... + # The process stops when the result is exactly one, or when we have + # enough accuracy + + # From the binary fraction we calculate the result as follows: + # we assume the fraction ends in 1, and we remove this one first. + # For each digit after the dot, assume 1 eq R and 0 eq XR, where R means + # take square root and X multiply with the original X. + + my $i = 0; + while ($i++ < 50) + { + $d->badd($d); # * 2 + last if $d->is_one(); # == 1 + $x->bsqrt(); # 0 + if ($d > 1) + { + $x->bsqrt(); $x->bmul($xc); $d->bdec(); # 1 + } + print "at $x\n"; + } + # assume fraction ends in 1 + $x->bsqrt(); # 1 + if (!$c->is_one()) + { + $x->bmul( $xc->bpow($c) ); + } + elsif (!$c->is_zero()) + { + $x->bmul( $xc ); + } + # done + + # shortcut to not run trough _find_round_parameters again + if (defined $params[1]) + { + $x->bround($params[1],$params[3]); # then round accordingly + } + else + { + $x->bfround($params[2],$params[3]); # then round accordingly + } + if ($fallback) + { + # clear a/p after round, since user did not request it + $x->{_a} = undef; $x->{_p} = undef; + } + # restore globals + $$abr = $ab; $$pbr = $pb; + $x; + } + sub _pow { # Calculate a power where $y is a non-integer, like 2 ** 0.5 @@ -1209,7 +1313,7 @@ sub bpow return $x->bone() if $y->is_zero(); return $x if $x->is_one() || $y->is_one(); - return $x->_pow($y,$a,$p,$r) if !$y->is_int(); # non-integer power + return $x->_pow2($y,$a,$p,$r) if !$y->is_int(); # non-integer power my $y1 = $y->as_number(); # make bigint # if ($x == -1) @@ -1494,7 +1598,7 @@ sub AUTOLOAD } # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() $name =~ s/^f/b/; - return &{'Math::BigInt'."::$name"}(@_); + return &{"$MBI"."::$name"}(@_); } my $bname = $name; $bname =~ s/^f/b/; *{$class."::$name"} = \&$bname; @@ -1552,6 +1656,7 @@ sub import { my $self = shift; my $l = scalar @_; my $j = 0; my @a = @_; + my $lib = ''; for ( my $i = 0; $i < $l ; $i++, $j++) { if ( $_[$i] eq ':constant' ) @@ -1575,7 +1680,28 @@ sub import my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." splice @a, $j, $s; $j -= $s; } + elsif ($_[$i] eq 'lib') + { + $lib = $_[$i+1] || ''; # default Calc + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; + } + elsif ($_[$i] eq 'with') + { + $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; + } } + my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt + my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm + $file = File::Spec->catdir (@parts, $file); + # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work + my $mbilib = eval { Math::BigInt->config()->{lib} }; + $lib .= ",$mbilib" if defined $mbilib; + require $file; + $MBI->import ( lib => $lib, 'objectify' ); + # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance $self->SUPER::import(@a); # for subclasses @@ -1643,7 +1769,7 @@ sub length $len += $x->{_e} if $x->{_e}->sign() eq '+'; if (wantarray()) { - my $t = Math::BigInt::bzero(); + my $t = $MBI->bzero(); $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-'; return ($len,$t); } @@ -1922,10 +2048,100 @@ In particular perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' -prints the value of C<2E-100>. Note that without conversion of +prints the value of C<2E-100>. Note that without conversion of constants the expression 2E-100 will be calculated as normal floating point number. +Please note that ':constant' does not affect integer constants, nor binary +nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to +work. + +=head2 Math library + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use Math::BigFloat lib => 'Calc'; + +You can change this by using: + + use Math::BigFloat lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; + +Calc.pm uses as internal format an array of elements of some decimal base +(usually 1e7, but this might be differen for some systems) with the least +significant digit first, while BitVect.pm uses a bit vector of base 2, most +significant bit first. Other modules might use even different means of +representing the numbers. See the respective module documentation for further +details. + +Please note that Math::BigFloat does B<not> use the denoted library itself, +but it merely passes the lib argument to Math::BigInt. So, instead of the need +to do: + + use Math::BigInt lib => 'GMP'; + use Math::BigFloat; + +you can roll it all into one line: + + use Math::BigFloat lib => 'GMP'; + +Use the lib, Luke! And see L<Using Math::BigInt::Lite> for more details. + +=head2 Using Math::BigInt::Lite + +It is possible to use L<Math::BigInt::Lite> with Math::BigFloat: + + # 1 + use Math::BigFloat with => 'Math::BigInt::Lite'; + +There is no need to "use Math::BigInt" or "use Math::BigInt::Lite", but you +can combine these if you want. For instance, you may want to use +Math::BigInt objects in your main script, too. + + # 2 + use Math::BigInt; + use Math::BigFloat with => 'Math::BigInt::Lite'; + +Of course, you can combine this with the C<lib> parameter. + + # 3 + use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari'; + +If you want to use Math::BigInt's, too, simple add a Math::BigInt B<before>: + + # 4 + use Math::BigInt; + use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari'; + +Notice that the module with the last C<lib> will "win" and thus +it's lib will be used if the lib is available: + + # 5 + use Math::BigInt lib => 'Bar,Baz'; + use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'Foo'; + +That would try to load Foo, Bar, Baz and Calc (in that order). Or in other +words, Math::BigFloat will try to retain previously loaded libs when you +don't specify it one. + +Actually, the lib loading order would be "Bar,Baz,Calc", and then +"Foo,Bar,Baz,Calc", but independend of which lib exists, the result is the +same as trying the latter load alone, except for the fact that Bar or Baz +might be loaded needlessly in an intermidiate step + +The old way still works though: + + # 6 + use Math::BigInt lib => 'Bar,Baz'; + use Math::BigFloat; + +But B<examples #3 and #4 are recommended> for usage. + =head1 BUGS =over 2 diff --git a/lib/Math/BigFloat/Trace.pm b/lib/Math/BigFloat/Trace.pm new file mode 100644 index 0000000000..871b2a969e --- /dev/null +++ b/lib/Math/BigFloat/Trace.pm @@ -0,0 +1,58 @@ +#!/usr/bin/perl -w + +package Math::BigFloat::Trace; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigFloat); + +$VERSION = 0.01; + +use overload; # inherit overload from BigFloat + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +sub new +{ + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; + my $self = Math::BigFloat->new($value,$a,$p,$round_mode); + +# remember, downgrading may return a BigInt, so don't meddle with class +# bless $self,$class; + + print "MBF new '$value' => '$self' (",ref($self),")"; + return $self; +} + +sub import + { + print "MBF import ",join(' ',@_); + my $self = shift; + + # we catch the constants, the rest goes go BigFloat + my @a = (); + foreach (@_) + { + push @a, $_ if $_ ne ':constant'; + } + overload::constant float => sub { $self->new(shift); }; + + Math::BigFloat->import(@a); # need it for subclasses +# $self->export_to_level(1,$self,@_); # need this ? + } + +1; diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index abe2c829b8..3c142f2b6a 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.54'; +$VERSION = '1.55'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify _swap bgcd blcm); @@ -535,7 +535,7 @@ sub binf # create a bigint '+-inf', if given a BigInt, set it to '+-inf' # the sign is either '+', or if given, used from there my $self = shift; - my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; + my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/; $self = $class if !defined $self; if (!ref($self)) { @@ -554,7 +554,8 @@ sub binf # otherwise do our own thing $self->{value} = $CALC->_zero(); } - $self->{sign} = $sign.'inf'; + $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf + $self->{sign} = $sign; ($self->{_a},$self->{_p}) = @_; # take over requested rounding return $self; } @@ -657,7 +658,7 @@ sub bstr # make a string from bigint object my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - + if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN @@ -870,12 +871,11 @@ sub bcmp # post-normalized compare for internal use (honors signs) if ($x->{sign} eq '+') { - return 1 if $y->{sign} eq '-'; # 0 check handled above + # $x and $y both > 0 return $CALC->_acmp($x->{value},$y->{value}); } - # $x->{sign} eq '-' - return -1 if $y->{sign} eq '+'; + # $x && $y both < 0 $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1) } @@ -906,8 +906,8 @@ sub badd # print "mbi badd ",join(' ',caller()),"\n"; # print "upgrade => ",$upgrade||'undef', # " \$x (",ref($x),") \$y (",ref($y),")\n"; -# return $upgrade->badd($x,$y,@r) if defined $upgrade && -# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade)); + return $upgrade->badd($x,$y,@r) if defined $upgrade && + ((ref($x) eq $upgrade) || (ref($y) eq $upgrade)); # print "still badd\n"; $r[3] = $y; # no push! @@ -1487,7 +1487,7 @@ sub bpow $x->bmul($x); } $x->bmul($pow2) unless $pow2->is_one(); - return $x->round(@r); + $x->round(@r); } sub blsft @@ -1716,10 +1716,10 @@ sub length sub digit { # return the nth decimal digit, negative values count backward, 0 is right - my $x = shift; - my $n = shift || 0; + my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + $n = 0 if !defined $n; - return $CALC->_digit($x->{value},$n); + $CALC->_digit($x->{value},$n); } sub _trailing_zeros @@ -1789,7 +1789,7 @@ sub exponent my $e = $class->bzero(); return $e->binc() if $x->is_zero(); $e += $x->_trailing_zeros(); - return $e; + $e; } sub mantissa @@ -1804,8 +1804,9 @@ sub mantissa my $m = $x->copy(); # that's inefficient my $zeros = $m->_trailing_zeros(); - $m /= 10 ** $zeros if $zeros != 0; - return $m; + $m->brsft($zeros,10) if $zeros != 0; +# $m /= 10 ** $zeros if $zeros != 0; + $m; } sub parts @@ -2153,6 +2154,7 @@ sub import { # this causes overlord er load to step in overload::constant integer => sub { $self->new(shift) }; + overload::constant binary => sub { $self->new(shift) }; splice @a, $j, 1; $j --; } elsif ($_[$i] eq 'upgrade') @@ -2711,35 +2713,60 @@ If used on an object, it will set it to one: $x->bone(); # +1 $x->bone('-'); # -1 -=head2 is_one() / is_zero() / is_nan() / is_positive() / is_negative() / -is_inf() / is_odd() / is_even() / is_int() +=head2 is_one()/is_zero()/is_nan()/is_inf() + $x->is_zero(); # true if arg is +0 $x->is_nan(); # true if arg is NaN $x->is_one(); # true if arg is +1 $x->is_one('-'); # true if arg is -1 - $x->is_odd(); # true if odd, false for even - $x->is_even(); # true if even, false for odd - $x->is_positive(); # true if >= 0 - $x->is_negative(); # true if < 0 $x->is_inf(); # true if +inf $x->is_inf('-'); # true if -inf (sign is default '+') + +These methods all test the BigInt for beeing one specific value and return +true or false depending on the input. These are faster than doing something +like: + + if ($x == 0) + +=head2 is_positive()/is_negative() + + $x->is_positive(); # true if >= 0 + $x->is_negative(); # true if < 0 + +The methods return true if the argument is positive or negative, respectively. +C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and +C<-inf> is negative. A C<zero> is positive. + +These methods are only testing the sign, and not the value. + +=head2 is_odd()/is_even()/is_int() + + $x->is_odd(); # true if odd, false for even + $x->is_even(); # true if even, false for odd $x->is_int(); # true if $x is an integer -These methods all test the BigInt for one condition and return true or false -depending on the input. +The return true when the argument satisfies the condition. C<NaN>, C<+inf>, +C<-inf> are not integers and are neither odd nor even. =head2 bcmp - $x->bcmp($y); # compare numbers (undef,<0,=0,>0) + $x->bcmp($y); + +Compares $x with $y and takes the sign into account. +Returns -1, 0, 1 or undef. =head2 bacmp - $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) + $x->bacmp($y); + +Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef. =head2 sign - $x->sign(); # return the sign, either +,- or NaN + $x->sign(); + +Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN. =head2 bcmp @@ -3381,15 +3408,15 @@ Examples for converting: =head1 Autocreating constants -After C<use Math::BigInt ':constant'> all the B<integer> decimal constants -in the given scope are converted to C<Math::BigInt>. This conversion -happens at compile time. +After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal +and binary constants in the given scope are converted to C<Math::BigInt>. +This conversion happens at compile time. In particular, perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' -prints the integer value of C<2**100>. Note that without conversion of +prints the integer value of C<2**100>. Note that without conversion of constants the expression 2**100 will be calculated as perl scalar. Please note that strings and floating point constants are not affected, @@ -3413,6 +3440,16 @@ Without the quotes Perl would convert the large number to a floating point constant at compile time and then hand the result to BigInt, which results in an truncated result or a NaN. +This also applies to integers that look like floating point constants: + + use Math::BigInt ':constant'; + + print ref(123e2),"\n"; + print ref(123.2e2),"\n"; + +will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat> +to get this to work. + =head1 PERFORMANCE Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index de4f46ea7e..a7110c9fcf 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -8,7 +8,7 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.25'; +$VERSION = '0.26'; # Package to store unsigned big integers in decimal and do math with them @@ -392,7 +392,7 @@ sub _sub { # (ref to int_num_array, ref to int_num_array, swap) # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y - # subtract Y from X (X is always greater/equal!) by modifying x in place + # subtract Y from X by modifying x in place my ($c,$sx,$sy,$s) = @_; my $car = 0; my $i; my $j = 0; @@ -410,7 +410,9 @@ sub _sub #print "case 1 (swap)\n"; for $i (@$sx) { - last unless defined $sy->[$j] || $car; + # we can't do an early out if $x is than $y, since we + # need to copy the high chunks from $y. Found by Bob Mathews. + #last unless defined $sy->[$j] || $car; $sy->[$j] += $BASE if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0); $j++; @@ -1174,7 +1176,7 @@ sub _rsft $dst++; } splice (@$x,$dst) if $dst > 0; # kill left-over array elems - pop @$x if $x->[-1] == 0; # kill last element if 0 + pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0 } # else rem == 0 $x; } diff --git a/lib/Math/BigInt/Trace.pm b/lib/Math/BigInt/Trace.pm new file mode 100644 index 0000000000..4733d22634 --- /dev/null +++ b/lib/Math/BigInt/Trace.pm @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w + +package Math::BigInt::Trace; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigInt; +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigInt); + +$VERSION = 0.01; + +use overload; # inherit overload from BigInt + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +sub new +{ + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; + my $self = Math::BigInt->new($value,$a,$p,$round_mode); + bless $self,$class; + print "MBI new '$value' => '$self' (",ref($self),")"; + return $self; +} + +sub import + { + print "MBI import ",join(' ',@_); + my $self = shift; + Math::BigInt::import($self,@_); # need it for subclasses +# $self->export_to_level(1,$self,@_); # need this ? + @_ = (); + } + +1; diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index 8288d2b189..abeb8c257c 100644 --- a/lib/Math/BigInt/t/bare_mbf.t +++ b/lib/Math/BigInt/t/bare_mbf.t @@ -26,11 +26,14 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1592; + plan tests => 1601; } -use Math::BigInt lib => 'BareCalc'; -use Math::BigFloat; +#use Math::BigInt lib => 'BareCalc'; +#use Math::BigFloat; + +# use Math::BigInt; use Math::BigFloat lib => 'BareCalc'; +use Math::BigFloat lib => 'BareCalc'; use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigFloat"; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index d480062338..5899dfe03b 100644 --- a/lib/Math/BigInt/t/bare_mbi.t +++ b/lib/Math/BigInt/t/bare_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2147; + plan tests => 2237; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index 8748d2332f..734b935168 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -153,6 +153,19 @@ $x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +############################################################################### +# bone/binf etc as plain calls (Lite failed them) + +ok ($class->fzero(),0); +ok ($class->fone(),1); +ok ($class->fone('+'),1); +ok ($class->fone('-'),-1); +ok ($class->fnan(),'NaN'); +ok ($class->finf(),'inf'); +ok ($class->finf('+'),'inf'); +ok ($class->finf('-'),'-inf'); +ok ($class->finf('-inf'),'-inf'); ############################################################################### # fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() @@ -370,7 +383,11 @@ abc:123.456:NaN # 2 ** 0.5 == sqrt(2) # 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0) 2:0.5:1.41421356237309504880168872420969807857 -2:0.2:1.148698354997035006798626946777927589444 +#2:0.2:1.148698354997035006798626946777927589444 +6:1.5:14.6969384566990685891837044482353483518 +$div_scale = 20; +#62.5:12.5:26447206647554886213592.3959144 +$div_scale = 40; &fneg fnegNaN:NaN +inf:-inf diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 2b4f83ac89..a3c0131c15 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1592; + plan tests => 1601; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 39f4c7756e..2bcf3466fb 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -164,7 +164,7 @@ while (<DATA>) }elsif ($f eq "bpow"){ $try .= "\$x ** \$y;"; }elsif ($f eq "digit"){ - $try = "\$x = $class->new('$args[0]'); \$x->digit($args[1]);"; + $try .= "\$x->digit(\$y);"; } else { warn "Unknown op '$f'"; } } # end else all other ops @@ -311,25 +311,25 @@ $x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') } @args = Math::BigInt::objectify(2,4,5); ok (scalar @args,3); # $class, 4, 5 -ok ($args[0],$class); +ok ($args[0] =~ /^Math::BigInt/); ok ($args[1],4); ok ($args[2],5); @args = Math::BigInt::objectify(0,4,5); ok (scalar @args,3); # $class, 4, 5 -ok ($args[0],$class); +ok ($args[0] =~ /^Math::BigInt/); ok ($args[1],4); ok ($args[2],5); @args = Math::BigInt::objectify(2,4,5); ok (scalar @args,3); # $class, 4, 5 -ok ($args[0],$class); +ok ($args[0] =~ /^Math::BigInt/); ok ($args[1],4); ok ($args[2],5); @args = Math::BigInt::objectify(2,4,5,6,7); ok (scalar @args,5); # $class, 4, 5, 6, 7 -ok ($args[0],$class); +ok ($args[0] =~ /^Math::BigInt/); ok ($args[1],4); ok (ref($args[1]),$args[0]); ok ($args[2],5); ok (ref($args[2]),$args[0]); ok ($args[3],6); ok (ref($args[3]),''); @@ -446,6 +446,11 @@ if ($x > $BASE) { ok (1,1) } else { ok ("$x > $BASE","$x < $BASE"); } $x = $class->new($MAX); ok ($x->length(), length($MAX)); ############################################################################### +# test bug that $class->digit($string) did not work + +ok ($class->digit(123,2),1); + +############################################################################### # bug in sub where number with at least 6 trailing zeros after any op failed $x = $class->new(123456); $z = $class->new(10000); $z *= 10; $x -= $z; @@ -490,6 +495,19 @@ $x = $class->new('-322056000'); ($x,$y) = $x->bdiv('-12882240'); ok ($y,'0'); is_valid($y); # $y not '-0' ############################################################################### +# bone/binf etc as plain calls (Lite failed them) + +ok ($class->bzero(),0); +ok ($class->bone(),1); +ok ($class->bone('+'),1); +ok ($class->bone('-'),-1); +ok ($class->bnan(),'NaN'); +ok ($class->binf(),'inf'); +ok ($class->binf('+'),'inf'); +ok ($class->binf('-'),'-inf'); +ok ($class->binf('-inf'),'-inf'); + +############################################################################### # all tests done 1; @@ -515,15 +533,20 @@ sub is_valid my ($x,$f) = @_; my $e = 0; # error? - # ok as reference? - $e = 'Not a reference to Math::BigInt' if !ref($x); - # has ok sign? - $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'" - if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; + # allow the check to pass for all Lite, and all MBI and subclasses + # ok as reference? + $e = 'Not a reference to Math::BigInt' if ref($x) !~ /^Math::BigInt/; - $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; - $e = $CALC->_check($x->{value}) if $e eq '0'; + if (ref($x) ne 'Math::BigInt::Lite') + { + # has ok sign? + $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'" + if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; + + $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; + $e = $CALC->_check($x->{value}) if $e eq '0'; + } # test done, see if error did crop up ok (1,1), return if ($e eq '0'); @@ -1029,6 +1052,26 @@ baddNaN:+inf:NaN -123456789:987654321:864197532 -123456789:-987654321:-1111111110 +123456789:-987654321:-864197532 +-1:10001:10000 +-1:100001:100000 +-1:1000001:1000000 +-1:10000001:10000000 +-1:100000001:100000000 +-1:1000000001:1000000000 +-1:10000000001:10000000000 +-1:100000000001:100000000000 +-1:1000000000001:1000000000000 +-1:10000000000001:10000000000000 +-1:-10001:-10002 +-1:-100001:-100002 +-1:-1000001:-1000002 +-1:-10000001:-10000002 +-1:-100000001:-100000002 +-1:-1000000001:-1000000002 +-1:-10000000001:-10000000002 +-1:-100000000001:-100000000002 +-1:-1000000000001:-1000000000002 +-1:-10000000000001:-10000000000002 &bsub abc:abc:NaN abc:+0:NaN @@ -1071,6 +1114,26 @@ abc:+0:NaN -123456789:+987654321:-1111111110 -123456789:-987654321:864197532 +123456789:-987654321:1111111110 +10001:1:10000 +100001:1:100000 +1000001:1:1000000 +10000001:1:10000000 +100000001:1:100000000 +1000000001:1:1000000000 +10000000001:1:10000000000 +100000000001:1:100000000000 +1000000000001:1:1000000000000 +10000000000001:1:10000000000000 +10001:-1:10002 +100001:-1:100002 +1000001:-1:1000002 +10000001:-1:10000002 +100000001:-1:100000002 +1000000001:-1:1000000002 +10000000001:-1:10000000002 +100000000001:-1:100000000002 +1000000000001:-1:1000000000002 +10000000000001:-1:10000000000002 &bmul abc:abc:NaN abc:+0:NaN diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index eca2d29701..c14d4415ef 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -10,7 +10,7 @@ BEGIN my $location = $0; $location =~ s/bigintpm.t//; unshift @INC, $location; # to locate the testing files chdir 't' if -d 't'; - plan tests => 2147; + plan tests => 2237; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t index fc3e52f594..db0c27ef80 100644 --- a/lib/Math/BigInt/t/config.t +++ b/lib/Math/BigInt/t/config.t @@ -22,7 +22,7 @@ my $cfg = Math::BigInt->config(); ok (ref($cfg),'HASH'); ok ($cfg->{lib},'Math::BigInt::Calc'); -ok ($cfg->{lib_version},'0.25'); +ok ($cfg->{lib_version},'0.26'); ok ($cfg->{class},'Math::BigInt'); ok ($cfg->{upgrade}||'',''); ok ($cfg->{div_scale},40); diff --git a/lib/Math/BigInt/t/constant.t b/lib/Math/BigInt/t/constant.t index ef3e223c1b..3c9b13fd46 100644 --- a/lib/Math/BigInt/t/constant.t +++ b/lib/Math/BigInt/t/constant.t @@ -8,13 +8,24 @@ BEGIN $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 5; + plan tests => 7; } use Math::BigInt ':constant'; ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968'); +{ + no warnings 'portable'; + # hexadecimal constants + ok (0x123456789012345678901234567890, + Math::BigInt->new('0x123456789012345678901234567890')); + # binary constants + ok (0b01010100011001010110110001110011010010010110000101101101, + Math::BigInt->new( + '0b01010100011001010110110001110011010010010110000101101101')); +} + use Math::BigFloat ':constant'; ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333'); diff --git a/lib/Math/BigInt/t/mbi_rand.t b/lib/Math/BigInt/t/mbi_rand.t new file mode 100644 index 0000000000..1f19c6b82b --- /dev/null +++ b/lib/Math/BigInt/t/mbi_rand.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +my $count; + +BEGIN + { + $| = 1; + unshift @INC, '../lib'; # for running manually + my $location = $0; $location =~ s/mbi_rand.t//; + unshift @INC, $location; # to locate the testing files + chdir 't' if -d 't'; + $count = 500; + plan tests => $count*2; + } + +use Math::BigInt; +my $c = 'Math::BigInt'; + +my $length = 200; + +# If you get a failure here, please re-run the test with the printed seed +# value as input: perl t/mbi_rand.t seed + +my $seed = int(rand(65537)); print "# seed: $seed\n"; srand($seed); + +my ($A,$B,$ADB,$AMB,$la,$lb); +for (my $i = 0; $i < $count; $i++) + { + # length of A and B + $la = int(rand($length)+1); $lb = int(rand($length)+1); + $A = ''; $B = ''; + # we create the numbers from "patterns", e.g. get a random number and a + # random count and string them together. This means things like + # "100000999999999999911122222222" are much more likely. If we just strung + # together digits, we would end up with "1272398823211223" etc. + while (length($A) < $la) { $A .= int(rand(100)) x int(rand(16)); } + while (length($B) < $lb) { $B .= int(rand(100)) x int(rand(16)); } + $A = $c->new($A); $B = $c->new($B); + print "# A $A\n# B $B\n"; + if ($A->is_zero() || $B->is_zero()) + { + ok (1,1); ok (1,1); next; + } + # check that int(A/B)*B + A % B == A holds for all inputs + # $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B); + ($ADB,$AMB) = $A->copy()->bdiv($B); + ok ($A,$ADB*$B+2*$AMB-$AMB); + # swap 'em and try this, too + # $X = ($B/$A)*$A + $B % $A; + ($ADB,$AMB) = $B->copy()->bdiv($A); + ok ($B,$ADB*$A+2*$AMB-$AMB); + } + diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 3df9ce47f5..69a1ab9158 100755 --- a/lib/Math/BigInt/t/sub_mbf.t +++ b/lib/Math/BigInt/t/sub_mbf.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1592 + plan tests => 1601 + 6; # + our own tests } diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index c492592099..95a0dae1dc 100755 --- a/lib/Math/BigInt/t/sub_mbi.t +++ b/lib/Math/BigInt/t/sub_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2147 + plan tests => 2237 + 5; # +4 own tests } diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc index 26b3a65e09..bf35261b80 100644 --- a/lib/Math/BigInt/t/upgrade.inc +++ b/lib/Math/BigInt/t/upgrade.inc @@ -725,9 +725,9 @@ baddNaN:+inf:NaN -123456789:987654321:864197532 -123456789:-987654321:-1111111110 +123456789:-987654321:-864197532 -#2:2.5:4.5^ -#-123:-1.5:-124.5^ -#-1.2:1:-0.2^ +2:2.5:4.5^ +-123:-1.5:-124.5^ +-1.2:1:-0.2^ &bsub abc:abc:NaN abc:+0:NaN diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t index 534c99bf12..5c8cf5fa66 100644 --- a/lib/Math/BigInt/t/upgrade.t +++ b/lib/Math/BigInt/t/upgrade.t @@ -10,7 +10,7 @@ BEGIN my $location = $0; $location =~ s/upgrade.t//; unshift @INC, $location; # to locate the testing files chdir 't' if -d 't'; - plan tests => 2056 + plan tests => 2068 + 2; # our own tests } diff --git a/lib/Math/BigInt/t/use_lib1.t b/lib/Math/BigInt/t/use_lib1.t new file mode 100644 index 0000000000..d737081a57 --- /dev/null +++ b/lib/Math/BigInt/t/use_lib1.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +# see if using Math::BigInt and Math::BigFloat works together nicely. +# all use_lib*.t should be equivalent + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + unshift @INC, 'lib'; + print "# INC = @INC\n"; + plan tests => 2; + } + +use Math::BigFloat lib => 'BareCalc'; + +ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc'); + +ok (Math::BigFloat->new(123)->badd(123),246); + diff --git a/lib/Math/BigInt/t/use_lib2.t b/lib/Math/BigInt/t/use_lib2.t new file mode 100644 index 0000000000..6dd744f298 --- /dev/null +++ b/lib/Math/BigInt/t/use_lib2.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +# see if using Math::BigInt and Math::BigFloat works together nicely. +# all use_lib*.t should be equivalent + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + unshift @INC, 'lib'; + plan tests => 2; + } + +use Math::BigInt; +use Math::BigFloat lib => 'BareCalc'; + +ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc'); + +ok (Math::BigFloat->new(123)->badd(123),246); + diff --git a/lib/Math/BigInt/t/use_lib3.t b/lib/Math/BigInt/t/use_lib3.t new file mode 100644 index 0000000000..3b43544660 --- /dev/null +++ b/lib/Math/BigInt/t/use_lib3.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +# see if using Math::BigInt and Math::BigFloat works together nicely. +# all use_lib*.t should be equivalent + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + unshift @INC, 'lib'; + plan tests => 2; + } + +use Math::BigInt lib => 'BareCalc'; +use Math::BigFloat; + +ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc'); + +ok (Math::BigFloat->new(123)->badd(123),246); + diff --git a/lib/Math/BigInt/t/use_lib4.t b/lib/Math/BigInt/t/use_lib4.t new file mode 100644 index 0000000000..079ba6d05f --- /dev/null +++ b/lib/Math/BigInt/t/use_lib4.t @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +# see if using Math::BigInt and Math::BigFloat works together nicely. +# all use_lib*.t should be equivalent, except this, since the later overrides +# the former lib statement + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + unshift @INC, 'lib'; + plan tests => 2; + } + +use Math::BigInt lib => 'BareCalc'; +use Math::BigFloat lib => 'Calc'; + +ok (Math::BigInt->config()->{lib},'Math::BigInt::Calc'); + +ok (Math::BigFloat->new(123)->badd(123),246); + diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm new file mode 100644 index 0000000000..b23408afb2 --- /dev/null +++ b/lib/Math/BigRat.pm @@ -0,0 +1,806 @@ +#!/usr/bin/perl -w + +# The following hash values are used: +# sign : +,-,NaN,+inf,-inf +# _d : denominator +# _n : numeraotr (value = _n/_d) +# _a : accuracy +# _p : precision +# _f : flags, used by MBR to flag parts of a rationale as untouchable + +package Math::BigRat; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigFloat); +@EXPORT_OK = qw(); + +$VERSION = '0.04'; + +use overload; # inherit from Math::BigFloat + +############################################################################## +# global constants, flags and accessory + +use constant MB_NEVER_ROUND => 0x0001; + +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; +$upgrade = undef; +$downgrade = undef; + +my $nan = 'NaN'; +my $class = 'Math::BigRat'; + +sub _new_from_float + { + # turn a single float input into a rationale (like '0.1') + my ($self,$f) = @_; + + return $self->bnan() if $f->is_nan(); + return $self->binf('-inf') if $f->{sign} eq '-inf'; + return $self->binf('+inf') if $f->{sign} eq '+inf'; + + #print "f $f caller", join(' ',caller()),"\n"; + $self->{_n} = $f->{_m}->copy(); # mantissa + $self->{_d} = Math::BigInt->bone(); + $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+'; + if ($f->{_e}->{sign} eq '-') + { + # something like Math::BigRat->new('0.1'); + $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10 + } + else + { + # something like Math::BigRat->new('10'); + # 1 / 1 => 10/1 + $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero(); + } +# print "float new $self->{_n} / $self->{_d}\n"; + $self; + } + +sub new + { + # create a Math::BigRat + my $class = shift; + + my ($n,$d) = shift; + + my $self = { }; bless $self,$class; + +# print "ref ",ref($d),"\n"; +# if (ref($d)) +# { +# print "isa float ",$d->isa('Math::BigFloat'),"\n"; +# print "isa int ",$d->isa('Math::BigInt'),"\n"; +# print "isa rat ",$d->isa('Math::BigRat'),"\n"; +# } + + # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet + + if ((ref $n) && (!$n->isa('Math::BigRat'))) + { +# print "is ref, but not rat\n"; + if ($n->isa('Math::BigFloat')) + { +# print "is ref, and float\n"; + return $self->_new_from_float($n)->bnorm(); + } + if ($n->isa('Math::BigInt')) + { +# print "is ref, and int\n"; + $self->{_n} = $n->copy(); # "mantissa" = $d + $self->{_d} = Math::BigInt->bone(); + $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+'; + return $self->bnorm(); + } + } + return $n->copy() if ref $n; + +# print "is string\n"; + + if (!defined $n) + { + $self->{_n} = Math::BigInt->bzero(); # undef => 0 + $self->{_d} = Math::BigInt->bone(); + $self->{sign} = '+'; + return $self->bnorm(); + } + # string input with / delimiter + if ($n =~ /\s*\/\s*/) + { + return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid + return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid + ($n,$d) = split (/\//,$n); + # try as BigFloats first + if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/)) + { + # one of them looks like a float + $self->_new_from_float(Math::BigFloat->new($n)); + # now correct $self->{_n} due to $n + my $f = Math::BigFloat->new($d); + if ($f->{_e}->{sign} eq '-') + { + # 10 / 0.1 => 100/1 + $self->{_n}->blsft($f->{_e}->copy()->babs(),10); + } + else + { + $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1 + } + } + else + { + $self->{_n} = Math::BigInt->new($n); + $self->{_d} = Math::BigInt->new($d); + return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan(); + # inf handling is missing here + + $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+'; + # if $d is negative, flip sign + $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-'; + $self->{_d}->{sign} = '+'; # normalize + } + return $self->bnorm(); + } + + # simple string input + if (($n =~ /[\.eE]/)) + { + # looks like a float +# print "float-like string $d\n"; + $self->_new_from_float(Math::BigFloat->new($n)); + } + else + { + $self->{_n} = Math::BigInt->new($n); + $self->{_d} = Math::BigInt->bone(); + $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+'; + } + $self->bnorm(); + } + +sub bstr + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + +# print "bstr $x->{sign} $x->{_n} $x->{_d}\n"; + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n}->bstr() if $x->{_d}->is_one(); + return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr(); + } + +sub bsstr + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + return $x->{_n}->bstr() . '/' . $x->{_d}->bstr(); + } + +sub bnorm + { + # reduce the number to the shortest form and remember this (so that we + # don't reduce again) + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + # this is to prevent automatically rounding when MBI's globals are set + $x->{_d}->{_f} = MB_NEVER_ROUND; + $x->{_n}->{_f} = MB_NEVER_ROUND; + # 'forget' that parts were rounded via MBI::bround() in MBF's bfround() + $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef; + $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef; + + # normalize zeros to 0/1 + if (($x->{sign} =~ /^[+-]$/) && + ($x->{_n}->is_zero())) + { + $x->{sign} = '+'; # never -0 + $x->{_d} = Math::BigInt->bone() unless $x->{_d}->is_one(); + return $x; + } + +# print "$x->{_n} / $x->{_d} => "; + # reduce other numbers + my $gcd = $x->{_n}->bgcd($x->{_d}); + + if (!$gcd->is_one()) + { + $x->{_n}->bdiv($gcd); + $x->{_d}->bdiv($gcd); + } +# print "$x->{_n} / $x->{_d}\n"; + $x; + } + +############################################################################## +# special values + +sub _bnan + { + # used by parent class bone() to initialize number to 1 + my $self = shift; + $self->{_n} = Math::BigInt->bzero(); + $self->{_d} = Math::BigInt->bzero(); + } + +sub _binf + { + # used by parent class bone() to initialize number to 1 + my $self = shift; + $self->{_n} = Math::BigInt->bzero(); + $self->{_d} = Math::BigInt->bzero(); + } + +sub _bone + { + # used by parent class bone() to initialize number to 1 + my $self = shift; + $self->{_n} = Math::BigInt->bone(); + $self->{_d} = Math::BigInt->bone(); + } + +sub _bzero + { + # used by parent class bone() to initialize number to 1 + my $self = shift; + $self->{_n} = Math::BigInt->bzero(); + $self->{_d} = Math::BigInt->bone(); + } + +############################################################################## +# mul/add/div etc + +sub badd + { + # add two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 + # - + - = --------- = -- + # 4 3 4*3 12 + + my $gcd = $x->{_d}->bgcd($y->{_d}); + + my $aa = $x->{_d}->copy(); + my $bb = $y->{_d}->copy(); + if ($gcd->is_one()) + { + $bb->bdiv($gcd); $aa->bdiv($gcd); + } + $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign}; + my $m = $y->{_n}->copy()->bmul($aa); + $m->{sign} = $y->{sign}; # 2/1 - 2/1 + $x->{_n}->badd($m); + + $x->{_d}->bmul($y->{_d}); + + # calculate new sign + $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bsub + { + # subtract two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + # TODO: inf handling + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 + # - + - = --------- = -- + # 4 3 4*3 12 + + my $gcd = $x->{_d}->bgcd($y->{_d}); + + my $aa = $x->{_d}->copy(); + my $bb = $y->{_d}->copy(); + if ($gcd->is_one()) + { + $bb->bdiv($gcd); $aa->bdiv($gcd); + } + $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign}; + my $m = $y->{_n}->copy()->bmul($aa); + $m->{sign} = $y->{sign}; # 2/1 - 2/1 + $x->{_n}->bsub($m); + + $x->{_d}->bmul($y->{_d}); + + # calculate new sign + $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bmul + { + # multiply two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + return $x->bnan() if $x->is_zero() || $y->is_zero(); + # result will always be +-inf: + # +inf * +/+inf => +inf, -inf * -/-inf => +inf + # +inf * -/-inf => -inf, -inf * +/+inf => -inf + return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-'); + } + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # According to Knuth, this can be optimized by doingtwice gcd (for d and n) + # and reducing in one step) + + # 1 1 2 1 + # - * - = - = - + # 4 3 12 6 + $x->{_n}->bmul($y->{_n}); + $x->{_d}->bmul($y->{_d}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bdiv + { + # (dividend: BRAT or num_str, divisor: BRAT or num_str) return + # (BRAT,BRAT) (quo,rem) or BRAT (only rem) + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # TODO: list context, upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 1 3 + # - / - == - * - + # 4 3 4 1 + $x->{_n}->bmul($y->{_d}); + $x->{_d}->bmul($y->{_n}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round($a,$p,$r); + } + +############################################################################## +# is_foo methods (the rest is inherited) + +sub is_int + { + # return true if arg (BRAT or num_str) is an integer + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't + $x->{_d}->is_one(); # 1e-1 => no integer + 0; + } + +sub is_zero + { + # return true if arg (BRAT or num_str) is zero + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero(); + 0; + } + +sub is_one + { + # return true if arg (BRAT or num_str) is +1 or -1 if signis given + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $sign = shift || ''; $sign = '+' if $sign ne '-'; + return 1 + if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one()); + 0; + } + +sub is_odd + { + # return true if arg (BFLOAT or num_str) is odd or false if even + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't + ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1 + 0; + } + +sub is_even + { + # return true if arg (BINT or num_str) is even or false if odd + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't + return 1 if ($x->{_d}->is_one() # x/3 is never + && $x->{_n}->is_even()); # but 4/1 is + 0; + } + +BEGIN + { + *objectify = \&Math::BigInt::objectify; + } + +############################################################################## +# parts() and friends + +sub numerator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign}; + $n; + } + +sub denominator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + $x->{_d}->copy(); + } + +sub parts + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $n = $x->{_n}->copy(); + $n->{sign} = $x->{sign}; + return ($x->{_n}->copy(),$x->{_d}->copy()); + } + +sub length + { + return 0; + } + +sub digit + { + return 0; + } + +############################################################################## +# special calc routines + +sub bceil + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x unless $x->{sign} =~ /^[+-]$/; + return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0 + + $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 + $x->{_d}->bone(); + $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1 + $x; + } + +sub bfloor + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x unless $x->{sign} =~ /^[+-]$/; + return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0 + + $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 + $x->{_d}->bone(); + $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1 + $x; + } + +sub bfac + { + return Math::BigRat->bnan(); + } + +sub bpow + { + my ($self,$x,$y,@r) = objectify(2,@_); + + return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x + return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; + return $x->bone(@r) if $y->is_zero(); + return $x->round(@r) if $x->is_one() || $y->is_one(); + if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one()) + { + # if $x == -1 and odd/even y => +1/-1 + return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); + # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; + } + # 1 ** -y => 1 / (1 ** |y|) + # so do test for negative $y after above's clause + # return $x->bnan() if $y->{sign} eq '-'; + return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) + + my $pow2 = $self->__one(); + my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs(); + my $two = Math::BigInt->new(2); + while (!$y1->is_one()) + { + print "at $y1 (= $x)\n"; + $pow2->bmul($x) if $y1->is_odd(); + $y1->bdiv($two); + $x->bmul($x); + } + $x->bmul($pow2) unless $pow2->is_one(); + # n ** -x => 1/n ** x + ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-'; + $x; + #$x->round(@r); + } + +sub blog + { + return Math::BigRat->bnan(); + } + +sub bsqrt + { + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc + $x->{_d}->bsqrt($a,$p,$r); + $x->{_n}->bsqrt($a,$p,$r); + $x->bnorm(); + } + +sub blsft + { + my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_); + + $x->bmul( $b->copy()->bpow($y), $a,$p,$r); + $x; + } + +sub brsft + { + my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_); + + $x->bdiv( $b->copy()->bpow($y), $a,$p,$r); + $x; + } + +############################################################################## +# round + +sub round + { + $_[0]; + } + +sub bround + { + $_[0]; + } + +sub bfround + { + $_[0]; + } + +############################################################################## +# comparing + +sub bcmp + { + my ($self,$x,$y) = objectify(2,@_); + + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # handle +-inf and NaN + return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return +1 if $x->{sign} eq '+inf'; + return -1 if $x->{sign} eq '-inf'; + return -1 if $y->{sign} eq '+inf'; + return +1; + } + # check sign for speed first + return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y + return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 + + # shortcut + my $xz = $x->{_n}->is_zero(); + my $yz = $y->{_n}->is_zero(); + return 0 if $xz && $yz; # 0 <=> 0 + return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y + return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 + + my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign}; + my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign}; + $t->bcmp($u); + } + +sub bacmp + { + my ($self,$x,$y) = objectify(2,@_); + + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # handle +-inf and NaN + return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; + return +1; # inf is always bigger + } + + my $t = $x->{_n} * $y->{_d}; + my $u = $y->{_n} * $x->{_d}; + $t->bacmp($u); + } + +############################################################################## +# output conversation + +sub as_number + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc + my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3 + $t->{sign} = $x->{sign}; + $t; + } + +#sub import +# { +# my $self = shift; +# Math::BigInt->import(@_); +# $self->SUPER::import(@_); # need it for subclasses +# #$self->export_to_level(1,$self,@_); # need this ? +# } + +1; + +__END__ + +=head1 NAME + +Math::BigRat - arbitrarily big rationales + +=head1 SYNOPSIS + + use Math::BigRat; + + $x = Math::BigRat->new('3/7'); + + print $x->bstr(),"\n"; + +=head1 DESCRIPTION + +This is just a placeholder until the real thing is up and running. Watch this +space... + +=head2 MATH LIBRARY + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use Math::BigRat lib => 'Calc'; + +You can change this by using: + + use Math::BigRat lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; + +Calc.pm uses as internal format an array of elements of some decimal base +(usually 1e7, but this might be differen for some systems) with the least +significant digit first, while BitVect.pm uses a bit vector of base 2, most +significant bit first. Other modules might use even different means of +representing the numbers. See the respective module documentation for further +details. + +=head1 METHODS + +=head2 new + + $x = Math::BigRat->new('1/3'); + +Create a new Math::BigRat object. Input can come in various forms: + + $x = Math::BigRat->new('1/3'); # simple string + $x = Math::BigRat->new('1 / 3'); # spaced + $x = Math::BigRat->new('1 / 0.1'); # w/ floats + $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt + $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat + +=head2 numerator + + $n = $x->numerator(); + +Returns a copy of the numerator (the part above the line) as signed BigInt. + +=head2 denominator + + $d = $x->denominator(); + +Returns a copy of the denominator (the part under the line) as positive BigInt. + +=head2 parts + + ($n,$d) = $x->parts(); + +Return a list consisting of (signed) numerator and (unsigned) denominator as +BigInts. + +=head1 BUGS + +None know yet. Please see also L<Math::BigInt>. + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>, +L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. + +The package at +L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigRat> may +contain more documentation and examples as well as testcases. + +=head1 AUTHORS + +(C) by Tels L<http://bloodgate.com/> 2001-2002. + +=cut diff --git a/lib/Math/BigRat/t/bigfltpm.inc b/lib/Math/BigRat/t/bigfltpm.inc new file mode 100644 index 0000000000..5b3f4f16cf --- /dev/null +++ b/lib/Math/BigRat/t/bigfltpm.inc @@ -0,0 +1,1244 @@ +#include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + +while (<DATA>) + { + chop; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "fnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "exponent") { + # ->bstr() to see if an object is returned + $try .= '$x->exponent()->bstr();'; + } elsif ($f eq "mantissa") { + # ->bstr() to see if an object is returned + $try .= '$x->mantissa()->bstr();'; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "length") { + $try .= "\$x->length();"; + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "as_number") { + $try .= '$x->as_number();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->bround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->bfround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->bsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->blog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->bfac();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "fcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "facmp") { + $try .= '$x->bacmp($y);'; + } elsif ($f eq "fpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "fadd") { + $try .= '$x + $y;'; + } elsif ($f eq "fsub") { + $try .= '$x - $y;'; + } elsif ($f eq "fmul") { + $try .= '$x * $y;'; + } elsif ($f eq "fdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->bdiv(\$y));"; + } elsif ($f eq "frsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "flsft") { + $try .= '$x << $y;'; + } elsif ($f eq "fmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); +# if (ref($ans1) eq "$class") +# { +# # float numbers are normalized (for now), so mantissa shouldn't have +# # trailing zeros +# #print $ans1->_trailing_zeros(),"\n"; +# print "# Has trailing zeros after '$try'\n" +# if !ok ($ans1->{_m}->_trailing_zeros(), 0); +# } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +ok ($y,1200); ok ($x,1200); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +############################################################################### +# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() +# correctly modifies $x + +$class->accuracy(undef); $class->precision(undef); # reset + +$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); + +$class->precision(undef); +$x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); + +$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); + +# A and P set => NaN +${${class}.'::accuracy'} = 4; $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN'); +# supplied arg overrides set global +$class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); + +$class->accuracy(undef); $class->precision(undef); # reset for further tests + +1; # all done + +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +__DATA__ +$div_scale = 40; +&flog +0:NaN +-1:NaN +-2:NaN +1:0 +# this is too slow for the testsuite +#2.718281828:0.9999999998311266953289851340574956564911 +#$div_scale = 20; +#2.718281828:0.99999999983112669533 +1:0 +# too slow, too (or hangs?) +#123:4.8112184355 +# $div_scale = 14; +#10:0:2.302585092994 +#1000:0:6.90775527898214 +#100:0:4.60517018598809 +#2:0:0.693147180559945 +#3.1415:0:1.14470039286086 +#12345:0:9.42100640177928 +#0.001:0:-6.90775527898214 +# reset for further tests +$div_scale = 40; +&frsft +NaNfrsft:2:NaN +0:2:0 +1:1:0.5 +2:1:1 +4:1:2 +123:1:61.5 +32:3:4 +&flsft +NaNflsft:0:NaN +2:1:4 +4:3:32 +5:3:40 +1:2:4 +0:5:0 +&fnorm +1:1 +-0:0 +fnormNaN:NaN ++inf:inf +-inf:-inf +123:123 +-123.4567:-123.4567 +# invalid inputs +1__2:NaN +1E1__2:NaN +11__2E2:NaN +#1.E3:NaN +.2E-3.:NaN +#1e3e4:NaN +.2E2:20 +&as_number +0:0 +1:1 +1.2:1 +2.345:2 +-2:-2 +-123.456:-123 +-200:-200 +&finf +1:+:inf +2:-:-inf +3:abc:inf +&numify +0:0e+1 ++1:1e+0 +1234:1234e+0 +NaN:NaN ++inf:inf +-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1234.567:1234567e-3 +&fstr ++inf:::inf +-inf:::-inf +abcfstr:::NaN +1234.567:9::1234.56700 +1234.567::-6:1234.567000 +12345:5::12345 +0.001234:6::0.00123400 +0.001234::-8:0.00123400 +0:4::0 +0::-4:0.0000 +&fnorm +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:123.456 +0.01:0.01 +.002:0.002 ++.2:0.2 +-0.0003:-0.0003 +-.0000000004:-0.0000000004 +123456E2:12345600 +123456E-2:1234.56 +-123456E2:-12345600 +-123456E-2:-1234.56 +1e1:10 +2e-11:0.00000000002 +# excercise _split + .02e-1:0.002 + 000001:1 + -00001:-1 + -1:-1 + 000.01:0.01 + -000.0023:-0.0023 + 1.1e1:11 +-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 +&fpow +2:2:4 +1:2:1 +1:3:1 +-1:2:1 +-1:3:-1 +123.456:2:15241.383936 +2:-2:0.25 +2:-3:0.125 +128:-2:0.00006103515625 +abc:123.456:NaN +123.456:abc:NaN ++inf:123.45:inf +-inf:123.45:-inf ++inf:-123.45:inf +-inf:-123.45:-inf +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123.456789 +-123456.789:123456.789 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123.456789 +-123456.789:123456.789 +&fround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNfround:5:NaN ++10123456789:5:10123000000 +-10123456789:5:-10123000000 ++10123456789.123:5:10123000000 +-10123456789.123:5:-10123000000 ++10123456789:9:10123456700 +-10123456789:9:-10123456700 ++101234500:6:101234000 +-101234500:6:-101234000 +$round_mode = "zero" ++20123456789:5:20123000000 +-20123456789:5:-20123000000 ++20123456789.123:5:20123000000 +-20123456789.123:5:-20123000000 ++20123456789:9:20123456800 +-20123456789:9:-20123456800 ++201234500:6:201234000 +-201234500:6:-201234000 +$round_mode = "+inf" ++30123456789:5:30123000000 +-30123456789:5:-30123000000 ++30123456789.123:5:30123000000 +-30123456789.123:5:-30123000000 ++30123456789:9:30123456800 +-30123456789:9:-30123456800 ++301234500:6:301235000 +-301234500:6:-301234000 +$round_mode = "-inf" ++40123456789:5:40123000000 +-40123456789:5:-40123000000 ++40123456789.123:5:40123000000 +-40123456789.123:5:-40123000000 ++40123456789:9:40123456800 +-40123456789:9:-40123456800 ++401234500:6:401234000 +-401234500:6:-401235000 +$round_mode = "odd" ++50123456789:5:50123000000 +-50123456789:5:-50123000000 ++50123456789.123:5:50123000000 +-50123456789.123:5:-50123000000 ++50123456789:9:50123456800 +-50123456789:9:-50123456800 ++501234500:6:501235000 +-501234500:6:-501235000 +$round_mode = "even" ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601234000 +-601234500:6:-601234000 ++60123456789.0123:5:60123000000 +-60123456789.0123:5:-60123000000 +&ffround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNffround:5:NaN ++1.23:-1:1.2 ++1.234:-1:1.2 ++1.2345:-1:1.2 ++1.23:-2:1.23 ++1.234:-2:1.23 ++1.2345:-2:1.23 ++1.23:-3:1.230 ++1.234:-3:1.234 ++1.2345:-3:1.234 +-1.23:-1:-1.2 ++1.27:-1:1.2 +-1.27:-1:-1.2 ++1.25:-1:1.2 +-1.25:-1:-1.2 ++1.35:-1:1.3 +-1.35:-1:-1.3 +-0.0061234567890:-1:0.0 +-0.0061:-1:0.0 +-0.00612:-1:0.0 +-0.00612:-2:0.00 +-0.006:-1:0.0 +-0.006:-2:0.00 +-0.0006:-2:0.00 +-0.0006:-3:0.000 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:0 +0.41:0:0 +$round_mode = "zero" ++2.23:-1:/2.2(?:0{5}\d+)? +-2.23:-1:/-2.2(?:0{5}\d+)? ++2.27:-1:/2.(?:3|29{5}\d+) +-2.27:-1:/-2.(?:3|29{5}\d+) ++2.25:-1:/2.2(?:0{5}\d+)? +-2.25:-1:/-2.2(?:0{5}\d+)? ++2.35:-1:/2.(?:3|29{5}\d+) +-2.35:-1:/-2.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "+inf" ++3.23:-1:/3.2(?:0{5}\d+)? +-3.23:-1:/-3.2(?:0{5}\d+)? ++3.27:-1:/3.(?:3|29{5}\d+) +-3.27:-1:/-3.(?:3|29{5}\d+) ++3.25:-1:/3.(?:3|29{5}\d+) +-3.25:-1:/-3.2(?:0{5}\d+)? ++3.35:-1:/3.(?:4|39{5}\d+) +-3.35:-1:/-3.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "-inf" ++4.23:-1:/4.2(?:0{5}\d+)? +-4.23:-1:/-4.2(?:0{5}\d+)? ++4.27:-1:/4.(?:3|29{5}\d+) +-4.27:-1:/-4.(?:3|29{5}\d+) ++4.25:-1:/4.2(?:0{5}\d+)? +-4.25:-1:/-4.(?:3|29{5}\d+) ++4.35:-1:/4.(?:3|29{5}\d+) +-4.35:-1:/-4.(?:4|39{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "odd" ++5.23:-1:/5.2(?:0{5}\d+)? +-5.23:-1:/-5.2(?:0{5}\d+)? ++5.27:-1:/5.(?:3|29{5}\d+) +-5.27:-1:/-5.(?:3|29{5}\d+) ++5.25:-1:/5.(?:3|29{5}\d+) +-5.25:-1:/-5.(?:3|29{5}\d+) ++5.35:-1:/5.(?:3|29{5}\d+) +-5.35:-1:/-5.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "even" ++6.23:-1:/6.2(?:0{5}\d+)? +-6.23:-1:/-6.2(?:0{5}\d+)? ++6.27:-1:/6.(?:3|29{5}\d+) +-6.27:-1:/-6.(?:3|29{5}\d+) ++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) +-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) ++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) +-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +0.01234567:-3:0.012 +0.01234567:-4:0.0123 +0.01234567:-5:0.01235 +0.01234567:-6:0.012346 +0.01234567:-7:0.0123457 +0.01234567:-8:0.01234567 +0.01234567:-9:0.012345670 +0.01234567:-12:0.012345670000 +&fcmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:-1 ++0:-1:1 ++1:+0:1 ++0:+1:-1 +-1:+1:-1 ++1:-1:1 +-1:-1:0 ++1:+1:0 +-1.1:0:-1 ++0:-1.1:1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:-1 +-12:-123:1 ++123:+124:-1 ++124:+123:1 +-123:-124:1 +-124:-123:-1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:1 +0:-0.1:1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:-1 +-0.1:0:-1 +0:0.0001234:-1 +0:-0.0001234:1 +0.0001234:0:1 +-0.0001234:0:-1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:-1 ++inf:5432112345:1 +-inf:-5432112345:-1 ++inf:-5432112345:1 +-inf:54321.12345:-1 ++inf:54321.12345:1 +-inf:-54321.12345:-1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&facmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:1 ++0:-1:-1 ++1:+0:1 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:-1:0 ++1:+1:0 +-1.1:0:1 ++0:-1.1:-1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:1 +-12:-123:-1 ++123:+124:-1 ++124:+123:1 +-123:-124:-1 +-124:-123:1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:-1 +0:-0.1:-1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:1 +-0.1:0:1 +0:0.0001234:-1 +0:-0.0001234:-1 +0.0001234:0:1 +-0.0001234:0:1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:1 ++inf:5432112345:1 +-inf:-5432112345:1 ++inf:-5432112345:1 +-inf:54321.12345:1 ++inf:54321.12345:1 +-inf:-54321.12345:1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 +5:inf:-1 +-1:inf:-1 +5:-inf:-1 +-1:-inf:-1 +# return undef ++inf:facmpNaN: +facmpNaN:inf: +-inf:facmpNaN: +facmpNaN:-inf: +&fdec +fdecNaN:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +1.23:0.23 +-1.23:-2.23 +100:99 +101:100 +-100:-101 +-99:-100 +-98:-99 +99:98 +&finc +fincNaN:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +1.23:2.23 +-1.23:-0.23 +100:101 +-100:-99 +-99:-98 +-101:-100 +99:100 +&fadd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:0 +-inf:+inf:0 ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +0.001234:0.0001234:0.0013574 +&fsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:0 +-inf:-inf:0 +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +&fmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +&fdiv-list +0:0:NaN,NaN +0:1:0,0 +9:4:2.25,1 +9:5:1.8,4 +&fdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:0.5 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:111111111.1111111111111111111111111111111 ++2000000000:+9:222222222.2222222222222222222222222222222 ++3000000000:+9:333333333.3333333333333333333333333333333 ++4000000000:+9:444444444.4444444444444444444444444444444 ++5000000000:+9:555555555.5555555555555555555555555555556 ++6000000000:+9:666666666.6666666666666666666666666666667 ++7000000000:+9:777777777.7777777777777777777777777777778 ++8000000000:+9:888888888.8888888888888888888888888888889 ++9000000000:+9:1000000000 ++35500000:+113:314159.2920353982300884955752212389380531 ++71000000:+226:314159.2920353982300884955752212389380531 ++106500000:+339:314159.2920353982300884955752212389380531 ++1000000000:+3:333333333.3333333333333333333333333333333 +2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 +123456:1:123456 +$div_scale = 20 ++1000000000:+9:111111111.11111111111 ++2000000000:+9:222222222.22222222222 ++3000000000:+9:333333333.33333333333 ++4000000000:+9:444444444.44444444444 ++5000000000:+9:555555555.55555555556 ++6000000000:+9:666666666.66666666667 ++7000000000:+9:777777777.77777777778 ++8000000000:+9:888888888.88888888889 ++9000000000:+9:1000000000 +1:10:0.1 +1:100:0.01 +1:1000:0.001 +1:10000:0.0001 +1:504:0.001984126984126984127 +2:1.987654321:1.0062111801179738436 +123456789.123456789123456789123456789:1:123456789.12345678912 +# the next two cases are the "old" behaviour, but are now (>v0.01) different +#+35500000:+113:314159.292035398230088 +#+71000000:+226:314159.292035398230088 ++35500000:+113:314159.29203539823009 ++71000000:+226:314159.29203539823009 ++106500000:+339:314159.29203539823009 ++1000000000:+3:333333333.33333333333 +$div_scale = 1 +# round to accuracy 1 after bdiv ++124:+3:40 +123456789.1234:1:100000000 +# reset scale for further tests +$div_scale = 40 +&fmod ++9:4:1 ++9:5:4 ++9000:56:40 ++56:9000:56 +# inf handling, see table in doc +0:inf:0 +0:-inf:0 +5:inf:5 +5:-inf:5 +-5:inf:-5 +-5:-inf:-5 +inf:5:0 +-inf:5:0 +inf:-5:0 +-inf:-5:0 +5:5:0 +-5:-5:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN +8:0:8 +inf:0:inf +# exceptions to reminder rule +-inf:0:-inf +-8:0:-8 +0:0:NaN +abc:abc:NaN +abc:1:abc:NaN +1:abc:NaN +0:0:NaN +0:1:0 +1:0:1 +0:-1:0 +-1:0:-1 +1:1:0 +-1:-1:0 +1:-1:0 +-1:1:0 +1:2:1 +2:1:0 +1000000000:9:1 +2000000000:9:2 +3000000000:9:3 +4000000000:9:4 +5000000000:9:5 +6000000000:9:6 +7000000000:9:7 +8000000000:9:8 +9000000000:9:0 +35500000:113:33 +71000000:226:66 +106500000:339:99 +1000000000:3:1 +10:5:0 +100:4:0 +1000:8:0 +10000:16:0 +999999999999:9:0 +999999999999:99:0 +999999999999:999:0 +999999999999:9999:0 +999999999999999:99999:0 +-9:+5:1 ++9:-5:-1 +-9:-5:-4 +-5:3:1 +-2:3:1 +4:3:1 +1:3:1 +-5:-3:-2 +-2:-3:-2 +4:-3:-2 +1:-3:-2 +4095:4095:0 +100041000510123:3:0 +152403346:12345:4321 +87654321:87654321:0 +# now some floating point tests +123:2.5:0.5 +1230:2.5:0 +123.4:2.5:0.9 +123e1:25:5 +&ffac +Nanfac:NaN +-1:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 +&fsqrt ++0:0 +-1:NaN +-2:NaN +-16:NaN +-123.45:NaN +nanfsqrt:NaN ++inf:inf +-inf:NaN +1:1 +2:1.41421356237309504880168872420969807857 +4:2 +9:3 +16:4 +100:10 +123.456:11.11107555549866648462149404118219234119 +15241.38393:123.4559999756998444766131352122991626468 +1.44:1.2 +# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 +1.44E10:120000 +2e10:141421.356237309504880168872420969807857 +144e20:120000000000 +# proved to be an endless loop under 7-9 +12:3.464101615137754587054892683011744733886 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_positive +0:1 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&parts +0:0 1 +1:1 0 +123:123 0 +-123:-123 0 +-1200:-12 2 +NaNparts:NaN NaN ++inf:inf inf +-inf:-inf inf +&exponent +0:1 +1:0 +123:0 +-123:0 +-1200:2 ++inf:inf +-inf:inf +NaNexponent:NaN +&mantissa +0:0 +1:1 +123:123 +-123:-123 +-1200:-12 ++inf:inf +-inf:-inf +NaNmantissa:NaN +&length +123:3 +-123:3 +0:1 +1:1 +12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/lib/Math/BigRat/t/bigfltrt.t b/lib/Math/BigRat/t/bigfltrt.t new file mode 100755 index 0000000000..2b049e2d41 --- /dev/null +++ b/lib/Math/BigRat/t/bigfltrt.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/bigfltrt.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../lib lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + +# plan tests => 1585; + plan tests => 1; + } + +#use Math::BigInt; +#use Math::BigRat; +use Math::BigRat::Test; # test via this + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat::Test"; +$CL = "Math::BigInt::Calc"; + +ok (1,1); + +# does not fully work yet +# require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t new file mode 100755 index 0000000000..380f2e794f --- /dev/null +++ b/lib/Math/BigRat/t/bigrat.t @@ -0,0 +1,79 @@ +#!/usr/bin/perl -w + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + plan tests => 36; + } + +# testing of Math::BigRat + +use Math::BigRat; + +my ($x,$y,$z); + +$x = Math::BigRat->new(1234); ok ($x,1234); +$x = Math::BigRat->new('1234/1'); ok ($x,1234); +$x = Math::BigRat->new('1234/2'); ok ($x,617); + +$x = Math::BigRat->new('100/1.0'); ok ($x,100); +$x = Math::BigRat->new('10.0/1.0'); ok ($x,10); +$x = Math::BigRat->new('0.1/10'); ok ($x,'1/100'); +$x = Math::BigRat->new('0.1/0.1'); ok ($x,'1'); +$x = Math::BigRat->new('1e2/10'); ok ($x,10); +$x = Math::BigRat->new('1e2/1e1'); ok ($x,10); +$x = Math::BigRat->new('1 / 3'); ok ($x,'1/3'); +$x = Math::BigRat->new('-1 / 3'); ok ($x,'-1/3'); +$x = Math::BigRat->new('NaN'); ok ($x,'NaN'); +$x = Math::BigRat->new('inf'); ok ($x,'inf'); +$x = Math::BigRat->new('-inf'); ok ($x,'-inf'); +$x = Math::BigRat->new('1/'); ok ($x,'NaN'); + +$x = Math::BigRat->new('1/4'); $y = Math::BigRat->new('1/3'); +ok ($x + $y, '7/12'); +ok ($x * $y, '1/12'); +ok ($x / $y, '3/4'); + +$x = Math::BigRat->new('7/5'); $x *= '3/2'; +ok ($x,'21/10'); +$x -= '0.1'; +ok ($x,'2'); # not 21/10 + +$x = Math::BigRat->new('2/3'); $y = Math::BigRat->new('3/2'); +ok ($x > $y,''); +ok ($x < $y,1); +ok ($x == $y,''); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('3/2'); +ok ($x > $y,''); +ok ($x < $y,'1'); +ok ($x == $y,''); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('-2/3'); +ok ($x > $y,''); +ok ($x < $y,''); +ok ($x == $y,'1'); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('-1/3'); +ok ($x > $y,''); +ok ($x < $y,'1'); +ok ($x == $y,''); + +$x = Math::BigRat->new('-124'); $y = Math::BigRat->new('-122'); +ok ($x->bacmp($y),1); + +$x = Math::BigRat->new('-124'); $y = Math::BigRat->new('-122'); +ok ($x->bcmp($y),-1); + +$x = Math::BigRat->new('-144/9'); $x->bsqrt(); ok ($x,'NaN'); +$x = Math::BigRat->new('144/9'); $x->bsqrt(); ok ($x,'4'); + +# done + +1; + diff --git a/lib/Math/BigRat/t/bigratpm.inc b/lib/Math/BigRat/t/bigratpm.inc new file mode 100644 index 0000000000..bbec697706 --- /dev/null +++ b/lib/Math/BigRat/t/bigratpm.inc @@ -0,0 +1,642 @@ +#include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + +while (<DATA>) + { + chop; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "bnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "numerator") { + # ->bstr() to see if an object is returned + $try .= '$x->numerator()->bstr();'; + } elsif ($f eq "denominator") { + # ->bstr() to see if an object is returned + $try .= '$x->denominator()->bstr();'; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "length") { + $try .= "\$x->length();"; + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "as_number") { + $try .= '$x->as_number();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->bround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->bfround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->bsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->blog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->bfac();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "fcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "facmp") { + $try .= '$x->bacmp($y);'; + } elsif ($f eq "bpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "badd") { + $try .= '$x + $y;'; + } elsif ($f eq "bsub") { + $try .= '$x - $y;'; + } elsif ($f eq "bmul") { + $try .= '$x * $y;'; + } elsif ($f eq "bdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->bdiv(\$y));"; + } elsif ($f eq "brsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "blsft") { + $try .= '$x << $y;'; + } elsif ($f eq "bmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); +# if (ref($ans1) eq "$class") +# { +# # float numbers are normalized (for now), so mantissa shouldn't have +# # trailing zeros +# #print $ans1->_trailing_zeros(),"\n"; +# print "# Has trailing zeros after '$try'\n" +# if !ok ($ans1->{_m}->_trailing_zeros(), 0); +# } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +ok ($y,1200); ok ($x,1200); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +1; # all done + +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +__DATA__ +&finf +1:+:inf +2:-:-inf +3:abc:inf +#&numify +#0:0e+1 +#+1:1e+0 +#1234:1234e+0 +#NaN:NaN +#+inf:inf +#-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1:1/1 +3/1:3/1 +0.1:1/10 +&bnorm +1:1 +-0:0 +bnormNaN:NaN ++inf:inf +-inf:-inf +123:123 +-123.4567:-1234567/10000 +# invalid inputs +1__2:NaN +1E1__2:NaN +11__2E2:NaN +#1.E3:NaN +.2E-3.:NaN +#1e3e4:NaN +.2E2:20 +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:15432/125 +0.01:1/100 +.002:1/500 ++.2:1/5 +-0.0003:-3/10000 +-.0000000004:-1/2500000000 +123456E2:12345600 +123456E-2:30864/25 +-123456E2:-12345600 +-123456E-2:-30864/25 +1e1:10 +2e-11:1/50000000000 +12/10:6/5 +0.1/0.1:1 +100/0.1:1000 +0.1/10:1/100 +1 / 3:1/3 +1/ 3:1/3 +1 /3:1/3 +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123456789/1000000 +-123456.789:123456789/1000 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123456789/1000000 +-123456.789:123456789/1000 +&badd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:NaN +-inf:+inf:NaN ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +1/3:1/3:2/3 +2/3:-1/3:1/3 +&bsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:NaN +-inf:-inf:NaN +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +2/3:1/3:1/3 +7/27:3/54:11/54 +-2/3:+2/3:-4/3 +-2/3:-2/3:0 +&bmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +1/4:1/3:1/12 +&bdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:1/2 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:1000000000/9 ++2000000000:+9:2000000000/9 ++3000000000:+9:1000000000/3 ++4000000000:+9:4000000000/9 ++5000000000:+9:5000000000/9 ++6000000000:+9:2000000000/3 ++7000000000:+9:7000000000/9 ++8000000000:+9:8000000000/9 ++9000000000:+9:1000000000 ++35500000:+113:35500000/113 ++71000000:+226:35500000/113 ++106500000:+339:35500000/113 ++1000000000:+3:1000000000/3 +2:25.024996000799840031993601279744051189762:1000000000000000000000000000000000000000/12512498000399920015996800639872025594881 +123456:1:123456 +1/4:1/3:3/4 +# reset scale for further tests +$div_scale = 40 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +1/3:0 +3/1:1 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_positive +0:1 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +#&parts +#0:0 1 +#1:1 0 +#123:123 0 +#-123:-123 0 +#-1200:-12 2 +#NaNparts:NaN NaN +#+inf:inf inf +#-inf:-inf inf +#&exponent +#0:1 +#1:0 +#123:0 +#-123:0 +#-1200:2 +#+inf:inf +#-inf:inf +#NaNexponent:NaN +#&mantissa +#0:0 +#1:1 +#123:123 +#-123:-123 +#-1200:-12 +#+inf:inf +#-inf:-inf +#NaNmantissa:NaN +#&length +#123:3 +#-123:3 +#0:1 +#1:1 +#12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +0/3:1 +1/3:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +1/3:0 +100/100:1 +0.1/0.1:1 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/lib/Math/BigRat/t/bigratpm.t b/lib/Math/BigRat/t/bigratpm.t new file mode 100755 index 0000000000..a4d8ed9070 --- /dev/null +++ b/lib/Math/BigRat/t/bigratpm.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/bigratpm.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + + plan tests => 414; + } + +#use Math::BigInt; +use Math::BigRat; + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat"; +$CL = "Math::BigInt::Calc"; + +require 'bigratpm.inc'; # all tests here for sharing diff --git a/lib/Pod/t/pod2html-lib.pl b/lib/Pod/t/pod2html-lib.pl index de26389d56..c3d96aeefb 100644 --- a/lib/Pod/t/pod2html-lib.pl +++ b/lib/Pod/t/pod2html-lib.pl @@ -25,6 +25,9 @@ sub convert_n_test { # expected my $expect = <DATA>; $expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/; + if (ord("A") == 193) { # EBCDIC. + $expect =~ s/item_mat%3c%21%3e/item_mat%4c%5a%6e/; + } # result open my $in, $outfile or die "cannot open $outfile: $!"; diff --git a/lib/bigfloat.t b/lib/bigfloatpl.t index d67d13d1d4..d67d13d1d4 100755..100644 --- a/lib/bigfloat.t +++ b/lib/bigfloatpl.t diff --git a/lib/bigint.pm b/lib/bigint.pm new file mode 100644 index 0000000000..e5770c33a8 --- /dev/null +++ b/lib/bigint.pm @@ -0,0 +1,343 @@ +package bigint; +require 5.005; + +$VERSION = '0.02'; +use Exporter; +@ISA = qw( Exporter ); +@EXPORT_OK = qw( ); + +use strict; +use overload; + +############################################################################## + +# These are all alike, and thus faked by AUTOLOAD + +my @faked = qw/round_mode accuracy precision div_scale/; +use vars qw/$VERSION $AUTOLOAD $_lite/; # _lite for testsuite + +sub AUTOLOAD + { + my $name = $AUTOLOAD; + + $name =~ s/.*:://; # split package + no strict 'refs'; + foreach my $n (@faked) + { + if ($n eq $name) + { + *{"bigint::$name"} = sub + { + my $self = shift; + no strict 'refs'; + if (defined $_[0]) + { + Math::BigInt->$name($_[0]); + } + return Math::BigInt->$name(); + }; + return &$name; + } + } + + # delayed load of Carp and avoid recursion + require Carp; + Carp::croak ("Can't call bigint\-\>$name, not a valid method"); + } + +sub upgrade + { + my $self = shift; + no strict 'refs'; +# if (defined $_[0]) +# { +# $Math::BigInt::upgrade = $_[0]; +# } + return $Math::BigInt::upgrade; + } + +sub _constant + { + # this takes a floating point constant string and returns it truncated to + # integer. For instance, '4.5' => '4', '1.234e2' => '123' etc + my $float = shift; + + # some simple cases first + return $float if ($float =~ /^[+-]?[0-9]+$/); # '+123','-1','0' etc + return $float + if ($float =~ /^[+-]?[0-9]+\.?[eE]\+?[0-9]+$/); # 123e2, 123.e+2 + return '0' if ($float =~ /^[+-]?[0]*\.[0-9]+$/); # .2, 0.2, -.1 + if ($float =~ /^[+-]?[0-9]+\.[0-9]*$/) # 1., 1.23, -1.2 etc + { + $float =~ s/\..*//; + return $float; + } + my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$float); + return $float if !defined $mis; # doesn't look like a number to me + my $ec = int($$ev); + my $sign = $$mis; $sign = '' if $sign eq '+'; + if ($$es eq '-') + { + # ignore fraction part entirely + if ($ec >= length($$miv)) # 123.23E-4 + { + return '0'; + } + return $sign . substr ($$miv,0,length($$miv)-$ec); # 1234.45E-2 = 12 + } + # xE+y + if ($ec >= length($$mfv)) + { + $ec -= length($$mfv); + return $sign.$$miv.$$mfv if $ec == 0; # 123.45E+2 => 12345 + return $sign.$$miv.$$mfv.'E'.$ec; # 123.45e+3 => 12345e1 + } + $mfv = substr($$mfv,0,$ec); + return $sign.$$miv.$mfv; # 123.45e+1 => 1234 + } + +sub import + { + my $self = shift; + + # some defaults + my $lib = 'Calc'; + + my @import = ( ':constant' ); # drive it w/ constant + my @a = @_; my $l = scalar @_; my $j = 0; + my ($ver,$trace); # version? trace? + my ($a,$p); # accuracy, precision + for ( my $i = 0; $i < $l ; $i++,$j++ ) + { + if ($_[$i] =~ /^(l|lib)$/) + { + # this causes a different low lib to take care... + $lib = $_[$i+1] || ''; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(a|accuracy)$/) + { + $a = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(p|precision)$/) + { + $p = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(v|version)$/) + { + $ver = 1; + splice @a, $j, 1; $j --; + } + elsif ($_[$i] =~ /^(t|trace)$/) + { + $trace = 1; + splice @a, $j, 1; $j --; + } + else { die "unknown option $_[$i]"; } + } + my $class; + $_lite = 0; # using M::BI::L ? + if ($trace) + { + require Math::BigInt::Trace; $class = 'Math::BigInt::Trace'; +# print STDERR "Loading $class"; + } + else + { + # see if we can find Math::BigInt::Lite + if (!defined $a && !defined $p) # rounding won't work to well + { + eval 'require Math::BigInt::Lite;'; + if ($@ eq '') + { + @import = ( ); # :constant in Lite, not MBI + Math::BigInt::Lite->import( ':constant' ); + $_lite= 1; # signal okay + } + } + require Math::BigInt if $_lite == 0; # not already loaded? + $class = 'Math::BigInt'; # regardless of MBIL or not + } + # Math::BigInt::Trace or plain Math::BigInt + $class->import(@import, lib => $lib); + + bigint->accuracy($a) if defined $a; + bigint->precision($p) if defined $p; + if ($ver) + { + print "bigint\t\t\t v$VERSION\n"; + print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; + print "Math::BigInt\t\t v$Math::BigInt::VERSION"; + my $config = Math::BigInt->config(); + print " lib => $config->{lib} v$config->{lib_version}\n"; + exit; + } + # we take care of floating point constants, since BigFloat isn't available + # and BigInt doesn't like them: + overload::constant float => sub { Math::BigInt->new( _constant(shift) ); }; + } + +1; + +__END__ + +=head1 NAME + +bigint - Transparent big integer support for Perl + +=head1 SYNOPSIS + + use bignt; + + $x = 2 + 4.5,"\n"; # BigInt 6 + print 2 ** 512; # really is what you think it is + +=head1 DESCRIPTION + +All operators (including basic math operations) are overloaded. Integer +constants are created as proper BigInts. + +Floating point constants are truncated to integer. All results are also +trunctaed. + +=head2 OPTIONS + +bigint recognizes some options that can be passed while loading it via use. +The options can (currently) be either a single letter form, or the long form. +The following options exist: + +=over 2 + +=item a or accuracy + +This sets the accuracy for all math operations. The argument must be greater +than or equal to zero. See Math::BigInt's bround() function for details. + + perl -Mbigint=a,2 -le 'print 12345+1' + +=item p or precision + +This sets the precision for all math operations. The argument can be any +integer. Negative values mean a fixed number of digits after the dot, and +are <B>ignored</B> since all operations happen in integer space. +A positive value rounds to this digit left from the dot. 0 or 1 mean round to +integer and are ignore like negative values. + +See Math::BigInt's bfround() function for details. + + perl -Mbignum=p,5 -le 'print 123456789+123' + +=item t or trace + +This enables a trace mode and is primarily for debugging bigint or +Math::BigInt. + +=item l or lib + +Load a different math lib, see L<MATH LIBRARY>. + + perl -Mbigint=l,GMP -e 'print 2 ** 512' + +Currently there is no way to specify more than one library on the command +line. This will be hopefully fixed soon ;) + +=item v or version + +This prints out the name and version of all modules used and then exits. + + perl -Mbigint=v -e '' + +=head2 MATH LIBRARY + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use bigint lib => 'Calc'; + +You can change this by using: + + use bigint lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use bigint lib => 'Foo,Math::BigInt::Bar'; + +Please see respective module documentation for further details. + +=head2 INTERNAL FORMAT + +The numbers are stored as objects, and their internals might change at anytime, +especially between math operations. The objects also might belong to different +classes, like Math::BigInt, or Math::BigInt::Lite. Mixing them together, even +with normal scalars is not extraordinary, but normal and expected. + +You should not depend on the internal format, all accesses must go through +accessor methods. E.g. looking at $x->{sign} is not a bright idea since there +is no guaranty that the object in question has such a hash key, nor is a hash +underneath at all. + +=head2 SIGN + +The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately. +You can access it with the sign() method. + +A sign of 'NaN' is used to represent the result when input arguments are not +numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively +minus infinity. You will get '+inf' when dividing a positive number by 0, and +'-inf' when dividing any negative number by 0. + +=head2 METHODS + +Since all numbers are now objects, you can use all functions that are part of +the BigInt API. You can only use the bxxx() notation, and not the fxxx() +notation, though. + +=head1 MODULES USED + +C<bigint> is just a thin wrapper around various modules of the Math::BigInt +family. Think of it as the head of the family, who runs the shop, and orders +the others to do the work. + +The following modules are currently used by bigint: + + Math::BigInt::Lite (for speed, and only if it is loadable) + Math::BigInt + +=head1 EXAMPLES + +Some cool command line examples to impress the Python crowd ;) You might want +to compare them to the results under -Mbignum or -Mbigrat: + + perl -Mbigint -le 'print sqrt(33)' + perl -Mbigint -le 'print 2*255' + perl -Mbigint -le 'print 4.5+2*255' + perl -Mbigint -le 'print 3/7 + 5/7 + 8/3' + perl -Mbigint -le 'print 123->is_odd()' + perl -Mbigint -le 'print log(2)' + perl -Mbigint -le 'print 2 ** 0.5' + perl -Mbigint=a,65 -le 'print 2 ** 0.2' + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +Especially L<bigrat> as in C<perl -Mbigrat -le 'print 1/3+1/4'> and +L<bignum> as in C<perl -Mbignum -le 'print sqrt(2)'>. + +L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well +as L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. + +=head1 AUTHORS + +(C) by Tels L<http://bloodgate.com/> in early 2002. + +=cut diff --git a/lib/bigint.t b/lib/bigintpl.t index 569db20667..569db20667 100755..100644 --- a/lib/bigint.t +++ b/lib/bigintpl.t diff --git a/lib/bignum.pm b/lib/bignum.pm new file mode 100644 index 0000000000..a9fd9f0697 --- /dev/null +++ b/lib/bignum.pm @@ -0,0 +1,326 @@ +package bignum; +require 5.005; + +$VERSION = '0.10'; +use Exporter; +@ISA = qw( Exporter ); +@EXPORT_OK = qw( ); + +use strict; + +############################################################################## + +# These are all alike, and thus faked by AUTOLOAD + +my @faked = qw/round_mode accuracy precision div_scale/; +use vars qw/$VERSION $AUTOLOAD $_lite/; # _lite for testsuite + +sub AUTOLOAD + { + my $name = $AUTOLOAD; + + $name =~ s/.*:://; # split package + no strict 'refs'; + foreach my $n (@faked) + { + if ($n eq $name) + { + *{"bignum::$name"} = sub + { + my $self = shift; + no strict 'refs'; + if (defined $_[0]) + { + Math::BigInt->$name($_[0]); + Math::BigFloat->$name($_[0]); + } + return Math::BigInt->$name(); + }; + return &$name; + } + } + + # delayed load of Carp and avoid recursion + require Carp; + Carp::croak ("Can't call bignum\-\>$name, not a valid method"); + } + +sub upgrade + { + my $self = shift; + no strict 'refs'; +# if (defined $_[0]) +# { +# $Math::BigInt::upgrade = $_[0]; +# $Math::BigFloat::upgrade = $_[0]; +# } + return $Math::BigInt::upgrade; + } + +sub import + { + my $self = shift; + + # some defaults + my $lib = 'Calc'; + my $upgrade = 'Math::BigFloat'; + my $downgrade = 'Math::BigInt'; + + my @import = ( ':constant' ); # drive it w/ constant + my @a = @_; my $l = scalar @_; my $j = 0; + my ($ver,$trace); # version? trace? + my ($a,$p); # accuracy, precision + for ( my $i = 0; $i < $l ; $i++,$j++ ) + { + if ($_[$i] eq 'upgrade') + { + # this causes upgrading + $upgrade = $_[$i+1]; # or undef to disable + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] eq 'downgrade') + { + # this causes downgrading + $downgrade = $_[$i+1]; # or undef to disable + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(l|lib)$/) + { + # this causes a different low lib to take care... + $lib = $_[$i+1] || ''; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(a|accuracy)$/) + { + $a = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(p|precision)$/) + { + $p = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(v|version)$/) + { + $ver = 1; + splice @a, $j, 1; $j --; + } + elsif ($_[$i] =~ /^(t|trace)$/) + { + $trace = 1; + splice @a, $j, 1; $j --; + } + else { die "unknown option $_[$i]"; } + } + my $class; + $_lite = 0; # using M::BI::L ? + if ($trace) + { + require Math::BigInt::Trace; $class = 'Math::BigInt::Trace'; + $upgrade = 'Math::BigFloat::Trace'; +# print STDERR "Loading $class"; + } + else + { + # see if we can find Math::BigInt::Lite + if (!defined $a && !defined $p) # rounding won't work to well + { + eval 'require Math::BigInt::Lite;'; + if ($@ eq '') + { + @import = ( ); # :constant in Lite, not MBI + Math::BigInt::Lite->import( ':constant' ); + $_lite= 1; # signal okay + } + } + require Math::BigInt if $_lite == 0; # not already loaded? + $class = 'Math::BigInt'; # regardless of MBIL or not + } + # Math::BigInt::Trace or plain Math::BigInt + $class->import(@import, upgrade => $upgrade, lib => $lib); + + if ($trace) + { + require Math::BigFloat::Trace; $class = 'Math::BigFloat::Trace'; + $downgrade = 'Math::BigInt::Trace'; +# print STDERR "Loading $class"; + } + else + { + require Math::BigFloat; $class = 'Math::BigFloat'; + } + $class->import(':constant','downgrade',$downgrade); + + bignum->accuracy($a) if defined $a; + bignum->precision($p) if defined $p; + if ($ver) + { + print "bignum\t\t\t v$VERSION\n"; + print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; + print "Math::BigInt\t\t v$Math::BigInt::VERSION"; + my $config = Math::BigInt->config(); + print " lib => $config->{lib} v$config->{lib_version}\n"; + print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; + exit; + } + } + +1; + +__END__ + +=head1 NAME + +bignum - Transparent BigNumber support for Perl + +=head1 SYNOPSIS + + use bignum; + + $x = 2 + 4.5,"\n"; # BigFloat 6.5 + print 2 ** 512 * 0.1; # really is what you think it is + +=head1 DESCRIPTION + +All operators (including basic math operations) are overloaded. Integer and +floating-point constants are created as proper BigInts or BigFloats, +respectively. + +=head2 OPTIONS + +bignum recognizes some options that can be passed while loading it via use. +The options can (currently) be either a single letter form, or the long form. +The following options exist: + +=over 2 + +=item a or accuracy + +This sets the accuracy for all math operations. The argument must be greater +than or equal to zero. See Math::BigInt's bround() function for details. + + perl -Mbignum=a,50 -le 'print sqrt(20)' + +=item p or precision + +This sets the precision for all math operations. The argument can be any +integer. Negative values mean a fixed number of digits after the dot, while +a positive value rounds to this digit left from the dot. 0 or 1 mean round to +integer. See Math::BigInt's bfround() function for details. + + perl -Mbignum=p,-50 -le 'print sqrt(20)' + +=item t or trace + +This enables a trace mode and is primarily for debugging bignum or +Math::BigInt/Math::BigFloat. + +=item l or lib + +Load a different math lib, see L<MATH LIBRARY>. + + perl -Mbignum=l,GMP -e 'print 2 ** 512' + +Currently there is no way to specify more than one library on the command +line. This will be hopefully fixed soon ;) + +=item v or version + +This prints out the name and version of all modules used and then exits. + + perl -Mbignum=v -e '' + +=head2 MATH LIBRARY + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use bignum lib => 'Calc'; + +You can change this by using: + + use bignum lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use bignum lib => 'Foo,Math::BigInt::Bar'; + +Please see respective module documentation for further details. + +=head2 INTERNAL FORMAT + +The numbers are stored as objects, and their internals might change at anytime, +especially between math operations. The objects also might belong to different +classes, like Math::BigInt, or Math::BigFLoat. Mixing them together, even +with normal scalars is not extraordinary, but normal and expected. + +You should not depend on the internal format, all accesses must go through +accessor methods. E.g. looking at $x->{sign} is not a bright idea since there +is no guaranty that the object in question has such a hashkey, nor is a hash +underneath at all. + +=head2 SIGN + +The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately. +You can access it with the sign() method. + +A sign of 'NaN' is used to represent the result when input arguments are not +numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively +minus infinity. You will get '+inf' when dividing a positive number by 0, and +'-inf' when dividing any negative number by 0. + +=head2 METHODS + +Since all numbers are now objects, you can use all functions that are part of +the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not +the fxxx() notation, though. This makes it possible that the underlying object +might morph into a different class than BigFloat. + +=head1 MODULES USED + +C<bignum> is just a thin wrapper around various modules of the Math::BigInt +family. Think of it as the head of the family, who runs the shop, and orders +the others to do the work. + +The following modules are currently used by bignum: + + Math::BigInt::Lite (for speed, and only if it is loadable) + Math::BigInt + Math::BigFloat + +=head1 EXAMPLES + +Some cool command line examples to impress the Python crowd ;) + + perl -Mbignum -le 'print sqrt(33)' + perl -Mbignum -le 'print 2*255' + perl -Mbignum -le 'print 4.5+2*255' + perl -Mbignum -le 'print 3/7 + 5/7 + 8/3' + perl -Mbignum -le 'print 123->is_odd()' + perl -Mbignum -le 'print log(2)' + perl -Mbignum -le 'print 2 ** 0.5' + perl -Mbignum=a,65 -le 'print 2 ** 0.2' + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +Especially L<bigrat> as in C<perl -Mbigrat -le 'print 1/3+1/4'>. + +L<Math::BigFloat>, L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well +as L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. + +=head1 AUTHORS + +(C) by Tels L<http://bloodgate.com/> in early 2002. + +=cut diff --git a/lib/bignum/t/bigint.t b/lib/bignum/t/bigint.t new file mode 100755 index 0000000000..6133f7b89a --- /dev/null +++ b/lib/bignum/t/bigint.t @@ -0,0 +1,86 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 28; + } + +use bigint; + +############################################################################### +# _constant tests + +foreach (qw/ + 123:123 + 123.4:123 + 1.4:1 + 0.1:0 + -0.1:0 + -1.1:-1 + -123.4:-123 + -123:-123 + 123e2:123e2 + 123e-1:12 + 123e-4:0 + 123e-3:0 + 123.345e-1:12 + 123.456e+2:12345 + 1234.567e+3:1234567 + 1234.567e+4:1234567E1 + 1234.567e+6:1234567E3 + /) + { + my ($x,$y) = split /:/; + print "# Try $x\n"; + ok (bigint::_constant("$x"),"$y"); + } + +############################################################################### +# general tests + +my $x = 5; ok (ref($x) =~ /^Math::BigInt/); # :constant + +# todo: ok (2 + 2.5,4.5); # should still work +# todo: $x = 2 + 3.5; ok (ref($x),'Math::BigFloat'); + +$x = 2 ** 255; ok (ref($x) =~ /^Math::BigInt/); + +ok (12->bfac(),479001600); +ok (9/4,2); + +ok (4.5+4.5,8); # truncate +ok (ref(4.5+4.5) =~ /^Math::BigInt/); + + +############################################################################### +# accurarcy and precision + +# this might change! + +ok_undef ($Math::BigInt::accuracy); +ok_undef ($Math::BigInt::precision); +bigint->accuracy(5); +ok ($Math::BigInt::accuracy,5); +bigint->precision(-2); +ok_undef ($Math::BigInt::accuracy); +ok ($Math::BigInt::precision,-2); + +############################################################################### +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } diff --git a/lib/bignum/t/bignum.t b/lib/bignum/t/bignum.t new file mode 100755 index 0000000000..a804a26f23 --- /dev/null +++ b/lib/bignum/t/bignum.t @@ -0,0 +1,72 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 17; + } + +use bignum; + +############################################################################### +# general tests + +my $x = 5; ok (ref($x) =~ /^Math::BigInt/); # :constant + +# todo: ok (2 + 2.5,4.5); # should still work +# todo: $x = 2 + 3.5; ok (ref($x),'Math::BigFloat'); + +$x = 2 ** 255; ok (ref($x) =~ /^Math::BigInt/); + +# see if Math::BigInt constant and upgrading works +ok (Math::BigInt::bsqrt(12),'3.464101615137754587054892683011744733886'); +ok (sqrt(12),'3.464101615137754587054892683011744733886'); + +ok (2/3,"0.6666666666666666666666666666666666666667"); + +#ok (2 ** 0.5, 'NaN'); # should be sqrt(2); + +ok (12->bfac(),479001600); + +# see if Math::BigFloat constant works + +# 0123456789 0123456789 <- default 40 +# 0123456789 0123456789 +ok (1/3, '0.3333333333333333333333333333333333333333'); + +############################################################################### +# accurarcy and precision + +# this might change! + +ok_undef ($Math::BigInt::accuracy); +ok_undef ($Math::BigInt::precision); +ok_undef ($Math::BigFloat::accuracy); +ok_undef ($Math::BigFloat::precision); +bignum->accuracy(5); +ok ($Math::BigInt::accuracy,5); +ok ($Math::BigFloat::accuracy,5); +bignum->precision(-2); +ok_undef ($Math::BigInt::accuracy); +ok_undef ($Math::BigFloat::accuracy); +ok ($Math::BigInt::precision,-2); +ok ($Math::BigFloat::precision,-2); + +############################################################################### +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } diff --git a/lib/bignum/t/bigrat.t b/lib/bignum/t/bigrat.t new file mode 100755 index 0000000000..3664e8beb6 --- /dev/null +++ b/lib/bignum/t/bigrat.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 4; + } + +use bigrat; + +############################################################################### +# general tests + +my $x = 5; ok (ref($x),'Math::BigInt'); # :constant + +# todo: ok (2 + 2.5,4.5); # should still work +# todo: $x = 2 + 3.5; ok (ref($x),'Math::BigFloat'); + +$x = 2 ** 255; ok (ref($x),'Math::BigInt'); + +# see if Math::BigRat constant works +ok (1/3, '1/3'); +ok (1/4+1/3,'7/12'); + +############################################################################### +# accurarcy and precision + +# this might change! +#ok_undef ($Math::BigInt::accuracy); +#ok_undef ($Math::BigInt::precision); +#ok_undef ($Math::BigFloat::accuracy); +#ok_undef ($Math::BigFloat::precision); +#bigrat->accuracy(5); +#ok ($Math::BigInt::accuracy,5); +#ok ($Math::BigFloat::accuracy,5); +#bigrat->precision(-2); +#ok_undef ($Math::BigInt::accuracy); +#ok_undef ($Math::BigFloat::accuracy); +#ok ($Math::BigInt::precision,-2); +#ok ($Math::BigFloat::precision,-2); + +############################################################################### +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } diff --git a/lib/bignum/t/bn_lite.t b/lib/bignum/t/bn_lite.t new file mode 100755 index 0000000000..21247c1ee7 --- /dev/null +++ b/lib/bignum/t/bn_lite.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 1; + } + +eval 'require Math::BigInt::Lite;'; +if ($@ eq '') + { + # can use Lite, so let bignum try it + require bignum; bignum->import(); + # can't get to work a ref(1+1) here, presumable because :constant phase + # already done + ok ($bignum::_lite,1); + } +else + { + print "ok 1 # skipped, no Math::BigInt::Lite\n"; + } + + diff --git a/lib/bignum/t/br_lite.t b/lib/bignum/t/br_lite.t new file mode 100755 index 0000000000..2bf77d4037 --- /dev/null +++ b/lib/bignum/t/br_lite.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 1; + } + +eval 'require Math::BigInt::Lite;'; +if ($@ eq '') + { + # can use Lite, so let bignum try it + require bigrat; bigrat->import(); + # can't get to work a ref(1+1) here, presumable because :constant phase + # already done + ok ($bigrat::_lite,1); + } +else + { + print "ok 1 # skipped, no Math::BigInt::Lite\n"; + } + + diff --git a/lib/bignum/t/option_a.t b/lib/bignum/t/option_a.t new file mode 100755 index 0000000000..2ab00bb074 --- /dev/null +++ b/lib/bignum/t/option_a.t @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 4; + } + +use bignum a => '12'; + +ok (Math::BigInt->accuracy(),12); +ok (Math::BigFloat->accuracy(),12); + +bignum->import( accuracy => '23'); + +ok (Math::BigInt->accuracy(),23); +ok (Math::BigFloat->accuracy(),23); + diff --git a/lib/bignum/t/option_l.t b/lib/bignum/t/option_l.t new file mode 100755 index 0000000000..134dd7cd8e --- /dev/null +++ b/lib/bignum/t/option_l.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 12; + } + +use bignum; + +my $rc = eval ('bignum->import( "l" => "foo" );'); +ok ($@,''); # shouldn't die +$rc = eval ('bignum->import( "lib" => "foo" );'); +ok ($@,''); # ditto + +$rc = eval ('bignum->import( "foo" => "bar" );'); +ok ($@ =~ /^Unknown option foo/i,1); # should die + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) + { + $rc = eval ('bignum->import( "$_" => "bar" );'); + ok ($@ =~ /^Unknown option $_/i,1); # should die + } + diff --git a/lib/bignum/t/option_p.t b/lib/bignum/t/option_p.t new file mode 100755 index 0000000000..c6df4ad1f4 --- /dev/null +++ b/lib/bignum/t/option_p.t @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 2; + } + +use bignum p => '12'; + +ok (Math::BigInt->precision(),12); +ok (Math::BigFloat->precision(),12); + diff --git a/lib/bignum/t/trace.t b/lib/bignum/t/trace.t new file mode 100755 index 0000000000..891101b5f9 --- /dev/null +++ b/lib/bignum/t/trace.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 1; + } + +BEGIN + { + print "# "; # for testsuite + } +use bignum qw/ trace /; + +############################################################################### +# general tests + +my $x = 5; +print "\n"; +ok (ref($x),'Math::BigInt::Trace'); # :constant via trace + +############################################################################### +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } diff --git a/lib/bigrat.pm b/lib/bigrat.pm new file mode 100644 index 0000000000..3fc0a99060 --- /dev/null +++ b/lib/bigrat.pm @@ -0,0 +1,242 @@ +package bigrat; +require 5.005; + +$VERSION = '0.04'; +use Exporter; +@ISA = qw( Exporter ); +@EXPORT_OK = qw( ); + +use strict; + +############################################################################## + +# These are all alike, and thus faked by AUTOLOAD + +my @faked = qw/round_mode accuracy precision div_scale/; +use vars qw/$VERSION $AUTOLOAD $_lite/; # _lite for testsuite + +sub AUTOLOAD + { + my $name = $AUTOLOAD; + + $name =~ s/.*:://; # split package + no strict 'refs'; + foreach my $n (@faked) + { + if ($n eq $name) + { + *{"bigrat::$name"} = sub + { + my $self = shift; + no strict 'refs'; + if (defined $_[0]) + { + Math::BigInt->$name($_[0]); + Math::BigFloat->$name($_[0]); + } + return Math::BigInt->$name(); + }; + return &$name; + } + } + + # delayed load of Carp and avoid recursion + require Carp; + Carp::croak ("Can't call bigrat\-\>$name, not a valid method"); + } + +sub upgrade + { + my $self = shift; + no strict 'refs'; +# if (defined $_[0]) +# { +# $Math::BigInt::upgrade = $_[0]; +# $Math::BigFloat::upgrade = $_[0]; +# } + return $Math::BigInt::upgrade; + } + +sub import + { + my $self = shift; + + # see also bignum->import() for additional comments + + # some defaults + my $lib = 'Calc'; my $upgrade = 'Math::BigFloat'; + + my @import = ( ':constant' ); # drive it w/ constant + my @a = @_; my $l = scalar @_; my $j = 0; + my ($a,$p); + my ($ver,$trace); # version? trace? + for ( my $i = 0; $i < $l ; $i++,$j++ ) + { + if ($_[$i] eq 'upgrade') + { + # this causes upgrading + $upgrade = $_[$i+1]; # or undef to disable + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; + } + elsif ($_[$i] =~ /^(l|lib)$/) + { + # this causes a different low lib to take care... + $lib = $_[$i+1] || ''; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; + } + elsif ($_[$i] =~ /^(v|version)$/) + { + $ver = 1; + splice @a, $j, 1; $j --; + } + elsif ($_[$i] =~ /^(t|trace)$/) + { + $trace = 1; + splice @a, $j, 1; $j --; + } + else + { + die ("unknown option $_[$i]"); + } + } + my $class; + $_lite = 0; # using M::BI::L ? + if ($trace) + { + require Math::BigInt::Trace; $class = 'Math::BigInt::Trace'; + $upgrade = 'Math::BigFloat::Trace'; +# print STDERR "Loading $class"; + } + else + { + # see if we can find Math::BigInt::Lite + if (!defined $a && !defined $p) # rounding won't work to well + { + eval 'require Math::BigInt::Lite;'; + if ($@ eq '') + { + @import = ( ); # :constant in Lite, not MBI + Math::BigInt::Lite->import( ':constant' ); + $_lite= 1; # signal okay + } + } + require Math::BigInt if $_lite == 0; # not already loaded? + $class = 'Math::BigInt'; # regardless of MBIL or not + } + # Math::BigInt::Trace or plain Math::BigInt + $class->import(@import, upgrade => $upgrade, lib => $lib); + + require Math::BigFloat; + Math::BigFloat->import( upgrade => 'Math::BigRat', ':constant' ); + require Math::BigRat; + if ($ver) + { + print "bigrat\t\t\t v$VERSION\n"; + print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; + print "Math::BigInt\t\t v$Math::BigInt::VERSION"; + my $config = Math::BigInt->config(); + print " lib => $config->{lib} v$config->{lib_version}\n"; + print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; + print "Math::BigRat\t\t v$Math::BigRat::VERSION\n"; + exit; + } + } + +1; + +__END__ + +=head1 NAME + +bigrat - Transparent BigNumber/BigRationale support for Perl + +=head1 SYNOPSIS + + use bigrat; + + $x = 2 + 4.5,"\n"; # BigFloat 6.5 + print 1/3 + 1/4,"\n"; # produces 7/12 + +=head1 DESCRIPTION + +All operators (inlcuding basic math operations) are overloaded. Integer and +floating-point constants are created as proper BigInts or BigFloats, +respectively. + +Other than L<bignum>, this module upgrades to Math::BigRat, meaning that +instead of 2.5 you will get 2+1/2 as output. + +=head2 MODULES USED + +C<bigrat> is just a thin wrapper around various modules of the Math::BigInt +family. Think of it as the head of the family, who runs the shop, and orders +the others to do the work. + +The following modules are currently used by bignum: + + Math::BigInt::Lite (for speed, and only if it is loadable) + Math::BigInt + Math::BigFloat + Math::BigRat + +=head2 MATH LIBRARY + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use bigrat lib => 'Calc'; + +You can change this by using: + + use bigrat lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use bigrat lib => 'Foo,Math::BigInt::Bar'; + +Please see respective module documentation for further details. + +=head2 SIGN + +The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately. + +A sign of 'NaN' is used to represent the result when input arguments are not +numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively +minus infinity. You will get '+inf' when dividing a positive number by 0, and +'-inf' when dividing any negative number by 0. + +=head2 METHODS + +Since all numbers are not objects, you can use all functions that are part of +the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not +the fxxx() notation, though. This makes you independed on the fact that the +underlying object might morph into a different class than BigFloat. + +=head1 EXAMPLES + + perl -Mbigrat -le 'print sqrt(33)' + perl -Mbigrat -le 'print 2*255' + perl -Mbigrat -le 'print 4.5+2*255' + perl -Mbigrat -le 'print 3/7 + 5/7 + 8/3' + perl -Mbigrat -le 'print 12->is_odd()'; + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +Especially L<bignum>. + +L<Math::BigFloat>, L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well +as L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. + +=head1 AUTHORS + +(C) by Tels L<http://bloodgate.com/> in early 2002. + +=cut diff --git a/patchlevel.h b/patchlevel.h index aeb502d794..8ce76e7b73 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -79,7 +79,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL15421" + ,"DEVEL15449" ,NULL }; diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 0a119452bf..ad0d6d850c 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2584,22 +2584,22 @@ version which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvIVX +=item SvIVx -Returns the raw value in the SV's IV slot, without checks or conversions. -Only use when you are sure SvIOK is true. See also C<SvIV()>. +Coerces the given SV to an integer and returns it. Guarantees to evaluate +sv only once. Use the more efficient C<SvIV> otherwise. - IV SvIVX(SV* sv) + IV SvIVx(SV* sv) =for hackers Found in file sv.h -=item SvIVx +=item SvIVX -Coerces the given SV to an integer and returns it. Guarantees to evaluate -sv only once. Use the more efficient C<SvIV> otherwise. +Returns the raw value in the SV's IV slot, without checks or conversions. +Only use when you are sure SvIOK is true. See also C<SvIV()>. - IV SvIVx(SV* sv) + IV SvIVX(SV* sv) =for hackers Found in file sv.h @@ -2699,22 +2699,22 @@ which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvNVx +=item SvNVX -Coerces the given SV to a double and returns it. Guarantees to evaluate -sv only once. Use the more efficient C<SvNV> otherwise. +Returns the raw value in the SV's NV slot, without checks or conversions. +Only use when you are sure SvNOK is true. See also C<SvNV()>. - NV SvNVx(SV* sv) + NV SvNVX(SV* sv) =for hackers Found in file sv.h -=item SvNVX +=item SvNVx -Returns the raw value in the SV's NV slot, without checks or conversions. -Only use when you are sure SvNOK is true. See also C<SvNV()>. +Coerces the given SV to a double and returns it. Guarantees to evaluate +sv only once. Use the more efficient C<SvNV> otherwise. - NV SvNVX(SV* sv) + NV SvNVx(SV* sv) =for hackers Found in file sv.h @@ -3832,8 +3832,7 @@ Found in file sv.c =item sv_pv -A private implementation of the C<SvPV_nolen> macro for compilers which can't -cope with complex macro expressions. Always use the macro instead. +Use the C<SvPV_nolen> macro instead char* sv_pv(SV *sv) @@ -3842,9 +3841,7 @@ Found in file sv.c =item sv_pvbyte -A private implementation of the C<SvPVbyte_nolen> macro for compilers -which can't cope with complex macro expressions. Always use the macro -instead. +Use C<SvPVbyte_nolen> instead. char* sv_pvbyte(SV *sv) @@ -3910,9 +3907,7 @@ Found in file sv.c =item sv_pvutf8 -A private implementation of the C<SvPVutf8_nolen> macro for compilers -which can't cope with complex macro expressions. Always use the macro -instead. +Use the C<SvPVutf8_nolen> macro instead char* sv_pvutf8(SV *sv) diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 1e6350bd7f..744e63648f 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -700,6 +700,18 @@ went bang?) Also see L<Error Indicators>. +=item %! + +Each element of C<%!> has a true value only if C<$!> is set to that +value. For example, C<$!{ENOENT}> is true if and only if the current +value of C<$!> is C<ENOENT>; that is, if the most recent error was +"No such file or directory" (or its moral equivalent: not all operating +systems give that exact error, and certainly not all languages). +To check if a particular key is meaningful on your system, use +C<exists $!{the_key}>; for a list of legal keys, use C<keys %!>. +See L<Errno> for more information, and also see above for the +validity of C<$!>. + =item $EXTENDED_OS_ERROR =item $^E @@ -954,9 +954,9 @@ PERL_CALLCONV void Perl_reginitcolors(pTHX); PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv); PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv); PERL_CALLCONV char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv); -PERL_CALLCONV char* Perl_sv_pv(pTHX_ SV *sv); -PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv); -PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv); +/* PERL_CALLCONV char* sv_pv(pTHX_ SV *sv); */ +/* PERL_CALLCONV char* sv_pvutf8(pTHX_ SV *sv); */ +/* PERL_CALLCONV char* sv_pvbyte(pTHX_ SV *sv); */ /* PERL_CALLCONV STRLEN sv_utf8_upgrade(pTHX_ SV *sv); */ PERL_CALLCONV bool Perl_sv_utf8_downgrade(pTHX_ SV *sv, bool fail_ok); PERL_CALLCONV void Perl_sv_utf8_encode(pTHX_ SV *sv); @@ -2875,8 +2875,8 @@ uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob) return ptr; } -/* For backwards-compatibility only. sv_2pv() is normally #def'ed to - * C<sv_2pv_macro()>. See also C<sv_2pv_flags()>. +/* sv_2pv() is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only */ char * @@ -3322,6 +3322,11 @@ use the Encode extension for that. =cut */ +/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags(); + * this function provided for binary compatibility only + */ + + STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv) { @@ -3516,9 +3521,10 @@ C<SvSetMagicSV_nosteal>. =cut */ -/* sv_setsv() is aliased to Perl_sv_setsv_macro; this function provided - for binary compatibility only -*/ +/* sv_setsv() is now a macro using Perl_sv_setsv_flags(); + * this function provided for binary compatibility only + */ + void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) { @@ -4247,9 +4253,10 @@ Handles 'get' magic, but not 'set' magic. See C<sv_catpvn_mg>. =cut */ -/* sv_catpvn() is aliased to Perl_sv_catpvn_macro; this function provided - for binary compatibility only -*/ +/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags(); + * this function provided for binary compatibility only + */ + void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) { @@ -4310,9 +4317,10 @@ not 'set' magic. See C<sv_catsv_mg>. =cut */ -/* sv_catsv() is aliased to Perl_sv_catsv_macro; this function provided - for binary compatibility only -*/ +/* sv_catsv() is now a macro using Perl_sv_catsv_flags(); + * this function provided for binary compatibility only + */ + void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) { @@ -6847,12 +6855,16 @@ Perl_sv_nv(pTHX_ register SV *sv) /* =for apidoc sv_pv -A private implementation of the C<SvPV_nolen> macro for compilers which can't -cope with complex macro expressions. Always use the macro instead. +Use the C<SvPV_nolen> macro instead =cut */ +/* sv_pv() is now a macro using SvPV_nolen(); + * this function provided for binary compatibility only + */ + + char * Perl_sv_pv(pTHX_ SV *sv) { @@ -6883,8 +6895,6 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) return sv_2pv(sv, lp); } -/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>. - */ char * Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp) @@ -6906,6 +6916,10 @@ can't cope with complex macro expressions. Always use the macro instead. =cut */ +/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags(); + * this function provided for binary compatibility only + */ + char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) { @@ -6967,13 +6981,16 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) /* =for apidoc sv_pvbyte -A private implementation of the C<SvPVbyte_nolen> macro for compilers -which can't cope with complex macro expressions. Always use the macro -instead. +Use C<SvPVbyte_nolen> instead. =cut */ +/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only + */ + + char * Perl_sv_pvbyte(pTHX_ SV *sv) { @@ -7018,12 +7035,14 @@ Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp) /* =for apidoc sv_pvutf8 -A private implementation of the C<SvPVutf8_nolen> macro for compilers -which can't cope with complex macro expressions. Always use the macro -instead. +Use the C<SvPVutf8_nolen> macro instead =cut */ +/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only + */ + char * Perl_sv_pvutf8(pTHX_ SV *sv) @@ -928,150 +928,75 @@ otherwise. =cut */ -#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp) -#define SvPV(sv, lp) sv_pvn(sv, &lp) -#define SvPV_nolen(sv) sv_pv(sv) -#define SvPV_nomg(sv, lp) sv_pvn_nomg(sv, &lp) -#define SvPV_force_flags(sv, lp, flags) sv_pvn_force_flags(sv, &lp, flags) - -#define SvPVutf8_force(sv, lp) sv_pvutf8n_force(sv, &lp) -#define SvPVutf8(sv, lp) sv_pvutf8n(sv, &lp) -#define SvPVutf8_nolen(sv) sv_pvutf8(sv) - -#define SvPVbyte_force(sv, lp) sv_pvbyte_force(sv, &lp) -#define SvPVbyte(sv, lp) sv_pvbyten(sv, &lp) -#define SvPVbyte_nolen(sv) sv_pvbyte(sv) - -#define SvPVx(sv, lp) sv_pvn(sv, &lp) -#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) -#define SvPVutf8x(sv, lp) sv_pvutf8n(sv, &lp) -#define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) -#define SvPVbytex(sv, lp) sv_pvbyten(sv, &lp) -#define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) - -#define SvIVx(sv) sv_iv(sv) -#define SvUVx(sv) sv_uv(sv) -#define SvNVx(sv) sv_nv(sv) - -#define SvTRUEx(sv) sv_true(sv) - -#define SvIV(sv) SvIVx(sv) -#define SvNV(sv) SvNVx(sv) -#define SvUV(sv) SvUVx(sv) -#define SvTRUE(sv) SvTRUEx(sv) - -/* flag values for sv_*_flags functions */ -#define SV_IMMEDIATE_UNREF 1 -#define SV_GMAGIC 2 - -#define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) -#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0) -#define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0) - -/* #ifndef CRIPPLED_CC */ -/* redefine some things to more efficient inlined versions */ - /* Let us hope that bitmaps for UV and IV are the same */ -#undef SvIV #define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) - -#undef SvUV #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) - -#undef SvNV #define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)) -#define sv_setsv(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_GMAGIC) -#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, 0) -#define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC) -#define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) -#define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) -#define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) -#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) -#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) -#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) +/* ----*/ -#undef SvPV #define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) -#undef SvPV_nomg -#define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) - -#undef SvPV_flags #define SvPV_flags(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) -#undef SvPV_force #define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) -#undef SvPV_force_nomg + #define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) -#undef SvPV_force_flags #define SvPV_force_flags(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) -#undef SvPV_nolen #define SvPV_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_nolen(sv)) -#undef SvPVutf8 -#define SvPVutf8(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) - -#undef SvPVutf8_force -#define SvPVutf8_force(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) +#define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) -#undef SvPVutf8_nolen -#define SvPVutf8_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ - ? SvPVX(sv) : sv_2pvutf8_nolen(sv)) +/* ----*/ -#undef SvPVutf8 #define SvPVutf8(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) -#undef SvPVutf8_force #define SvPVutf8_force(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) -#undef SvPVutf8_nolen + #define SvPVutf8_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ ? SvPVX(sv) : sv_2pvutf8_nolen(sv)) -#undef SvPVbyte +/* ----*/ + #define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) -#undef SvPVbyte_force #define SvPVbyte_force(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyte_force(sv, &lp)) -#undef SvPVbyte_nolen #define SvPVbyte_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\ ? SvPVX(sv) : sv_2pvbyte_nolen(sv)) + +/* define FOOx(): idempotent versions of FOO(). If possible, use a local + * var to evaluate the arg once; failing that, use a global if possible; + * failing that, call a function to do the work + */ + +#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) +#define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) +#define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) + #ifdef __GNUC__ -# undef SvIVx -# undef SvUVx -# undef SvNVx -# undef SvPVx -# undef SvPVutf8x -# undef SvPVbytex -# undef SvTRUE -# undef SvTRUEx + # define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); }) # define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); }) # define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); }) @@ -1095,26 +1020,31 @@ otherwise. ? SvNVX(sv) != 0.0 \ : sv_2bool(sv) ) # define SvTRUEx(sv) ({SV *nsv = (sv); SvTRUE(nsv); }) + #else /* __GNUC__ */ -#ifndef USE_5005THREADS + +# ifdef USE_5005THREADS +# define SvIVx(sv) sv_iv(sv) +# define SvUVx(sv) sv_uv(sv) +# define SvNVx(sv) sv_nv(sv) +# define SvPVx(sv, lp) sv_pvn(sv, &lp) +# define SvPVutf8x(sv, lp) sv_pvutf8n(sv, &lp) +# define SvPVbytex(sv, lp) sv_pvbyten(sv, &lp) +# define SvTRUE(sv) SvTRUEx(sv) +# define SvTRUEx(sv) sv_true(sv) + +# else /* USE_5005THREADS */ + /* These inlined macros use globals, which will require a thread * declaration in user code, so we avoid them under threads */ -# undef SvIVx -# undef SvUVx -# undef SvNVx -# undef SvPVx -# undef SvPVutf8x -# undef SvPVbytex -# undef SvTRUE -# undef SvTRUEx -# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv)) -# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) -# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv)) -# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp)) -# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) -# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) -# define SvTRUE(sv) ( \ +# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv)) +# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) +# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv)) +# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp)) +# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) +# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) +# define SvTRUE(sv) ( \ !sv \ ? 0 \ : SvPOK(sv) \ @@ -1129,10 +1059,34 @@ otherwise. : SvNOK(sv) \ ? SvNVX(sv) != 0.0 \ : sv_2bool(sv) ) -# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) -#endif /* !USE_5005THREADS */ -#endif /* !__GNU__ */ -/* #endif !CRIPPLED_CC */ +# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +# endif /* USE_5005THREADS */ +#endif /* __GNU__ */ + + +/* flag values for sv_*_flags functions */ +#define SV_IMMEDIATE_UNREF 1 +#define SV_GMAGIC 2 + +/* all these 'functions' are now just macros */ + +#define sv_pv(sv) SvPV_nolen(sv) +#define sv_pvutf8(sv) SvPVutf8_nolen(sv) +#define sv_pvbyte(sv) SvPVbyte_nolen(sv) + +#define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) +#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0) +#define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0) +#define sv_setsv(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_GMAGIC) +#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, 0) +#define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC) +#define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) +#define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) +#define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) +#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) +#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) +#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) + /* =for apidoc Am|SV*|newRV_inc|SV* sv diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t index 9035886be0..18b0d0557a 100644 --- a/t/lib/1_compile.t +++ b/t/lib/1_compile.t @@ -1,118 +1,21 @@ #!./perl +# Modules should have their own tests. For historical reasons, some +# do not. This does basic compile tests on modules that have no tests +# of their own. + BEGIN { - chdir '..' if -d '../pod' && -d '../t'; - @INC = 'lib'; + chdir 't'; + @INC = '../lib'; } use strict; use warnings; -use Config; - -my %Core_Modules; -my %Test; - -unless (open(MANIFEST, "MANIFEST")) { - die "$0: failed to open 'MANIFEST': $!\n"; -} - -sub add_by_name { - $Core_Modules{$_[0]}++; -} - -while (<MANIFEST>) { - s/_pm\.PL/.pm/; # Don't forget the extracted modules - if (m!^(lib)/(\S+?)\.pm\s!) { - # Collecting modules names from under ext/ would be - # rather painful since the mapping from filenames - # to module names is not 100%. - my ($dir, $module) = ($1, $2); - $module =~ s!/!::!g; - add_by_name($module); - } elsif (m!^(lib|ext)/(\S+?)(?:\.t|/test.pl)\s!) { - my ($dir, $test) = ($1, $2); - $test =~ s!(\w+)/\1$!$1! if $dir eq 'ext'; - $test =~ s!/t/[^/]+$!!; - $test =~ s!/!::!g; - $Test{$test}++; - } -} - -close(MANIFEST); - -# Delete stuff that can't be tested here. - -sub delete_by_name { - delete $Core_Modules{$_[0]}; -} - -sub has_extension { - $Config{extensions} =~ /\b$_[0]\b/i; -} - -sub delete_unless_has_extension { - delete $Core_Modules{$_[0]} unless has_extension($_[0]); -} - -foreach my $known_extension (split(' ', $Config{known_extensions})) { - delete_unless_has_extension($known_extension); -} - -sub delete_by_prefix { - for my $match (grep { /^$_[0]/ } keys %Core_Modules) { - delete_by_name($match); - } -} - -delete_by_name('CGI::Fast'); # won't load without FCGI - -delete_by_prefix('ExtUtils::MM_'); # ExtUtils::MakeMaker's domain - -delete_by_prefix('File::Spec::'); # File::Spec's domain -add_by_name('File::Spec::Functions'); # put this back - -delete_by_prefix('Attribute::Handlers');# we test this, and we have demos - -delete_by_prefix('Net::FTP::'); # Net::FTP is tested. - -# In this case we could rely on the fake Socket layer the libnet tests -# use but frankly I think in this case we might as well let it be. -delete_by_prefix('Net::') unless has_extension('Socket'); - -sub using_feature { - my $use = "use$_[0]"; - exists $Config{$use} && - defined $Config{$use} && - $Config{$use} eq 'define'; -} - -unless (using_feature('threads') && has_extension('Thread')) { - delete_by_name('Thread'); - delete_by_prefix('Thread::'); -} - -unless (has_extension('NDBM_File')) { - delete_by_name('Memoize::NDBM_File'); -} - -if (ord('A') == 193) { - delete_by_prefix('Net::') unless eval { require Convert::EBCDIC }; -} - -# Delete all modules which have their own tests. -# This makes this test a lot faster. -foreach my $mod (sort keys %Test) { - delete_by_name($mod); -} -foreach my $mod (<DATA>) { - chomp $mod; - print "### $mod has a test but is in DATA of $0\n" if exists $Test{$mod}; - delete_by_name($mod); -} # Okay, this is the list. -my @Core_Modules = sort keys %Core_Modules; +my @Core_Modules = grep /\S/, sort <DATA>; +chomp @Core_Modules; print "1..".(1+@Core_Modules)."\n"; @@ -136,104 +39,31 @@ foreach my $module (@Core_Modules) { # out of our namespace. sub compile_module { my ($module) = $_[0]; - - my $out = scalar `$^X "-Ilib" t/lib/compmod.pl $module`; + + my $out = scalar `$^X "-I../lib" lib/compmod.pl $module`; print "# $out"; return $out =~ /^ok/; } -# Add here modules that have their own test scripts and therefore -# need not be test-compiled by 1_compile.t. +# These modules have no tests of their own. +# Keep up to date with +# http://www.pobox.com/~schwern/cgi-bin/perl-qa-wiki.cgi?UntestedModules +# and vice-versa. The list should only shrink. __DATA__ -B::ShowLex -CGI::Apache -CGI::Carp -CGI::Cookie -CGI::Form -CGI::Pretty -CGI::Push -CGI::Switch -CGI::Util -Carp::Heavy -CPAN::Nox -Exporter::Heavy -ExtUtils::Command -ExtUtils::Constant -ExtUtils::Embed -ExtUtils::Installed -ExtUtils::MakeMaker -ExtUtils::Manifest -ExtUtils::Mkbootstrap -ExtUtils::Packlist -File::Spec::Functions -Filter::Util::Call -GDBM_File -I18N::LangTags::List -IO::Dir -IO::File -IO::Handle -IO::Pipe -IO::Poll -IO::Seekable -IO::Select -IO::Socket -IO::Socket::INET -IO::Socket::UNIX -Locale::Constants -Locale::Country -Locale::Currency -Locale::Language -Locale::Script -MIME::QuotedPrint -Math::BigFloat -Math::BigInt::Calc -Memoize::AnyDBM_File -Memoize::Expire -Memoize::ExpireFile -Memoize::ExpireTest -Memoize::NDBM_File -Memoize::SDBM_File -Memoize::Storable -NDBM_File -Net::Config -Net::FTP -Net::Netrc -Net::NNTP -Net::SMTP -Net::Time -ODBM_File -Pod::Checker -Pod::Find -Pod::Functions -Pod::Html -Pod::InputObjects -Pod::LaTeX -Pod::Man -Pod::ParseLink -Pod::ParseUtils -Pod::Select -Pod::Text -Pod::Text::Overstrike -Pod::Text::Termcap -Pod::Usage -SDBM_File -Safe -Scalar::Util -Sys::Syslog -Test::Builder -Test::Harness::Assert -Test::Harness::Straps -Test::More -Test::ParseWords -Text::Tabs -Text::Wrap -Thread -Tie::Array -Tie::Handle -Tie::Hash -Time::tm -UNIVERSAL -attributes -base -ops -warnings::register +B::CC +B::Disassembler +B::Stackobj +ByteLoader +CPAN +CPAN::FirstTime +DynaLoader +ExtUtils::MM_NW5 +ExtUtils::Install +ExtUtils::Liblist +ExtUtils::Mksymlists +Net::Cmd +Net::Domain +Net::POP3 +O +Pod::Plainer +Test::Harness::Iterator diff --git a/t/lib/Math/BigRat/Test.pm b/t/lib/Math/BigRat/Test.pm new file mode 100644 index 0000000000..80be068a27 --- /dev/null +++ b/t/lib/Math/BigRat/Test.pm @@ -0,0 +1,81 @@ +#!/usr/bin/perl -w + +package Math::BigRat::Test; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigRat; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigRat); +$VERSION = 0.03; + +use overload; # inherit overload from BigRat + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +my $class = 'Math::BigRat::Test'; + +#ub new +#{ +# my $proto = shift; +# my $class = ref($proto) || $proto; +# +# my $value = shift; +# my $a = $accuracy; $a = $_[0] if defined $_[0]; +# my $p = $precision; $p = $_[1] if defined $_[1]; +# # Store the floating point value +# my $self = Math::BigFloat->new($value,$a,$p,$round_mode); +# bless $self, $class; +# $self->{'_custom'} = 1; # make sure this never goes away +# return $self; +#} + +sub bstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n} if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bstr(); + } + +sub bsstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n}->bsstr() if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bsstr(); + } + +1; diff --git a/t/op/utfhash.t b/t/op/utfhash.t index a955f28f1a..54f77bbe4f 100644 --- a/t/op/utfhash.t +++ b/t/op/utfhash.t @@ -43,14 +43,14 @@ foreach my $a ("\x7f","\xff") } # Check we have not got an spurious extra keys -is(join('',sort keys %hash8),"\x7f\xff"); -is(join('',sort keys %hashu),"\x7f\xff\x{1ff}"); +is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff"); +is(join('',sort { ord $a <=> ord $b } keys %hashu),"\x7f\xff\x{1ff}"); # Now add a utf8 key to the 8-bit hash $hash8{chr(0x1ff)} = 0x1ff; # Check we have not got an spurious extra keys -is(join('',sort keys %hash8),"\x7f\xff\x{1ff}"); +is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff\x{1ff}"); foreach my $a ("\x7f","\xff","\x{1ff}") { diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 0824e0a90f..7929a27933 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -342,7 +342,7 @@ sub searchfor { for ($i=0; $i<@dirs; $i++) { $dir = $dirs[$i]; ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS; - if ( ( $ret = check_file $dir,"$s.pod") + if ( (! $opt_m && ( $ret = check_file $dir,"$s.pod")) or ( $ret = check_file $dir,"$s.pm") or ( $ret = check_file $dir,$s) or ( $Is_VMS and @@ -458,7 +458,8 @@ foreach (@pages) { print STDERR "Loosely found as @files\n" if $opt_v; } else { - print STDERR "No documentation found for \"$_\".\n"; + print STDERR "No " . + ($opt_m ? "module" : "documentation") . " found for \"$_\".\n"; if (@global_found) { print STDERR "However, try\n"; for my $dir (@global_found) { @@ -1096,13 +1096,18 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, #ifdef KILL_BY_SIGPRC #include <errnodef.h> -/* okay, this is some BLATENT hackery ... - we use this if the kill() in the CRTL uses sys$forcex, causing the +/* We implement our own kill() using the undocumented system service + sys$sigprc for one of two reasons: + + 1.) If the kill() in an older CRTL uses sys$forcex, causing the target process to do a sys$exit, which usually can't be handled gracefully...certainly not by Perl and the %SIG{} mechanism. - Instead we use the (undocumented) system service sys$sigprc. - It has the same parameters as sys$forcex, but throws an exception + 2.) If the kill() in the CRTL can't be called from a signal + handler without disappearing into the ether, i.e., the signal + it purportedly sends is never trapped. Still true as of VMS 7.3. + + sys$sigprc has the same parameters as sys$forcex, but throws an exception in the target process rather than calling sys$exit. Note that distinguishing SIGSEGV from SIGBUS requires an extra arg |