This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 15 Oct 2001 15:59:57 +0000 (15:59 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 15 Oct 2001 15:59:57 +0000 (15:59 +0000)
p4raw-id: //depot/perlio@12444

385 files changed:
Changes
MANIFEST
configure.com
ext/DB_File/DB_File.xs
ext/Data/Dumper/Dumper.xs
ext/POSIX/t/sigaction.t
ext/threads/threads.h
ext/threads/threads.xs
lib/ExtUtils/MM_Unix.pm
lib/File/Copy.pm
lib/File/Find/t/find.t
lib/File/Find/t/taint.t
lib/File/Spec.pm
lib/File/Spec.t
lib/File/Spec/Epoc.pm
lib/File/Spec/Mac.pm
lib/File/Spec/Unix.pm
lib/File/Spec/Win32.pm
lib/Math/BigFloat.pm
lib/Math/BigInt.pm
lib/Math/BigInt/Calc.pm
lib/Math/BigInt/t/Math/Subclass.pm [new file with mode: 0644]
lib/Math/BigInt/t/bigfltpm.inc [new file with mode: 0644]
lib/Math/BigInt/t/bigfltpm.t
lib/Math/BigInt/t/bigintpm.t
lib/Math/BigInt/t/calling.t [new file with mode: 0644]
lib/Math/BigInt/t/mbimbf.t
lib/Math/BigInt/t/subclass.t [new file with mode: 0644]
lib/Term/Complete.pm
lib/Term/Complete.t
lib/h2xs.t
lib/unicore/ArabLink.pl
lib/unicore/ArabLnkGrp.pl
lib/unicore/Bidirectional.pl
lib/unicore/Blocks.pl
lib/unicore/Category.pl
lib/unicore/CombiningClass.pl
lib/unicore/Decomposition.pl
lib/unicore/In.pl
lib/unicore/In/0.pl
lib/unicore/In/1.pl
lib/unicore/In/10.pl
lib/unicore/In/100.pl
lib/unicore/In/101.pl
lib/unicore/In/102.pl
lib/unicore/In/103.pl
lib/unicore/In/104.pl
lib/unicore/In/105.pl
lib/unicore/In/106.pl
lib/unicore/In/107.pl
lib/unicore/In/108.pl
lib/unicore/In/109.pl
lib/unicore/In/11.pl
lib/unicore/In/110.pl
lib/unicore/In/111.pl
lib/unicore/In/112.pl
lib/unicore/In/113.pl
lib/unicore/In/114.pl
lib/unicore/In/115.pl
lib/unicore/In/116.pl
lib/unicore/In/117.pl
lib/unicore/In/118.pl
lib/unicore/In/119.pl
lib/unicore/In/12.pl
lib/unicore/In/120.pl
lib/unicore/In/121.pl
lib/unicore/In/122.pl
lib/unicore/In/123.pl
lib/unicore/In/124.pl
lib/unicore/In/125.pl
lib/unicore/In/126.pl
lib/unicore/In/127.pl
lib/unicore/In/128.pl
lib/unicore/In/129.pl
lib/unicore/In/13.pl
lib/unicore/In/130.pl
lib/unicore/In/131.pl
lib/unicore/In/132.pl
lib/unicore/In/133.pl
lib/unicore/In/134.pl
lib/unicore/In/135.pl
lib/unicore/In/136.pl
lib/unicore/In/137.pl
lib/unicore/In/138.pl
lib/unicore/In/139.pl
lib/unicore/In/14.pl
lib/unicore/In/140.pl
lib/unicore/In/141.pl
lib/unicore/In/142.pl
lib/unicore/In/143.pl
lib/unicore/In/144.pl
lib/unicore/In/145.pl
lib/unicore/In/146.pl
lib/unicore/In/147.pl
lib/unicore/In/148.pl
lib/unicore/In/149.pl
lib/unicore/In/15.pl
lib/unicore/In/150.pl
lib/unicore/In/151.pl
lib/unicore/In/152.pl
lib/unicore/In/153.pl
lib/unicore/In/154.pl
lib/unicore/In/155.pl
lib/unicore/In/156.pl
lib/unicore/In/157.pl
lib/unicore/In/158.pl
lib/unicore/In/159.pl
lib/unicore/In/16.pl
lib/unicore/In/160.pl
lib/unicore/In/161.pl
lib/unicore/In/162.pl
lib/unicore/In/163.pl [new file with mode: 0644]
lib/unicore/In/164.pl [new file with mode: 0644]
lib/unicore/In/165.pl [new file with mode: 0644]
lib/unicore/In/166.pl [new file with mode: 0644]
lib/unicore/In/167.pl [new file with mode: 0644]
lib/unicore/In/168.pl [new file with mode: 0644]
lib/unicore/In/169.pl [new file with mode: 0644]
lib/unicore/In/17.pl
lib/unicore/In/170.pl [new file with mode: 0644]
lib/unicore/In/171.pl [moved from lib/unicore/Is/SylN.pl with 60% similarity]
lib/unicore/In/18.pl
lib/unicore/In/19.pl
lib/unicore/In/2.pl
lib/unicore/In/20.pl
lib/unicore/In/21.pl
lib/unicore/In/22.pl
lib/unicore/In/23.pl
lib/unicore/In/24.pl
lib/unicore/In/25.pl
lib/unicore/In/26.pl
lib/unicore/In/27.pl
lib/unicore/In/28.pl
lib/unicore/In/29.pl
lib/unicore/In/3.pl
lib/unicore/In/30.pl
lib/unicore/In/31.pl
lib/unicore/In/32.pl
lib/unicore/In/33.pl
lib/unicore/In/34.pl
lib/unicore/In/35.pl
lib/unicore/In/36.pl
lib/unicore/In/37.pl
lib/unicore/In/38.pl
lib/unicore/In/39.pl
lib/unicore/In/4.pl
lib/unicore/In/40.pl
lib/unicore/In/41.pl
lib/unicore/In/42.pl
lib/unicore/In/43.pl
lib/unicore/In/44.pl
lib/unicore/In/45.pl
lib/unicore/In/46.pl
lib/unicore/In/47.pl
lib/unicore/In/48.pl
lib/unicore/In/49.pl
lib/unicore/In/5.pl
lib/unicore/In/50.pl
lib/unicore/In/51.pl
lib/unicore/In/52.pl
lib/unicore/In/53.pl
lib/unicore/In/54.pl
lib/unicore/In/55.pl
lib/unicore/In/56.pl
lib/unicore/In/57.pl
lib/unicore/In/58.pl
lib/unicore/In/59.pl
lib/unicore/In/6.pl
lib/unicore/In/60.pl
lib/unicore/In/61.pl
lib/unicore/In/62.pl
lib/unicore/In/63.pl
lib/unicore/In/64.pl
lib/unicore/In/65.pl
lib/unicore/In/66.pl
lib/unicore/In/67.pl
lib/unicore/In/68.pl
lib/unicore/In/69.pl
lib/unicore/In/7.pl
lib/unicore/In/70.pl
lib/unicore/In/71.pl
lib/unicore/In/72.pl
lib/unicore/In/73.pl
lib/unicore/In/74.pl
lib/unicore/In/75.pl
lib/unicore/In/76.pl
lib/unicore/In/77.pl
lib/unicore/In/78.pl
lib/unicore/In/79.pl
lib/unicore/In/8.pl
lib/unicore/In/80.pl
lib/unicore/In/81.pl
lib/unicore/In/82.pl
lib/unicore/In/83.pl
lib/unicore/In/84.pl
lib/unicore/In/85.pl
lib/unicore/In/86.pl
lib/unicore/In/87.pl
lib/unicore/In/88.pl
lib/unicore/In/89.pl
lib/unicore/In/9.pl
lib/unicore/In/90.pl
lib/unicore/In/91.pl
lib/unicore/In/92.pl
lib/unicore/In/93.pl
lib/unicore/In/94.pl
lib/unicore/In/95.pl
lib/unicore/In/96.pl
lib/unicore/In/97.pl
lib/unicore/In/98.pl
lib/unicore/In/99.pl
lib/unicore/Is.pl [new file with mode: 0644]
lib/unicore/Is/ASCII.pl
lib/unicore/Is/Alnum.pl
lib/unicore/Is/Alpha.pl
lib/unicore/Is/BidiAL.pl
lib/unicore/Is/BidiAN.pl
lib/unicore/Is/BidiB.pl
lib/unicore/Is/BidiBN.pl
lib/unicore/Is/BidiCS.pl
lib/unicore/Is/BidiEN.pl
lib/unicore/Is/BidiES.pl
lib/unicore/Is/BidiET.pl
lib/unicore/Is/BidiL.pl
lib/unicore/Is/BidiLRE.pl
lib/unicore/Is/BidiLRO.pl
lib/unicore/Is/BidiNSM.pl
lib/unicore/Is/BidiON.pl
lib/unicore/Is/BidiPDF.pl
lib/unicore/Is/BidiR.pl
lib/unicore/Is/BidiRLE.pl
lib/unicore/Is/BidiRLO.pl
lib/unicore/Is/BidiS.pl
lib/unicore/Is/BidiWS.pl
lib/unicore/Is/Blank.pl
lib/unicore/Is/C.pl
lib/unicore/Is/Cc.pl
lib/unicore/Is/Cf.pl
lib/unicore/Is/Cn.pl
lib/unicore/Is/Cntrl.pl
lib/unicore/Is/Co.pl
lib/unicore/Is/Cs.pl
lib/unicore/Is/DCcircle.pl
lib/unicore/Is/DCcompat.pl
lib/unicore/Is/DCfinal.pl
lib/unicore/Is/DCfont.pl
lib/unicore/Is/DCfraction.pl
lib/unicore/Is/DCinitial.pl
lib/unicore/Is/DCisolated.pl
lib/unicore/Is/DCmedial.pl
lib/unicore/Is/DCnarrow.pl
lib/unicore/Is/DCnoBreak.pl
lib/unicore/Is/DCsmall.pl
lib/unicore/Is/DCsquare.pl
lib/unicore/Is/DCsub.pl
lib/unicore/Is/DCsuper.pl
lib/unicore/Is/DCvertical.pl
lib/unicore/Is/DCwide.pl
lib/unicore/Is/DecoCanon.pl
lib/unicore/Is/DecoCompat.pl
lib/unicore/Is/Digit.pl
lib/unicore/Is/Graph.pl
lib/unicore/Is/L.pl
lib/unicore/Is/LbrkAI.pl
lib/unicore/Is/LbrkAL.pl
lib/unicore/Is/LbrkB2.pl
lib/unicore/Is/LbrkBA.pl
lib/unicore/Is/LbrkBB.pl
lib/unicore/Is/LbrkBK.pl
lib/unicore/Is/LbrkCB.pl
lib/unicore/Is/LbrkCL.pl
lib/unicore/Is/LbrkCM.pl
lib/unicore/Is/LbrkCR.pl
lib/unicore/Is/LbrkEX.pl
lib/unicore/Is/LbrkGL.pl
lib/unicore/Is/LbrkHY.pl
lib/unicore/Is/LbrkID.pl
lib/unicore/Is/LbrkIN.pl
lib/unicore/Is/LbrkIS.pl
lib/unicore/Is/LbrkLF.pl
lib/unicore/Is/LbrkNS.pl
lib/unicore/Is/LbrkNU.pl
lib/unicore/Is/LbrkOP.pl
lib/unicore/Is/LbrkPO.pl
lib/unicore/Is/LbrkPR.pl
lib/unicore/Is/LbrkQU.pl
lib/unicore/Is/LbrkSA.pl
lib/unicore/Is/LbrkSG.pl
lib/unicore/Is/LbrkSP.pl
lib/unicore/Is/LbrkSY.pl
lib/unicore/Is/LbrkXX.pl
lib/unicore/Is/LbrkZW.pl
lib/unicore/Is/Ll.pl
lib/unicore/Is/Lm.pl
lib/unicore/Is/Lo.pl
lib/unicore/Is/Lower.pl
lib/unicore/Is/Lt.pl
lib/unicore/Is/Lu.pl
lib/unicore/Is/M.pl
lib/unicore/Is/Mc.pl
lib/unicore/Is/Me.pl
lib/unicore/Is/Mirrored.pl
lib/unicore/Is/Mn.pl
lib/unicore/Is/N.pl
lib/unicore/Is/Nd.pl
lib/unicore/Is/Nl.pl
lib/unicore/Is/No.pl
lib/unicore/Is/P.pl
lib/unicore/Is/Pc.pl
lib/unicore/Is/Pd.pl
lib/unicore/Is/Pe.pl
lib/unicore/Is/Pf.pl
lib/unicore/Is/Pi.pl
lib/unicore/Is/Po.pl
lib/unicore/Is/Print.pl
lib/unicore/Is/Ps.pl
lib/unicore/Is/Punct.pl
lib/unicore/Is/S.pl
lib/unicore/Is/Sc.pl
lib/unicore/Is/Sk.pl
lib/unicore/Is/Sm.pl
lib/unicore/Is/So.pl
lib/unicore/Is/Space.pl
lib/unicore/Is/SpacePerl.pl
lib/unicore/Is/SylA.pl [deleted file]
lib/unicore/Is/SylAA.pl [deleted file]
lib/unicore/Is/SylAAI.pl [deleted file]
lib/unicore/Is/SylAI.pl [deleted file]
lib/unicore/Is/SylC.pl [deleted file]
lib/unicore/Is/SylE.pl [deleted file]
lib/unicore/Is/SylEE.pl [deleted file]
lib/unicore/Is/SylI.pl [deleted file]
lib/unicore/Is/SylII.pl [deleted file]
lib/unicore/Is/SylO.pl [deleted file]
lib/unicore/Is/SylOO.pl [deleted file]
lib/unicore/Is/SylU.pl [deleted file]
lib/unicore/Is/SylV.pl [deleted file]
lib/unicore/Is/SylWA.pl [deleted file]
lib/unicore/Is/SylWAA.pl [deleted file]
lib/unicore/Is/SylWC.pl [deleted file]
lib/unicore/Is/SylWE.pl [deleted file]
lib/unicore/Is/SylWEE.pl [deleted file]
lib/unicore/Is/SylWI.pl [deleted file]
lib/unicore/Is/SylWII.pl [deleted file]
lib/unicore/Is/SylWO.pl [deleted file]
lib/unicore/Is/SylWOO.pl [deleted file]
lib/unicore/Is/SylWU.pl [deleted file]
lib/unicore/Is/SylWV.pl [deleted file]
lib/unicore/Is/Syllable.pl [deleted file]
lib/unicore/Is/Title.pl [new file with mode: 0644]
lib/unicore/Is/Upper.pl
lib/unicore/Is/Word.pl
lib/unicore/Is/XDigit.pl
lib/unicore/Is/Z.pl
lib/unicore/Is/Zl.pl
lib/unicore/Is/Zp.pl
lib/unicore/Is/Zs.pl
lib/unicore/JamoShort.pl
lib/unicore/Lbrk.pl [new file with mode: 0644]
lib/unicore/Makefile
lib/unicore/Name.pl
lib/unicore/Number.pl
lib/unicore/Scripts.pl
lib/unicore/To/Digit.pl
lib/unicore/To/Lower.pl
lib/unicore/To/Title.pl
lib/unicore/To/Upper.pl
lib/unicore/mktables [new file with mode: 0644]
lib/unicore/syllables.txt [deleted file]
lib/utf8_heavy.pl
lib/warnings.pm
op.h
patchlevel.h
perl.h
pod/perlfaq3.pod
pod/perlfaq4.pod
pod/perllexwarn.pod
pod/perlnewmod.pod
pod/perlunicode.pod
sv.c
t/lib/warnings/7fatal
t/op/magic.t
t/op/pat.t
utils/h2xs.PL
warnings.pl

diff --git a/Changes b/Changes
index 5c90111..9517973 100644 (file)
--- a/Changes
+++ b/Changes
@@ -31,6 +31,335 @@ or any other branch.
 Version v5.7.2         Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 12440] By: jhi                                   on 2001/10/15  12:58:24
+        Log: MacOS Classic catdir() rewrite from Thomas Wegner
+             (backward incompatibility, but a deliberate one,
+             the old version simply is broken in its logic),
+             also documentation updates, and as suggested replicated
+             the File::Spec::Unix documentation updates also on the
+             File::Spec documentation.
+             
+             TODO: there seems to be duplication of documentation
+             between File::Spec and File::Spec::Unix.  I think
+             the ::Unix should be left only with specific UNIXisms,
+             and all the generic documentation should be in ::Spec.
+     Branch: perl
+          ! lib/File/Find/t/find.t lib/File/Find/t/taint.t
+          ! lib/File/Spec.pm lib/File/Spec.t lib/File/Spec/Mac.pm
+          ! lib/File/Spec/Unix.pm
+____________________________________________________________________________
+[ 12439] By: jhi                                   on 2001/10/15  12:32:07
+        Log: Subject: Re: [PATCH t/op/magic.t] missing tests on Win32
+             From: Blair Zajac <blair@orcaware.com>
+             Date: Mon, 24 Sep 2001 11:48:58 -0700
+             Message-ID: <3BAF801A.88A4F614@orcaware.com>     
+             
+             (the skip() messages)
+     Branch: perl
+          ! t/op/magic.t
+____________________________________________________________________________
+[ 12438] By: ams                                   on 2001/10/14  23:43:59
+        Log: Subject: [PATCH] make PerlIO default on VMS
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Sun, 14 Oct 2001 15:27:18 -0500
+             Message-Id: <5.1.0.14.0.20011014152339.021ec150@exchi01>
+     Branch: perl
+          ! configure.com
+____________________________________________________________________________
+[ 12437] By: jhi                                   on 2001/10/14  23:05:57
+        Log: Retract #12436 (Abhijit already did this at #12426)
+     Branch: perl
+          ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 12436] By: jhi                                   on 2001/10/14  21:22:43
+        Log: (retracted by #12437)
+             Subject: [PATCH lib/ExtUtils/MM_Unix.pm] MakeMaker tries to parse commented out $VERSION
+             From: =?iso-8859-1?Q?Kay_R=F6pke?= <kroepke@dolphin-services.de>
+             Date: Sat, 13 Oct 2001 20:33:55 +0200
+             Message-Id: <E15sTbe-0001nt-00@mrvdom04.kundenserver.de>
+     Branch: perl
+          ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 12435] By: jhi                                   on 2001/10/14  21:21:52
+        Log: Subject: h2xs grammar nit
+             From: Yitzchak Scott-Thoennes <sthoenna@efn.org>
+             Date: Fri, 12 Oct 2001 00:12:01 -0700 (PDT)
+             Message-ID: <Pine.GSU.4.21.0110120010540.9710-100000@garcia.efn.org>
+     Branch: perl
+          ! utils/h2xs.PL
+____________________________________________________________________________
+[ 12434] By: jhi                                   on 2001/10/14  13:48:30
+        Log: Subject: [PATCH @12422] Fix scoping problem with FATAL warnings
+             From: "Paul Marquess" <Paul_Marquess@yahoo.co.uk>
+             Date: Sun, 14 Oct 2001 11:25:08 +0100
+             Message-ID: <AIEAJICLCBDNAAOLLOKLCEFDDCAA.Paul_Marquess@Yahoo.co.uk>
+     Branch: perl
+          ! lib/warnings.pm pod/perllexwarn.pod t/lib/warnings/7fatal
+          ! warnings.pl
+____________________________________________________________________________
+[ 12433] By: jhi                                   on 2001/10/13  23:20:11
+        Log: Use File::Spec (needs Thomas Wegner's upcoming patch
+             for File::Spec::Mac::catfile)
+     Branch: perl
+          ! lib/h2xs.t
+____________________________________________________________________________
+[ 12432] By: jhi                                   on 2001/10/13  23:17:31
+        Log: Subject: [PATCH] Re: default module version for h2xs (was Re: [PATCH] Re: What sort of Makefile.PL should h2xs write?)   
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sat, 13 Oct 2001 00:07:31 +0100
+             Message-ID: <20011013000731.D67535@plum.flirble.org>
+     Branch: perl
+          ! lib/h2xs.t utils/h2xs.PL
+____________________________________________________________________________
+[ 12431] By: jhi                                   on 2001/10/13  22:35:58
+        Log: Define PASTHRU_DEFINE and PASTHRU_INC (which are used
+             before DEFINE and INC), and repent by taking DEFINE and
+             INC away from PASTHRU.
+     Branch: perl
+          ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 12430] By: jhi                                   on 2001/10/13  21:23:09
+        Log: More MANIFEST anomalies.
+     Branch: perl
+          ! MANIFEST
+____________________________________________________________________________
+[ 12429] By: jhi                                   on 2001/10/13  21:01:32
+        Log: Not that many.
+     Branch: perl
+          ! MANIFEST
+____________________________________________________________________________
+[ 12428] By: sky                                   on 2001/10/13  20:59:27
+        Log: Subject: [DOC PATCH] pod syntax fixups for File::Spec::* modules
+             From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+             Date: Sat, 13 Oct 2001 23:15:55 +0200
+             Message-ID: <20011013231555.A18071@rafael>
+     Branch: perl
+          ! lib/File/Spec.pm lib/File/Spec/Epoc.pm lib/File/Spec/Mac.pm
+          ! lib/File/Spec/Unix.pm lib/File/Spec/Win32.pm
+____________________________________________________________________________
+[ 12427] By: jhi                                   on 2001/10/13  20:54:17
+        Log: Rewrite mktables from scratch.
+             - Cleaner.
+             - Faster: 15-20 seconds as opposed to several minutes.
+             - More dynamic: the names of the various categories
+             such as the linebreak ones are dynamic, not static.
+             - Is.pl: long names for the general category properties
+             are now available.
+             - Ranges (<... ,First>, <..., Last>) from the general
+             categories work now.
+             - No more mktables.PL because the mktables.PL is not
+             and never has been run to create a mktables.
+             - syllables.txt and Is/Syl*.pl removed: non-standard
+             (not part of the Unicode), and the whole concept is
+             being reworked (http://syllabary.sourceforge.net/),
+             the old way wouldn't even work with the new Syllables.txt
+             (it would result in 1000+ new categories)
+     Branch: perl
+          + lib/unicore/In/163.pl lib/unicore/In/164.pl
+          + lib/unicore/In/165.pl lib/unicore/In/166.pl
+          + lib/unicore/In/167.pl lib/unicore/In/168.pl
+          + lib/unicore/In/169.pl lib/unicore/In/170.pl
+          + lib/unicore/In/171.pl lib/unicore/Is.pl
+          + lib/unicore/Is/Title.pl lib/unicore/Lbrk.pl
+          + lib/unicore/mktables
+          - lib/unicore/Is/SylA.pl lib/unicore/Is/SylAA.pl
+          - lib/unicore/Is/SylAAI.pl lib/unicore/Is/SylAI.pl
+          - lib/unicore/Is/SylC.pl lib/unicore/Is/SylE.pl
+          - lib/unicore/Is/SylEE.pl lib/unicore/Is/SylI.pl
+          - lib/unicore/Is/SylII.pl lib/unicore/Is/SylN.pl
+          - lib/unicore/Is/SylO.pl lib/unicore/Is/SylOO.pl
+          - lib/unicore/Is/SylU.pl lib/unicore/Is/SylV.pl
+          - lib/unicore/Is/SylWA.pl lib/unicore/Is/SylWAA.pl
+          - lib/unicore/Is/SylWC.pl lib/unicore/Is/SylWE.pl
+          - lib/unicore/Is/SylWEE.pl lib/unicore/Is/SylWI.pl
+          - lib/unicore/Is/SylWII.pl lib/unicore/Is/SylWO.pl
+          - lib/unicore/Is/SylWOO.pl lib/unicore/Is/SylWU.pl
+          - lib/unicore/Is/SylWV.pl lib/unicore/Is/Syllable.pl
+          - lib/unicore/syllables.txt
+          ! (edit 304 files)
+____________________________________________________________________________
+[ 12426] By: ams                                   on 2001/10/13  18:05:36
+        Log: ExtUtils::MM_Unix should ignore comments when searching for
+             $VERSION.
+     Branch: perl
+          ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 12425] By: jhi                                   on 2001/10/13  12:26:41
+        Log: Subject: Re: New module XML::Clean
+             From: andreas.koenig@anima.de (Andreas J. Koenig)
+             Date: 13 Oct 2001 10:17:09 +0200
+             Message-ID: <m37ku0t0my.fsf@anima.de>
+     Branch: perl
+          ! pod/perlnewmod.pod
+____________________________________________________________________________
+[ 12424] By: sky                                   on 2001/10/13  09:39:59
+        Log: Set thread stack size if needed.
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12423] By: sky                                   on 2001/10/13  09:36:49
+        Log: We do want to set the attribute to joinable even on modern posix
+             platforms.
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12422] By: jhi                                   on 2001/10/13  02:04:44
+        Log: Subject: [PATCH ext/Data/Dumper.xs]
+             From: Brian Ingerson <ingy@ttul.org>
+             Date: Fri, 12 Oct 2001 19:32:35 -0700
+             Message-ID: <20011012193235.B889@ttul.org>
+     Branch: perl
+          ! ext/Data/Dumper/Dumper.xs
+____________________________________________________________________________
+[ 12421] By: jhi                                   on 2001/10/12  23:22:45
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
+[ 12420] By: jhi                                   on 2001/10/12  22:51:17
+        Log: FAQ sync.
+     Branch: perl
+          ! pod/perlfaq3.pod pod/perlfaq4.pod
+____________________________________________________________________________
+[ 12419] By: jhi                                   on 2001/10/12  22:46:49
+        Log: Subject: RE: [PATCH File::Copy] Silence warnings for tied filehandles     
+             From: "Wilson, Doug" <Doug_Wilson@intuit.com>
+             Date: Fri, 12 Oct 2001 11:51:05 -0700
+             Message-ID: <35A280DF784CD411A06B0008C7B130AD0115DDAE@sdex04.sd.intuit.com>
+     Branch: perl
+          ! lib/File/Copy.pm
+____________________________________________________________________________
+[ 12418] By: jhi                                   on 2001/10/12  22:44:24
+        Log: Subject: [PATCH lib/Term/Complete.t] Rethinking the Test
+             From: "chromatic" <chromatic@rmci.net>     
+             Date: Thu, 11 Oct 2001 10:57:55 -0600
+             Message-ID: <20011011170354.74354.qmail@onion.perl.org>
+             
+             Subject: [PATCH Complete.pm] Re: [PATCH lib/Term/Complete.t] Rethinking the Test
+             From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+             Date: Thu, 11 Oct 2001 22:34:21 +0200
+             Message-ID: <20011011223421.A693@rafael>     
+             
+             plus undef $Term::Complete::stty as suggested by Rafael.
+     Branch: perl
+          ! lib/Term/Complete.pm lib/Term/Complete.t
+____________________________________________________________________________
+[ 12417] By: jhi                                   on 2001/10/12  20:35:49
+        Log: UUnndduupplleexx..
+     Branch: perl
+          ! perl.h
+____________________________________________________________________________
+[ 12416] By: sky                                   on 2001/10/12  20:16:19
+        Log: Subject: Re: Sparc/Linux/ithreads unhappy @12391 [PATCH]
+             From: Andy Dougherty <doughera@lafayette.edu>
+             Date: Fri, 12 Oct 2001 16:53:03 -0400 (EDT)
+             Message-ID: <Pine.SOL.4.10.10110121647360.11279-100000@maxwell.phys.lafayette.edu>
+             (Potentially only band-aid)
+     Branch: perl
+          ! sv.c
+____________________________________________________________________________
+[ 12415] By: jhi                                   on 2001/10/12  20:13:06
+        Log: VMS pre-7.0 (which doesn't have sigaction()) uniformly
+             mishandles kill(), and therefore the sigaction test
+             should be skipped, from Charles Lane.
+     Branch: perl
+          ! ext/POSIX/t/sigaction.t
+____________________________________________________________________________
+[ 12414] By: sky                                   on 2001/10/12  18:47:49
+        Log: Perhaps other OLD_POSIX_API systems might be happy and not only HP-UX 10.20
+     Branch: perl
+          ! op.h
+____________________________________________________________________________
+[ 12413] By: jhi                                   on 2001/10/12  18:35:31
+        Log: Upgrade to Math::BigInt 1.44 from Tels and
+             further fixes from John Peacock.
+     Branch: perl
+          + lib/Math/BigInt/t/Math/Subclass.pm
+          + lib/Math/BigInt/t/bigfltpm.inc lib/Math/BigInt/t/calling.t
+          + lib/Math/BigInt/t/subclass.t
+          ! MANIFEST lib/Math/BigFloat.pm lib/Math/BigInt.pm
+          ! lib/Math/BigInt/Calc.pm lib/Math/BigInt/t/bigfltpm.t
+          ! lib/Math/BigInt/t/bigintc.t lib/Math/BigInt/t/bigintpm.t
+          ! lib/Math/BigInt/t/mbimbf.t
+____________________________________________________________________________
+[ 12412] By: sky                                   on 2001/10/12  18:28:23
+        Log: perhaps pthread_attr_t really needs to be set for the old api
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12411] By: sky                                   on 2001/10/12  18:11:45
+        Log: pthread_keycreate not pthread_key_create under the here be dragons API
+     Branch: perl
+          ! ext/threads/threads.h
+____________________________________________________________________________
+[ 12410] By: sky                                   on 2001/10/12  18:07:37
+        Log: Apperently OLD PTHREADS API is a bit retarded.
+             This should fix another set of compile failures in HP-UX 10.20.
+     Branch: perl
+          ! ext/threads/threads.h ext/threads/threads.xs
+____________________________________________________________________________
+[ 12409] By: nick                                  on 2001/10/12  15:30:01
+        Log: Blind integrate of mainline
+     Branch: perlio
+         +> (branch 32 files)
+          - lib/unicode/README
+         !> (integrate 121 files)
+____________________________________________________________________________
+[ 12408] By: sky                                   on 2001/10/12  14:55:08
+        Log: Let us avoid being smart for now.
+     Branch: perl
+          ! ext/threads/threads.h
+____________________________________________________________________________
+[ 12407] By: sky                                   on 2001/10/12  14:38:12
+        Log: (void*) the argument to make sure we work with picky compilers
+     Branch: perl
+          ! ext/threads/threads.xs
+____________________________________________________________________________
+[ 12406] By: ams                                   on 2001/10/12  13:26:04
+        Log: Subject: [PATCH 5.6.1 perldoc] use File::Temp
+             From: Mikhail Zabaluev <mhz@alt-linux.org>
+             Date: Fri, 12 Oct 2001 12:47:47 +0400
+             Message-Id: <20011012124747.E13918@localhost.localdomain>
+     Branch: perl
+          ! utils/perldoc.PL
+____________________________________________________________________________
+[ 12405] By: ams                                   on 2001/10/12  13:05:32
+        Log: Subject: [PATCH] (Was: lib/Memoize/t/speed.................FAILED at test 2)
+             From: andreas.koenig@anima.de (Andreas J. Koenig)
+             Date: 12 Oct 2001 11:12:07 +0200
+             Message-Id: <m3wv21te6w.fsf_-_@anima.de>
+     Branch: perl
+          ! lib/Memoize/t/speed.t
+____________________________________________________________________________
+[ 12404] By: sky                                   on 2001/10/12  12:46:15
+        Log: A) Support OLD_PTHREADS_API
+             B) Change from using pthread_t to using a TLS to store the
+             index of the thread in an hash, this is to avoid problems when
+             in fact pthread_t was not a seralizable type.
+             Both these changes are because of HP-UX 10.20
+             This has not been tested on win32 but should work there.
+             Need to add support for NetWare.
+     Branch: perl
+          ! ext/threads/threads.h ext/threads/threads.xs
+____________________________________________________________________________
+[ 12403] By: ams                                   on 2001/10/12  07:34:19
+        Log: Subject: Re: New module XML::Clean
+             From: andreas.koenig@anima.de (Andreas J. Koenig)
+             Date: 12 Oct 2001 10:20:35 +0200
+             Message-Id: <m3elo9uv58.fsf@anima.de>
+     Branch: perl
+          ! pod/perlnewmod.pod
+____________________________________________________________________________
+[ 12402] By: jhi                                   on 2001/10/11  19:51:04
+        Log: More HP model tweaks from Merijn.
+     Branch: perl
+          ! README.hpux
+____________________________________________________________________________
+[ 12401] By: jhi                                   on 2001/10/11  13:03:10
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
 [ 12400] By: jhi                                   on 2001/10/11  11:33:20
         Log: HP-UX update from H.Merijn Brand.
      Branch: perl
index 16fe167..eb864bc 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -852,8 +852,8 @@ lib/constant.t                      See if compile-time constants work
 lib/CPAN.pm                    Interface to Comprehensive Perl Archive Network
 lib/CPAN/FirstTime.pm          Utility for creating CPAN config files
 lib/CPAN/Nox.pm                        Runs CPAN while avoiding compiled extensions
-lib/CPAN/t/Nox.t               See if CPAN::Nox works
 lib/CPAN/t/loadme.t            See if CPAN the module works
+lib/CPAN/t/Nox.t               See if CPAN::Nox works
 lib/CPAN/t/vcmp.t              See if CPAN the module works
 lib/ctime.pl                   A ctime workalike
 lib/Cwd.pm                     Various cwd routines (getcwd, fastcwd, chdir)
@@ -1019,10 +1019,14 @@ lib/look.pl                     A "look" equivalent
 lib/Math/BigFloat.pm           An arbitrary precision floating-point arithmetic package
 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/bigfltpm.inc Shared tests for bigfltpm.t and subclass.t
 lib/Math/BigInt/t/bigfltpm.t   See if BigFloat.pm works
 lib/Math/BigInt/t/bigintc.t    See if BigInt/Calc.pm works
 lib/Math/BigInt/t/bigintpm.t   See if BigInt.pm works
+lib/Math/BigInt/t/calling.t    Test calling conventions
+lib/Math/BigInt/t/Math/Subclass.pm     Empty subclass of BigFloat for test
 lib/Math/BigInt/t/mbimbf.t     BigInt/BigFloat accuracy, precicion and fallback, round_mode
+lib/Math/BigInt/t/subclass.t   Empty subclass test of BigFloat
 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
@@ -1341,7 +1345,16 @@ lib/unicore/In/16.pl             Unicode character database
 lib/unicore/In/160.pl          Unicode character database
 lib/unicore/In/161.pl          Unicode character database
 lib/unicore/In/162.pl          Unicode character database
+lib/unicore/In/163.pl          Unicode character database
+lib/unicore/In/164.pl          Unicode character database
+lib/unicore/In/165.pl          Unicode character database
+lib/unicore/In/166.pl          Unicode character database
+lib/unicore/In/167.pl          Unicode character database
+lib/unicore/In/168.pl          Unicode character database
+lib/unicore/In/169.pl          Unicode character database
 lib/unicore/In/17.pl           Unicode character database
+lib/unicore/In/170.pl          Unicode character database
+lib/unicore/In/171.pl          Unicode character database
 lib/unicore/In/18.pl           Unicode character database
 lib/unicore/In/19.pl           Unicode character database
 lib/unicore/In/2.pl            Unicode character database
@@ -1433,6 +1446,7 @@ lib/unicore/In/97.pl              Unicode character database
 lib/unicore/In/98.pl           Unicode character database
 lib/unicore/In/99.pl           Unicode character database
 lib/unicore/Index.txt          Unicode character database
+lib/unicore/Is.pl              Unicode character database
 lib/unicore/Is/Alnum.pl                Unicode character database
 lib/unicore/Is/Alpha.pl                Unicode character database
 lib/unicore/Is/ASCII.pl                Unicode character database
@@ -1545,32 +1559,7 @@ lib/unicore/Is/Sm.pl             Unicode character database
 lib/unicore/Is/So.pl           Unicode character database
 lib/unicore/Is/Space.pl                Unicode character database
 lib/unicore/Is/SpacePerl.pl    Unicode character database
-lib/unicore/Is/SylA.pl         Unicode character database
-lib/unicore/Is/SylAA.pl                Unicode character database
-lib/unicore/Is/SylAAI.pl       Unicode character database
-lib/unicore/Is/SylAI.pl                Unicode character database
-lib/unicore/Is/SylC.pl         Unicode character database
-lib/unicore/Is/SylE.pl         Unicode character database
-lib/unicore/Is/SylEE.pl                Unicode character database
-lib/unicore/Is/SylI.pl         Unicode character database
-lib/unicore/Is/SylII.pl                Unicode character database
-lib/unicore/Is/Syllable.pl     Unicode character database
-lib/unicore/Is/SylN.pl         Unicode character database
-lib/unicore/Is/SylO.pl         Unicode character database
-lib/unicore/Is/SylOO.pl                Unicode character database
-lib/unicore/Is/SylU.pl         Unicode character database
-lib/unicore/Is/SylV.pl         Unicode character database
-lib/unicore/Is/SylWA.pl                Unicode character database
-lib/unicore/Is/SylWAA.pl       Unicode character database
-lib/unicore/Is/SylWC.pl                Unicode character database
-lib/unicore/Is/SylWE.pl                Unicode character database
-lib/unicore/Is/SylWEE.pl       Unicode character database
-lib/unicore/Is/SylWI.pl                Unicode character database
-lib/unicore/Is/SylWII.pl       Unicode character database
-lib/unicore/Is/SylWO.pl                Unicode character database
-lib/unicore/Is/SylWOO.pl       Unicode character database
-lib/unicore/Is/SylWU.pl                Unicode character database
-lib/unicore/Is/SylWV.pl                Unicode character database
+lib/unicore/Is/Title.pl                Unicode character database
 lib/unicore/Is/Upper.pl                Unicode character database
 lib/unicore/Is/Word.pl         Unicode character database
 lib/unicore/Is/XDigit.pl       Unicode character database
@@ -1580,9 +1569,10 @@ lib/unicore/Is/Zp.pl             Unicode character database
 lib/unicore/Is/Zs.pl           Unicode character database
 lib/unicore/Jamo.txt           Unicode character database
 lib/unicore/JamoShort.pl       Unicode character database
+lib/unicore/Lbrk.pl            Unicode character database
 lib/unicore/LineBrk.txt                Unicode character database
 lib/unicore/Makefile           Unicode character database
-lib/unicore/mktables.PL                Unicode character database generator
+lib/unicore/mktables           Unicode character database generator
 lib/unicore/Name.pl            Unicode character database
 lib/unicore/NamesList.html     Unicode character database
 lib/unicore/NamesList.txt      Unicode character database
@@ -1595,7 +1585,6 @@ lib/unicore/rename                Filename mappings used
 lib/unicore/Scripts.pl         Unicode character database
 lib/unicore/Scripts.txt                Unicode character database
 lib/unicore/SpecCase.txt       Unicode character database
-lib/unicore/syllables.txt      Unicode character database
 lib/unicore/To/Digit.pl                Unicode character database
 lib/unicore/To/Lower.pl                Unicode character database
 lib/unicore/To/Title.pl                Unicode character database
index acaaeae..ea09a29 100644 (file)
@@ -2709,27 +2709,26 @@ $ ENDIF
 $!
 $! PerlIO abstraction
 $!
-$ dflt = "n"
+$ dflt = "y"
 $ IF F$TYPE(useperlio) .NES. ""
 $ THEN
-$   IF useperlio THEN dflt = "y"
-$   IF useperlio .EQS. "define" THEN dflt = "y"
+$   IF useperlio .EQS. "undef" THEN dflt = "n"
 $ ENDIF
 $ IF .NOT. silent
 $ THEN
-$   echo "Previous version of ''package' used the standard IO mechanisms as"
+$   echo "Previous versions of ''package' used the standard IO mechanisms as"
 $   TYPE SYS$INPUT:
 $   DECK
 defined in <stdio.h>.  Versions 5.003_02 and later of perl allow
 alternate IO mechanisms via the PerlIO abstraction layer, but the
-stdio mechanism is still the default.  This abstraction layer can
-use AT&T's sfio (if you already have sfio installed) or regular stdio.
+stdio mechanism is still available if needed.  The abstraction layer
+can use AT&T's sfio (if you already have sfio installed) or regular stdio.
 Using PerlIO with sfio may cause problems with some extension modules.
 
 $   EOD
 $   echo "If this does not make any sense to you, just accept the default '" + dflt + "'."
 $ ENDIF
-$ rp = "Use the experimental PerlIO abstraction layer? [''dflt'] "
+$ rp = "Use the PerlIO abstraction layer? [''dflt'] "
 $ GOSUB myread
 $ IF ans .EQS. "" THEN ans = dflt
 $ IF ans
index d2dc572..db4382b 100644 (file)
@@ -1253,7 +1253,7 @@ SV *   sv ;
 
            svp = hv_fetch(action, "flags", 5, FALSE);
           if (svp)
-              (void)dbp->set_flags(dbp, SvIV(*svp)) ;
+              (void)dbp->set_flags(dbp, (u_int32_t)SvIV(*svp)) ;
    
            svp = hv_fetch(action, "cachesize", 9, FALSE);
           if (svp)
index 1b6aeca..d89bf96 100644 (file)
@@ -510,7 +510,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                    }
                    sortsv(AvARRAY(keys), 
                           av_len(keys)+1, 
-                          Perl_sv_cmp_locale);
+                          IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
                }
                else {
                    dSP; ENTER; SAVETMPS; PUSHMARK(sp);
index 1045db6..55a4d3b 100644 (file)
@@ -7,8 +7,9 @@ BEGIN {
 
 BEGIN{
        # Don't do anything if POSIX is missing, or sigaction missing.
+       use Config;
        eval { use POSIX; };
-       if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') {
+       if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) {
                print "1..0\n";
                exit 0;
        }
index d3e9c8a..72a4872 100755 (executable)
@@ -9,8 +9,8 @@
 #include <windows.h>
 #include <win32thread.h>
 #define PERL_THREAD_DETACH(t) 
-#define PERL_THREAD_SET_SPECIFIC(k,v) TlsSetValue(k,v)
-#define PERL_THREAD_GET_SPECIFIC(k)   TlsGetValue(k)
+#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
+#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
 #define PERL_THREAD_ALLOC_SPECIFIC(k) \
 STMT_START {\
   if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
@@ -22,18 +22,25 @@ STMT_START {\
 #include <pthread.h>
 #include <thread.h>
 
-#define PERL_THREAD_SET_SPECIFIC(k,v) pthread_setspecific(k,v)
-#define PERL_THREAD_GET_SPECIFIC(k)   pthread_getspecific(k)
+#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
+#ifdef OLD_PTHREADS_API
+#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
+#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
 #define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
-  if(pthread_key_create(&(k),0)) {\
+  if(pthread_keycreate(&(k),0)) {\
     PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
     exit(1);\
   }\
 } STMT_END
-#ifdef OLD_PTHREADS_API
-#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
 #else
 #define PERL_THREAD_DETACH(t) pthread_detach((t))
+#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
+  if(pthread_key_create(&(k),0)) {\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
+    exit(1);\
+  }\
+} STMT_END
 #endif
 #endif
 
index 0d00c81..cce263a 100755 (executable)
@@ -24,8 +24,8 @@ void* Perl_thread_run(void * arg) {
        SHAREDSvLOCK(threads);
        SHAREDSvEDIT(threads);
        PERL_THREAD_ALLOC_SPECIFIC(self_key);
-       PERL_THREAD_SET_SPECIFIC(self_key,INT2PTR(void*,thread->tid));
-       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));   
+       PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
+       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);  
        thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
        hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
        SvREFCNT_dec(thread_tid_ptr);
@@ -156,11 +156,29 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 
 
 #else
+       {
+         static pthread_attr_t attr;
+         static int attr_inited = 0;
+         sigset_t fullmask, oldmask;
+         static int attr_joinable = PTHREAD_CREATE_JOINABLE;
+         if (!attr_inited) {
+           attr_inited = 1;
+           pthread_attr_init(&attr);
+         }
+#  ifdef PTHREAD_ATTR_SETDETACHSTATE
+            PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
+#  endif
+#  ifdef THREAD_CREATE_NEEDS_STACK
+           if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
+             croak("panic: pthread_attr_setstacksize failed");
+#  endif
+
 #ifdef OLD_PTHREADS_API
-       pthread_create( &thread->thr, (pthread_attr_t)NULL, Perl_thread_run, (void *)thread);
+         pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
 #else
-       pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, (void *)thread);
+         pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread);
 #endif
+       }
 #endif
        MUTEX_UNLOCK(&create_mutex);    
 
@@ -189,11 +207,12 @@ SV* Perl_thread_self (char* class) {
        SV*     thread_tid_ptr;
        SV*     thread_ptr;
        HE*     thread_entry;
-       
+       void*   id;
+       PERL_THREAD_GETSPECIFIC(self_key,id);
        SHAREDSvLOCK(threads);
        SHAREDSvEDIT(threads);
-
-       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));   
+       
+       thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));   
 
        thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
                                         (HV*) SHAREDSvGET(threads),
@@ -285,8 +304,8 @@ BOOT:
 #endif
                SHAREDSvEDIT(threads);
                PERL_THREAD_ALLOC_SPECIFIC(self_key);
-               PERL_THREAD_SET_SPECIFIC(self_key,0);
-               thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));
+               PERL_THREAD_SETSPECIFIC(self_key,0);
+               thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
                thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
                hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
                SvREFCNT_dec(thread_tid_ptr);
index 9f09aac..e6c6766 100644 (file)
@@ -272,30 +272,30 @@ sub c_o {
         $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/;
         push @m, '
 .c.i:
-       '. $cpp_cmd . ' $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c > $*.i
+       '. $cpp_cmd . ' $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.c > $*.i
 ';
     }
     push @m, '
 .c.s:
-       $(CCCMD) -S $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+       $(CCCMD) -S $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.c
 ';
     push @m, '
 .c$(OBJ_EXT):
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.c
 ';
     push @m, '
 .C$(OBJ_EXT):
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.C
 ' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific
     push @m, '
 .cpp$(OBJ_EXT):
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.cpp
 
 .cxx$(OBJ_EXT):
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.cxx
 
 .cc$(OBJ_EXT):
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.cc
 ';
     join "", @m;
 }
@@ -478,7 +478,8 @@ sub const_cccmd {
     return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
     return '' unless $self->needs_linking();
     return $self->{CONST_CCCMD} =
-       q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\
+       q{CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \\
+       $(CCFLAGS) $(OPTIMIZE) \\
        $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\
        $(XS_DEFINE_VERSION)};
 }
@@ -2783,7 +2784,7 @@ sub parse_version {
     my $inpod = 0;
     while (<FH>) {
        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
-       next if $inpod;
+       next if $inpod || /^\s*#/;
        chop;
        # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
        next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
@@ -2848,10 +2849,14 @@ sub pasthru {
     my($sep) = $Is_VMS ? ',' : '';
     $sep .= "\\\n\t";
 
-    foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE INC DEFINE)) {
+    foreach $key (qw(LIB LIBPERL_A LINKTYPE PREFIX OPTIMIZE)) {
        push @pasthru, "$key=\"\$($key)\"";
     }
 
+    foreach $key (qw(DEFINE INC)) {
+       push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\"";
+    }
+
     push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n";
     join "", @m;
 }
@@ -3826,7 +3831,7 @@ sub xs_o {        # many makes are too dumb to use xs_c then c_o
     '
 .xs$(OBJ_EXT):
        $(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
-       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(PASTHRU_DEFINE) $(DEFINE) $*.c
 ';
 }
 
index afb7635..be184a6 100644 (file)
@@ -128,8 +128,7 @@ sub copy {
        $size = shift(@_) + 0;
        croak("Bad buffer size for copy: $size\n") unless ($size > 0);
     } else {
-       no warnings 'uninitialized';
-       $size = -s $from_h;
+       $size = tied(*$from_h) ? 0 : -s $from_h || 0;
        $size = 1024 if ($size < 512);
        $size = $Too_Big if ($size > $Too_Big);
     }
index 5ec3dd7..682d233 100644 (file)
@@ -171,28 +171,26 @@ sub my_postprocess {
 # $File::Find::dir (%Expect_Dir). Also use it in file operations like
 # chdir, rmdir etc.
 #
-# dir_path() concatenates directory names to form a _relative_
+# dir_path() concatenates directory names to form a *relative*
 # directory path, independent from the platform it's run on, although
-# there are limitations.  Don't try to create an absolute path,
+# there are limitations. Don't try to create an absolute path,
 # because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
+# volume names (e.g. Mac OS). As a special case, you can pass it a "." 
+# as first argument, to create a directory path like "./fa/dir" on
 # operating systems other than Mac OS (actually, Mac OS will ignore
 # the ".", if it's the first argument). If there's no second argument,
 # this function will return the empty string on Mac OS and the string
 # "./" otherwise.
 
 sub dir_path {
-    my $first_item = shift @_;
+    my $first_arg = shift @_;
 
-    if ($first_item eq '.') {
+    if ($first_arg eq '.') {
         if ($^O eq 'MacOS') {
             return '' unless @_;
             # ignore first argument; return a relative path
             # with leading ":" and with trailing ":"
-            return File::Spec->catdir("", @_); 
+            return File::Spec->catdir(@_); 
         } else { # other OS
             return './' unless @_;
             my $path = File::Spec->catdir(@_);
@@ -201,21 +199,16 @@ sub dir_path {
             return $path;
         }
 
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":" and with trailing ":"
-            return File::Spec->catdir("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catdir($first_item, @_);
-        }
+    } else { # $first_arg ne '.'
+        return $first_arg unless @_; # return plain filename
+        return File::Spec->catdir($first_arg, @_); # relative path
     }
 }
 
 
 # Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
+# find/finddepth. Basically, topdir() does the same as dir_path() (see
+# above), except that there's no trailing ":" on Mac OS.
 
 sub topdir {
     my $path = dir_path(@_);
@@ -225,27 +218,27 @@ sub topdir {
 
 
 # Use file_path() to specify a file path that's expected for $_
-# (%Expect_File).  Also suitable for file operations like unlink etc.
+# (%Expect_File). Also suitable for file operations like unlink etc.
 #
 # file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
+# form a *relative* file path (the last argument is assumed to be a
 # file). It's independent from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
+# there are limitations. As a special case, you can pass it a "." as 
+# first argument, to create a file path like "./fa/file" on operating 
+# systems other than Mac OS (actually, Mac OS will ignore the ".", if 
+# it's the first argument). If there's no second argument, this 
+# function will return the empty string on Mac OS and the string "./" 
+# otherwise.
 
 sub file_path {
-    my $first_item = shift @_;
+    my $first_arg = shift @_;
 
-    if ($first_item eq '.') {
+    if ($first_arg eq '.') {
         if ($^O eq 'MacOS') {
             return '' unless @_;
             # ignore first argument; return a relative path  
             # with leading ":", but without trailing ":"
-            return File::Spec->catfile("", @_); 
+            return File::Spec->catfile(@_); 
         } else { # other OS
             return './' unless @_;
             my $path = File::Spec->catfile(@_);
@@ -254,14 +247,9 @@ sub file_path {
             return $path;
         }
 
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":", but without trailing ":"
-            return File::Spec->catfile("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catfile($first_item, @_);
-        }
+    } else { # $first_arg ne '.'
+        return $first_arg unless @_; # return plain filename
+        return File::Spec->catfile($first_arg, @_); # relative path
     }
 }
 
index 0915049..7643040 100644 (file)
@@ -127,28 +127,26 @@ sub simple_wanted {
 # $File::Find::dir (%Expect_Dir). Also use it in file operations like
 # chdir, rmdir etc.
 #
-# dir_path() concatenates directory names to form a _relative_
-# directory path, independant from the platform it's run on, although
-# there are limitations.  Don't try to create an absolute path,
+# dir_path() concatenates directory names to form a *relative*
+# directory path, independent from the platform it's run on, although
+# there are limitations. Don't try to create an absolute path,
 # because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
+# volume names (e.g. Mac OS). As a special case, you can pass it a "." 
+# as first argument, to create a directory path like "./fa/dir" on
 # operating systems other than Mac OS (actually, Mac OS will ignore
 # the ".", if it's the first argument). If there's no second argument,
 # this function will return the empty string on Mac OS and the string
 # "./" otherwise.
 
 sub dir_path {
-    my $first_item = shift @_;
+    my $first_arg = shift @_;
 
-    if ($first_item eq '.') {
+    if ($first_arg eq '.') {
         if ($^O eq 'MacOS') {
             return '' unless @_;
             # ignore first argument; return a relative path
             # with leading ":" and with trailing ":"
-            return File::Spec->catdir("", @_); 
+            return File::Spec->catdir(@_); 
         } else { # other OS
             return './' unless @_;
             my $path = File::Spec->catdir(@_);
@@ -157,21 +155,16 @@ sub dir_path {
             return $path;
         }
 
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":" and with trailing ":"
-            return File::Spec->catdir("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catdir($first_item, @_);
-        }
+    } else { # $first_arg ne '.'
+        return $first_arg unless @_; # return plain filename
+        return File::Spec->catdir($first_arg, @_); # relative path
     }
 }
 
 
 # Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
+# find/finddepth. Basically, topdir() does the same as dir_path() (see
+# above), except that there's no trailing ":" on Mac OS.
 
 sub topdir {
     my $path = dir_path(@_);
@@ -180,28 +173,28 @@ sub topdir {
 }
 
 
-# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
-# Also suitable for file operations like unlink etc.
-
+# Use file_path() to specify a file path that's expected for $_
+# (%Expect_File). Also suitable for file operations like unlink etc.
+#
 # file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
-# file). It's independant from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
+# form a *relative* file path (the last argument is assumed to be a
+# file). It's independent from the platform it's run on, although
+# there are limitations. As a special case, you can pass it a "." as 
+# first argument, to create a file path like "./fa/file" on operating 
+# systems other than Mac OS (actually, Mac OS will ignore the ".", if 
+# it's the first argument). If there's no second argument, this 
+# function will return the empty string on Mac OS and the string "./" 
+# otherwise.
 
 sub file_path {
-    my $first_item = shift @_;
+    my $first_arg = shift @_;
 
-    if ($first_item eq '.') {
+    if ($first_arg eq '.') {
         if ($^O eq 'MacOS') {
             return '' unless @_;
             # ignore first argument; return a relative path  
             # with leading ":", but without trailing ":"
-            return File::Spec->catfile("", @_); 
+            return File::Spec->catfile(@_); 
         } else { # other OS
             return './' unless @_;
             my $path = File::Spec->catfile(@_);
@@ -210,14 +203,9 @@ sub file_path {
             return $path;
         }
 
-    } else { # $first_item ne '.'
-        return $first_item unless @_; # return plain filename
-        if ($^O eq 'MacOS') {
-            # relative path with leading ":", but without trailing ":"
-            return File::Spec->catfile("", $first_item, @_);
-        } else { # other OS
-            return File::Spec->catfile($first_item, @_);
-        }
+    } else { # $first_arg ne '.'
+        return $first_arg unless @_; # return plain filename
+        return File::Spec->catfile($first_arg, @_); # relative path
     }
 }
 
index 023005f..0f90a45 100644 (file)
@@ -59,7 +59,7 @@ File::Spec. Since some modules (like VMS) make use of facilities available
 only under that OS, it may not be possible to load all modules under all
 operating systems.
 
-Since File::Spec is object oriented, subroutines should not called directly,
+Since File::Spec is object oriented, subroutines should not be called directly,
 as in:
 
        File::Spec::catfile('a','b');
@@ -75,14 +75,14 @@ forms of these methods.
 
 =over 2
 
-=item canonpath
+=item canonpath()
 
 No physical check on the filesystem, but a logical cleanup of a
 path.
 
     $cpath = File::Spec->canonpath( $path ) ;
 
-=item catdir
+=item catdir()
 
 Concatenate two or more directory names to form a complete path ending
 with a directory. But remove the trailing slash from the resulting
@@ -153,10 +153,9 @@ Takes as argument a path and returns true if it is an absolute path.
 
     $is_absolute = File::Spec->file_name_is_absolute( $path );
 
-This does not consult the local filesystem on Unix, Win32, or OS/2.  It
-does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
-It does consult the working environment for VMS (see
-L<File::Spec::VMS/file_name_is_absolute>).
+This does not consult the local filesystem on Unix, Win32, OS/2, or
+Mac OS (Classic).  It does consult the working environment for VMS
+(see L<File::Spec::VMS/file_name_is_absolute>).
 
 =item path
 
@@ -198,9 +197,9 @@ files from directories.
 
 Unlike just splitting the directories on the separator, empty
 directory names (C<''>) can be returned, because these are significant
-on some OSs (e.g. MacOS).
+on some OSs.
 
-=item catpath
+=item catpath()
 
 Takes volume, directory and file portions and returns an entire path. Under
 Unix, $volume is ignored, and directory and file are catenated.  A '/' is
@@ -216,9 +215,9 @@ from the base path to the destination path:
     $rel_path = File::Spec->abs2rel( $path ) ;
     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 
-If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 On systems with the concept of a volume, this assumes that both paths 
 are on the $destination volume, and ignores the $base volume. 
@@ -228,26 +227,24 @@ $base filename as well. Otherwise all path components are assumed to be
 directories.
 
 If $path is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L<cwd()>.
+This means that it is taken to be relative to L<cwd()|Cwd>.
 
-No checks against the filesystem are made on most systems.  On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+No checks against the filesystem are made.  On VMS, there is
 interaction with the working environment, as logicals and
 macros are expanded.
 
 Based on code written by Shigio Yamaguchi.
 
-=item rel2abs
+=item rel2abs()
 
 Converts a relative path to an absolute path. 
 
     $abs_path = File::Spec->rel2abs( $path ) ;
     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 
-If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 On systems with the concept of a volume, this assumes that both paths 
 are on the $base volume, and ignores the $path volume. 
@@ -258,9 +255,7 @@ directories.
 
 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 
-No checks against the filesystem are made on most systems.  On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+No checks against the filesystem are made.  On VMS, there is
 interaction with the working environment, as logicals and
 macros are expanded.
 
@@ -282,10 +277,11 @@ L<ExtUtils::MakeMaker>
 
 Kenneth Albanowski <kjahds@kjahds.com>, Andy Dougherty
 <doughera@lafcol.lafayette.edu>, Andreas KE<ouml>nig
-<A.Koenig@franz.ww.TU-Berlin.DE>, Tim Bunce <Tim.Bunce@ig.co.uk. VMS
-support by Charles Bailey <bailey@newman.upenn.edu>.  OS/2 support by
-Ilya Zakharevich <ilya@math.ohio-state.edu>. Mac support by Paul Schinder
-<schinder@pobox.com>.  abs2rel() and rel2abs() written by
-Shigio Yamaguchi <shigio@tamacom.com>, modified by Barrie Slaymaker
-<barries@slaysys.com>.  splitpath(), splitdir(), catpath() and catdir()
-by Barrie Slaymaker.
+<A.Koenig@franz.ww.TU-Berlin.DE>, Tim Bunce <Tim.Bunce@ig.co.uk.
+VMS support by Charles Bailey <bailey@newman.upenn.edu>.
+OS/2 support by Ilya Zakharevich <ilya@math.ohio-state.edu>.
+Mac support by Paul Schinder <schinder@pobox.com>, and Thomas Wegner
+<wegner_thomas@yahoo.com>.  abs2rel() and rel2abs() written by Shigio
+Yamaguchi <shigio@tamacom.com>, modified by Barrie Slaymaker
+<barries@slaysys.com>.  splitpath(), splitdir(), catpath() and
+catdir() by Barrie Slaymaker.
index 698ea01..9baa5a6 100755 (executable)
@@ -1,17 +1,52 @@
 #!./perl
 
 BEGIN {
-    $^O = '';
     chdir 't' if -d 't';
     @INC = '../lib';
 }
+# Grab all of the plain routines from File::Spec
+use File::Spec @File::Spec::EXPORT_OK ;
+
+require File::Spec::Unix ;
+require File::Spec::Win32 ;
+
+eval {
+   require VMS::Filespec ;
+} ;
+
+my $skip_exception = "Install VMS::Filespec (from vms/ext)" ;
+
+if ( $@ ) {
+   # Not pretty, but it allows testing of things not implemented soley
+   # on VMS.  It might be better to change File::Spec::VMS to do this,
+   # making it more usable when running on (say) Unix but working with
+   # VMS paths.
+   eval qq-
+      sub File::Spec::VMS::vmsify  { die "$skip_exception" }
+      sub File::Spec::VMS::unixify { die "$skip_exception" }
+      sub File::Spec::VMS::vmspath { die "$skip_exception" }
+   - ;
+   $INC{"VMS/Filespec.pm"} = 1 ;
+}
+require File::Spec::VMS ;
+
+require File::Spec::OS2 ;
+require File::Spec::Mac ;
+
+# $root is only needed by Mac OS tests; these particular
+# tests are skipped on other OSs
+my $root;
+if  ($^O eq 'MacOS') {
+       $root = File::Spec::Mac->rootdir();
+}
 
 # Each element in this array is a single test. Storing them this way makes
 # maintenance easy, and should be OK since perl should be pretty functional
 # before these tests are run.
 
 @tests = (
-# Function                      Expected
+# [ Function          ,            Expected          ,         Platform ]
+
 [ "Unix->catfile('a','b','c')", 'a/b/c'  ],
 
 [ "Unix->splitpath('file')",            ',,file'            ],
@@ -313,93 +348,99 @@ BEGIN {
 [ "Mac->splitpath('hd::d1:d2:file')", 'hd:,::d1:d2:,file' ], # invalid path
 [ "Mac->splitpath('hd:file')",        'hd:,,file'         ],
 
+[ "Mac->splitdir()",                   ''            ],
 [ "Mac->splitdir('')",                 ''            ],
 [ "Mac->splitdir(':')",                ':'           ],
 [ "Mac->splitdir('::')",               '::'          ],
-[ "Mac->splitdir(':::')",              ':::'         ],
-[ "Mac->splitdir(':::d1:d2')",         ',,,d1,d2'    ],
-
-[ "Mac->splitdir(':d1:d2:d3::')",      ',d1,d2,d3,'  ],
-[ "Mac->splitdir(':d1:d2:d3:')",       ',d1,d2,d3'   ],
-[ "Mac->splitdir(':d1:d2:d3')",        ',d1,d2,d3'   ],
-
-[ "Mac->splitdir('hd:d1:d2:::')",      'hd,d1,d2,,'  ],
-[ "Mac->splitdir('hd:d1:d2::')",       'hd,d1,d2,'   ],
-[ "Mac->splitdir('hd:d1:d2:')",        'hd,d1,d2'    ],
-[ "Mac->splitdir('hd:d1:d2')",         'hd,d1,d2'    ],
-[ "Mac->splitdir('hd:d1::d2::')",      'hd,d1,,d2,'  ],
-
-[ "Mac->catdir()",                 ''            ],
-[ "Mac->catdir('')",               ':'           ],
-[ "Mac->catdir(':')",              ':'           ],
-
-[ "Mac->catdir('', '')",           '::'          ], # Hmm... ":" ? 
-[ "Mac->catdir('', ':')",          '::'          ], # Hmm... ":" ? 
-[ "Mac->catdir(':', ':')",         '::'          ], # Hmm... ":" ? 
-[ "Mac->catdir(':', '')",          '::'          ], # Hmm... ":" ? 
-
-[ "Mac->catdir('', '::')",         '::'          ],
-[ "Mac->catdir(':', '::')",        '::'          ], # but catdir('::', ':') is ':::'
-
-[ "Mac->catdir('::', '')",         ':::'         ], # Hmm... "::" ? 
-[ "Mac->catdir('::', ':')",        ':::'         ], # Hmm... "::" ? 
+[ "Mac->splitdir(':::')",              '::,::'       ],
+[ "Mac->splitdir(':::d1:d2')",         '::,::,d1,d2' ],
+
+[ "Mac->splitdir(':d1:d2:d3::')",      'd1,d2,d3,::'],
+[ "Mac->splitdir(':d1:d2:d3:')",       'd1,d2,d3'   ],
+[ "Mac->splitdir(':d1:d2:d3')",        'd1,d2,d3'   ],
+
+# absolute paths in splitdir() work, but you'd better use splitpath()
+[ "Mac->splitdir('hd:')",              'hd:'              ],
+[ "Mac->splitdir('hd::')",             'hd:,::'           ], # invalid path, but it works
+[ "Mac->splitdir('hd::d1:')",          'hd:,::,d1'        ], # invalid path, but it works
+[ "Mac->splitdir('hd:d1:d2:::')",      'hd:,d1,d2,::,::'  ],
+[ "Mac->splitdir('hd:d1:d2::')",       'hd:,d1,d2,::'     ],
+[ "Mac->splitdir('hd:d1:d2:')",        'hd:,d1,d2'        ],
+[ "Mac->splitdir('hd:d1:d2')",         'hd:,d1,d2'        ],
+[ "Mac->splitdir('hd:d1::d2::')",      'hd:,d1,::,d2,::'  ],
+
+[ "Mac->catdir()",                 ''             ],
+[ "Mac->catdir('')",               $root, 'MacOS' ], # skipped on other OS
+[ "Mac->catdir(':')",              ':'            ],
+
+[ "Mac->catdir('', '')",           $root, 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('', ':')",          $root, 'MacOS' ], # skipped on other OS 
+[ "Mac->catdir(':', ':')",         ':'            ],  
+[ "Mac->catdir(':', '')",          ':'            ], 
+
+[ "Mac->catdir('', '::')",         $root, 'MacOS' ], # skipped on other OS
+[ "Mac->catdir(':', '::')",        '::'           ], 
+
+[ "Mac->catdir('::', '')",         '::'           ],  
+[ "Mac->catdir('::', ':')",        '::'           ], 
+
+[ "Mac->catdir('::', '::')",       ':::'          ], 
+
+[ "Mac->catdir(':d1')",                    ':d1:'        ],
+[ "Mac->catdir(':d1:')",                   ':d1:'        ],
+[ "Mac->catdir(':d1','d2')",               ':d1:d2:'     ],
+[ "Mac->catdir(':d1',':d2')",              ':d1:d2:'     ],
+[ "Mac->catdir(':d1',':d2:')",             ':d1:d2:'     ],
+[ "Mac->catdir(':d1',':d2::')",            ':d1:d2::'     ],
+[ "Mac->catdir(':',':d1',':d2')",          ':d1:d2:'     ],
+[ "Mac->catdir('::',':d1',':d2')",         '::d1:d2:'    ],
+[ "Mac->catdir('::','::',':d1',':d2')",    ':::d1:d2:'   ],
+[ "Mac->catdir(':',':',':d1',':d2')",      ':d1:d2:'     ],
+[ "Mac->catdir('::',':',':d1',':d2')",     '::d1:d2:'    ],
+
+[ "Mac->catdir('d1')",                    ':d1:'         ],
+[ "Mac->catdir('d1','d2','d3')",          ':d1:d2:d3:'   ],
+[ "Mac->catdir('d1','d2/','d3')",         ':d1:d2/:d3:'  ],
+[ "Mac->catdir('d1','',':d2')",           ':d1:d2:'      ],
+[ "Mac->catdir('d1',':',':d2')",          ':d1:d2:'      ],
+[ "Mac->catdir('d1','::',':d2')",         ':d1::d2:'     ],
+[ "Mac->catdir('d1',':::',':d2')",        ':d1:::d2:'    ],
+[ "Mac->catdir('d1','::','::',':d2')",    ':d1:::d2:'    ],
+[ "Mac->catdir('d1','d2')",               ':d1:d2:'      ],
+[ "Mac->catdir('d1','d2', '')",           ':d1:d2:'      ],
+[ "Mac->catdir('d1','d2', ':')",          ':d1:d2:'      ],
+[ "Mac->catdir('d1','d2', '::')",         ':d1:d2::'     ],
+[ "Mac->catdir('d1','d2','','')",         ':d1:d2:'      ],
+[ "Mac->catdir('d1','d2',':','::')",      ':d1:d2::'     ],
+[ "Mac->catdir('d1','d2','::','::')",     ':d1:d2:::'    ],
+[ "Mac->catdir('d1',':d2')",              ':d1:d2:'      ],
+[ "Mac->catdir('d1',':d2:')",             ':d1:d2:'      ],
+
+[ "Mac->catdir('','d1','d2','d3')",        $root . 'd1:d2:d3:', 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('',':','d1','d2')",         $root . 'd1:d2:'   , 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('','::','d1','d2')",        $root . 'd1:d2:'   , 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('',':','','d1')",           $root . 'd1:'      , 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('', ':d1',':d2')",          $root . 'd1:d2:'   , 'MacOS' ], # skipped on other OS
+[ "Mac->catdir('','',':d1',':d2')",        $root . 'd1:d2:'   , 'MacOS' ], # skipped on other OS
 
-[ "Mac->catdir('::', '::')",       ':::'         ], # ok
-
-#
-# Unix counterparts:
-#
-
-# Unix catdir('.') =        "."
-
-# Unix catdir('','') =      "/"
-# Unix catdir('','.') =     "/"
-# Unix catdir('.','.') =    "."
-# Unix catdir('.','') =     "."
-
-# Unix catdir('','..') =    "/"
-# Unix catdir('.','..') =   ".."
-
-# Unix catdir('..','') =    ".."
-# Unix catdir('..','.') =   ".."
-# Unix catdir('..','..') =  "../.."
-
-[ "Mac->catdir(':d1','d2')",        ':d1:d2:'     ],
-[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:'  ],
-[ "Mac->catdir('','','d2','d3')",   '::d2:d3:'    ],
-[ "Mac->catdir('','','','d3')",     ':::d3:'      ],
-[ "Mac->catdir(':d1')",             ':d1:'        ],
-[ "Mac->catdir(':d1',':d2')",       ':d1:d2:'     ],
-[ "Mac->catdir('', ':d1',':d2')",   ':d1:d2:'     ],
-[ "Mac->catdir('','',':d1',':d2')", '::d1:d2:'    ],
-
-[ "Mac->catdir('hd')",              'hd:'         ],
-[ "Mac->catdir('hd','d1','d2')",    'hd:d1:d2:'   ],
-[ "Mac->catdir('hd','d1/','d2')",   'hd:d1/:d2:'  ],
-[ "Mac->catdir('hd','',':d1')",     'hd::d1:'     ],
-[ "Mac->catdir('hd','d1')",         'hd:d1:'      ],
-[ "Mac->catdir('hd','d1', '')",     'hd:d1::'     ],
-[ "Mac->catdir('hd','d1','','')",   'hd:d1:::'    ],
 [ "Mac->catdir('hd:',':d1')",       'hd:d1:'      ],
 [ "Mac->catdir('hd:d1:',':d2')",    'hd:d1:d2:'   ],
 [ "Mac->catdir('hd:','d1')",        'hd:d1:'      ],
-[ "Mac->catdir('hd',':d1')",        'hd:d1:'      ],
 [ "Mac->catdir('hd:d1:',':d2')",    'hd:d1:d2:'   ],
 [ "Mac->catdir('hd:d1:',':d2:')",   'hd:d1:d2:'   ],
 
+[ "Mac->catfile()",                      ''                      ], 
+[ "Mac->catfile('')",                    ''                      ],
+[ "Mac->catfile('', '')",                $root         , 'MacOS' ], # skipped on other OS 
+[ "Mac->catfile('', 'file')",            $root . 'file', 'MacOS' ], # skipped on other OS
+[ "Mac->catfile(':')",                   ':'                     ],
+[ "Mac->catfile(':', '')",               ':'                     ],
 
-[ "Mac->catfile()",                      ''            ], 
-[ "Mac->catfile('')",                    ''            ],
-[ "Mac->catfile(':')",                   ':'           ],
-[ "Mac->catfile(':', '')",               ':'           ],
-
-[ "Mac->catfile('hd','d1','file')",      'hd:d1:file'  ],
-[ "Mac->catfile('hd','d1',':file')",     'hd:d1:file'  ],
+[ "Mac->catfile('d1','d2','file')",      ':d1:d2:file' ],
+[ "Mac->catfile('d1','d2',':file')",     ':d1:d2:file' ],
 [ "Mac->catfile('file')",                'file'        ], 
 [ "Mac->catfile(':', 'file')",           ':file'       ], 
-[ "Mac->catfile('', 'file')",            ':file'       ], 
-
-
 [ "Mac->canonpath('')",                   ''     ],
 [ "Mac->canonpath(':')",                  ':'    ],
 [ "Mac->canonpath('::')",                 '::'   ],
@@ -419,7 +460,7 @@ BEGIN {
 [ "Mac->abs2rel('hd:d3:','hd:d1:d2:')",               ':::d3:'       ], # same as above
 [ "Mac->abs2rel('hd:d1:d2:d3:','hd:d1:d2:')",         ':d3:'         ],
 [ "Mac->abs2rel('hd:d1:d2:d3::','hd:d1:d2:')",        ':d3::'        ],
-[ "Mac->abs2rel('v1:d3:d4:d5:','v2:d1:d2:')",         ':::d3:d4:d5:' ], # ignore base's volume
+[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')",       ':::d3:d4:d5:' ], # ignore base's volume
 [ "Mac->abs2rel('hd:','hd:d1:d2:')",                  ':::'          ],
 
 [ "Mac->rel2abs(':d3:','hd:d1:d2:')",          'hd:d1:d2:d3:'     ], 
@@ -435,34 +476,6 @@ BEGIN {
 [ "Mac->rel2abs('hd:d3:','hd:d1:file')",       'hd:d3:'           ],
 ) ;
 
-# Grab all of the plain routines from File::Spec
-use File::Spec @File::Spec::EXPORT_OK ;
-
-require File::Spec::Unix ;
-require File::Spec::Win32 ;
-
-eval {
-   require VMS::Filespec ;
-} ;
-
-my $skip_exception = "Install VMS::Filespec (from vms/ext)" ;
-
-if ( $@ ) {
-   # Not pretty, but it allows testing of things not implemented soley
-   # on VMS.  It might be better to change File::Spec::VMS to do this,
-   # making it more usable when running on (say) Unix but working with
-   # VMS paths.
-   eval qq-
-      sub File::Spec::VMS::vmsify  { die "$skip_exception" }
-      sub File::Spec::VMS::unixify { die "$skip_exception" }
-      sub File::Spec::VMS::vmspath { die "$skip_exception" }
-   - ;
-   $INC{"VMS/Filespec.pm"} = 1 ;
-}
-require File::Spec::VMS ;
-
-require File::Spec::OS2 ;
-require File::Spec::Mac ;
 
 print "1..", scalar( @tests ), "\n" ;
 
@@ -474,7 +487,6 @@ for ( @tests ) {
 }
 
 
-
 #
 # Tries a named function with the given args and compares the result against
 # an expected result. Works with functions that return scalars or arrays.
index 23c99fb..036bcca 100644 (file)
@@ -67,7 +67,7 @@ sub path {
     return undef;
 }
 
-=item canonpath
+=item canonpath()
 
 No physical check on the filesystem, but a logical cleanup of a
 path. On UNIX eliminated successive slashes and successive "/.".
@@ -134,7 +134,7 @@ sub splitpath {
 
 =item splitdir
 
-The opposite of L</catdir()>.
+The opposite of L<catdir()|File::Spec/catdir()>.
 
     @dirs = File::Spec->splitdir( $directories );
 
@@ -221,9 +221,9 @@ from the base path to the destination path:
     $rel_path = File::Spec->abs2rel( $destination ) ;
     $rel_path = File::Spec->abs2rel( $destination, $base ) ;
 
-If $base is not present or '', then L</cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 On systems with the concept of a volume, this assumes that both paths 
 are on the $destination volume, and ignores the $base volume.
@@ -233,7 +233,7 @@ $base filename as well. Otherwise all path components are assumed to be
 directories.
 
 If $path is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L</cwd()>.
+This means that it is taken to be relative to L<cwd()|Cwd>.
 
 Based on code written by Shigio Yamaguchi.
 
@@ -311,16 +311,16 @@ sub abs2rel {
     ) ;
 }
 
-=item rel2abs
+=item rel2abs()
 
 Converts a relative path to an absolute path. 
 
     $abs_path = File::Spec->rel2abs( $destination ) ;
     $abs_path = File::Spec->rel2abs( $destination, $base ) ;
 
-If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L</cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 Assumes that both paths are on the $base volume, and ignores the 
 $destination volume. 
index 6b62747..bba21ee 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.2';
+$VERSION = '1.3';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -12,7 +12,7 @@ use Cwd;
 
 =head1 NAME
 
-File::Spec::Mac - File::Spec for MacOS
+File::Spec::Mac - File::Spec for Mac OS (Classic)
 
 =head1 SYNOPSIS
 
@@ -28,7 +28,7 @@ Methods for manipulating file specifications.
 
 =item canonpath
 
-On MacOS, there's nothing to be done.  Returns what it's given.
+On Mac OS, there's nothing to be done. Returns what it's given.
 
 =cut
 
@@ -37,12 +37,20 @@ sub canonpath {
     return $path;
 }
 
-=item catdir
+=item catdir()
 
 Concatenate two or more directory names to form a path separated by colons
-(":") ending with a directory.  Automatically puts a trailing ":" on the
-end of the complete path, because that's what's done in MacPerl's
-environment and helps to distinguish a file path from a directory path.
+(":") ending with a directory. Resulting paths are B<relative> by default,
+but can be forced to be absolute (but avoid this, see below). Automatically 
+puts a trailing ":" on the end of the complete path, because that's what's 
+done in MacPerl's environment and helps to distinguish a file path from a 
+directory path.
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting 
+path is relative by default and I<not> absolute. This descision was made due 
+to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths 
+on all other operating systems, it will now also follow this convention on Mac 
+OS. Note that this may break some existing scripts.
 
 The intended purpose of this routine is to concatenate I<directory names>.
 But because of the nature of Macintosh paths, some additional possibilities
@@ -51,100 +59,237 @@ common situations. In other words, you are also allowed to concatenate
 I<paths> instead of directory names (strictly speaking, a string like ":a"
 is a path, but not a name, since it contains a punctuation character ":").
 
-Here are the rules that are used: Each argument has its trailing ":" removed.
-Each argument, except the first, has its leading ":" removed.  They are then
-joined together by a ":" and a trailing ":" is added to the path.
-
 So, beside calls like
 
-    File::Spec->catdir("a") = "a:"
-    File::Spec->catdir("a","b") = "a:b:"
-    File::Spec->catdir("","a","b") = ":a:b:"
-    File::Spec->catdir("a","","b") = "a::b:"
-    File::Spec->catdir("") = ":"
-    File::Spec->catdir("a","b","") = "a:b::"     (!)
-    File::Spec->catdir() = ""                    (special case)
+    catdir("a") = ":a:"
+    catdir("a","b") = ":a:b:"
+    catdir() = ""                    (special case)
 
 calls like the following
 
-    File::Spec->catdir("a:",":b") = "a:b:"
-    File::Spec->catdir("a:b:",":c") = "a:b:c:"
-    File::Spec->catdir("a:","b") = "a:b:"
-    File::Spec->catdir("a",":b") = "a:b:"
-    File::Spec->catdir(":a","b") = ":a:b:"
-    File::Spec->catdir("","",":a",":b") = "::a:b:"
-    File::Spec->catdir("",":a",":b") = ":a:b:" (!)
-    File::Spec->catdir(":") = ":"
+    catdir(":a:") = ":a:"
+    catdir(":a","b") = ":a:b:"
+    catdir(":a:","b") = ":a:b:"
+    catdir(":a:",":b:") = ":a:b:"
+    catdir(":") = ":"
 
 are allowed.
 
-To get a path beginning with a ":" (a relative path), put a "" as the first
-argument. Beginning the first argument with a ":" (e.g. ":a") will also work
-(see the examples).
+Here are the rules that are used in C<catdir()>; note that we try to be as 
+compatible as possible to Unix: 
+
+=over 2
+
+
+=item 1.
+The resulting path is relative by default, i.e. the resulting path will have a 
+leading colon.
+
+
+=item 2.
+A trailing colon is added automatically to the resulting path, to denote a 
+directory.
+
+
+=item 3.
+Generally, each argument has one leading ":" and one trailing ":" removed (if 
+any). They are then joined together by a ":". Special treatment applies for 
+arguments denoting updir paths like "::lib:", see (4), or arguments consisting 
+solely of colons ("colon paths"), see (5).
+
 
-Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
-Does the first argument in
+=item 4.
+When an updir path like ":::lib::" is passed as argument, the number of  
+directories to climb up is handled correctly, not removing leading or trailing
+colons when necessary. E.g.
 
-    File::Spec->catdir("LWP","Protocol");
+    catdir(":::a","::b","c")    = ":::a::b:c:"
+    catdir(":::a::","::b","c")  = ":::a:::b:c:"
 
-denote a volume or a directory, i.e. should the path be relative or absolute?
-There is no way of telling except by checking for the existence of "LWP:" (a
-volume) or ":LWP" (a directory), but those checks aren't made here. Thus, according
-to the above rules, the path "LWP:Protocol:" will be returned, which, considered
-alone, is an absolute path, although the volume "LWP:" may not exist. Hence, don't
-forget to put a ":" in the appropriate place in the path if you want to
-distinguish unambiguously. (Remember that a valid relative path should always begin
-with a ":", unless you are specifying a file or a directory that resides in the
-I<current> directory. In that case, the leading ":" is not mandatory.)
 
-With version 1.2 of File::Spec, there's a new method called C<catpath>, that
-takes volume, directory and file portions and returns an entire path (see below).
-While C<catdir> is still suitable for the concatenation of I<directory names>,
-you should consider using C<catpath> to concatenate I<volume names> and
-I<directory paths>, because it avoids any ambiguities. E.g.
+=item 5.
+Adding a colon ":" or empty string "" to a path at I<any> position doesn't 
+alter the path, i.e. these arguments are ignored. (When a "" is passed as 
+the first argument, it has a special meaning, see (6) ). This way, a colon 
+":" is handled like a "." (curdir) on Unix, while an empty string "" is
+generally ignored (see C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled 
+like a ".." (updir), and a ":::" is handled like a "../.." etc.  E.g.
 
-    $dir      = File::Spec->catdir("LWP","Protocol");
-    $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
+    catdir("a",":",":","b")   = ":a:b:"
+    catdir("a",":","::",":b") = ":a::b:"
+
+
+=item 6.
+If the first argument is an empty string "" or is a volume name, i.e. matches 
+the pattern /^[^:]+:/, the resulting path is B<absolute>. 
+
+=item 7.
+Passing an empty string "" as the first argument to C<catdir()> is like passing 
+C<File::Spec-E<gt>rootdir()> as the first argument, i.e.
+
+    catdir("","a","b")          is the same as
+
+    catdir(rootdir(),"a","b"). 
+
+This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and C<rootdir()> is  
+"/". Note that C<rootdir()> on Mac OS is the startup volume, which is the closest  
+in concept to Unix' "/". This should help to run existing scripts originally written 
+for Unix.
+
+=item 8.
+For absolute paths, some cleanup is done, to ensure that the volume name isn't
+immediately followed by updirs. This is invalid, because this would go beyond 
+"root". Generally, these cases are handled like their Unix counterparts:
+
+ Unix:
+    Unix->catdir("","")                 =  "/"
+    Unix->catdir("",".")                =  "/"
+    Unix->catdir("","..")               =  "/"              # can't go beyond root
+    Unix->catdir("",".","..","..","a")  =  "/a"
+ Mac:
+    Mac->catdir("","")                  =  rootdir()         # (e.g. "HD:")
+    Mac->catdir("",":")                 =  rootdir()
+    Mac->catdir("","::")                =  rootdir()         # can't go beyond root
+    Mac->catdir("",":","::","::","a")   =  rootdir() . "a:"  # (e.g. "HD:a:")
+
+However, this approach is limited to the first arguments following "root" (again, see
+C<Unix-E<gt>canonpath()> ). If there are more arguments that move up the directory  
+tree, an invalid path going beyond root can be created. 
+
+=back
+
+As you've seen, you can force C<catdir()> to create an absolute path by passing either
+an empty string or a path that begins with a volume name as the first argument. However,
+you are strongly encouraged not to do so, since this is done only for backward 
+compatibility. Newer versions of File::Spec come with a method called C<catpath()> (see 
+below), that is designed to offer a portable solution for the creation of absolute paths.
+It takes volume, directory and file portions and returns an entire path. While 
+C<catdir()> is still suitable for the concatenation of I<directory names>, you are 
+encouraged to use C<catpath()> to concatenate I<volume names> and I<directory paths>. E.g.
+
+    $dir      = File::Spec->catdir("tmp","sources");
+    $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
 
 yields
 
-    "MacintoshHD:LWP:Protocol:" .
+    "MacintoshHD:tmp:sources:" .
 
 
 =cut
 
 sub catdir {
-    my $self = shift;
-    return '' unless @_;
+    my $self = shift;  
+       return '' unless @_;    
     my @args = @_;
-    my $result = shift @args;
-    #  To match the actual end of the string,
-    #  not ignoring newline, you can use \Z(?!\n).
-    $result =~ s/:\Z(?!\n)//;
-    foreach (@args) {
-       s/:\Z(?!\n)//;
-       s/^://s;
-       $result .= ":$_";
+    my $first_arg;     
+       my $relative;   
+       
+       # take care of the first argument
+       
+       if ($args[0] eq '')  { # absolute path, rootdir
+               shift @args;
+               $relative = 0;
+               $first_arg = $self->rootdir;
+       
+       } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
+               $relative = 0;
+               $first_arg = shift @args;
+               # add a trailing ':' if need be (may be it's a path like HD:dir)
+               $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+               
+       } else { # relative path
+               $relative = 1;
+               if ( $args[0] =~ /^::+\Z(?!\n)/ ) { 
+                       # updir colon path ('::', ':::' etc.), don't shift
+                       $first_arg = ':';
+               } elsif ($args[0] eq ':') {
+                       $first_arg = shift @args;
+               } else {
+                       # add a trailing ':' if need be
+                       $first_arg = shift @args;
+                       $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+               } 
+       }       
+               
+       # For all other arguments,    
+       # (a) ignore arguments that equal ':' or '',
+       # (b) handle updir paths specially:
+       #     '::'                      -> concatenate '::'
+       #     '::' . '::'       -> concatenate ':::' etc.
+       # (c) add a trailing ':' if need be
+       
+       my $result = $first_arg;
+       while (@args) {
+               my $arg = shift @args;
+               unless (($arg eq '') || ($arg eq ':')) {
+                       if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
+                               my $updir_count = length($arg) - 1;
+                               while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
+                                       $arg = shift @args; 
+                                       $updir_count += (length($arg) - 1);
+                               }
+                               $arg = (':' x $updir_count); 
+                       } else {
+                               $arg =~ s/^://s; # remove a leading ':' if any
+                               $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
+                       }
+                       $result .= $arg;
+               }#unless
     }
-    return "$result:";
+       
+       if ( ($relative) && ($result !~ /^:/) ) {   
+               # add a leading colon if need be
+               $result = ":$result";
+       }
+       
+       unless ($relative) { 
+               # remove updirs immediately following the volume name
+               $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
+       }
+       
+    return $result;
 }
 
 =item catfile
 
 Concatenate one or more directory names and a filename to form a
-complete path ending with a filename.  Since this uses catdir, the
-same caveats apply.  Note that the leading ":" is removed from the
-filename, so that
+complete path ending with a filename. Resulting paths are B<relative> 
+by default, but can be forced to be absolute (but avoid this). 
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the 
+resulting path is relative by default and I<not> absolute. This 
+descision was made due to portability reasons. Since 
+C<File::Spec-E<gt>catfile()> returns relative paths on all other 
+operating systems, it will now also follow this convention on Mac OS. 
+Note that this may break some existing scripts.
+
+The last argument is always considered to be the file portion. Since 
+C<catfile()> uses C<catdir()> (see above) for the concatenation of the 
+directory portions (if any), the following with regard to relative and  
+absolute paths is true:
+
+    catfile("")     = ""
+    catfile("file") = "file"    
+
+but
+
+    catfile("","")        = rootdir()         # (e.g. "HD:")
+    catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
+    catfile("HD:","file") = "HD:file"
 
-    File::Spec->catfile("a", "b", "file"); # = "a:b:file"
+This means that C<catdir()> is called only when there are two or more 
+arguments, as one might expect.
 
-and
+Note that the leading ":" is removed from the filename, so that
 
-    File::Spec->catfile("a", "b", ":file"); # = "a:b:file"
+    catfile("a","b","file")  = ":a:b:file"    and
 
-give the same answer, as one might expect. To concatenate I<volume names>,
-I<directory paths> and I<filenames>, you should consider using C<catpath>
-(see below).
+    catfile("a","b",":file") = ":a:b:file"
+
+give the same answer. 
+
+To concatenate I<volume names>, I<directory paths> and I<filenames>, 
+you are encouraged to use C<catpath()> (see below).
 
 =cut
 
@@ -190,7 +335,7 @@ name on Mac OS.
 
 sub rootdir {
 #
-#  There's no real root directory on MacOS.  The name of the startup
+#  There's no real root directory on Mac OS. The name of the startup
 #  volume is returned, since that's the closest in concept.
 #
     require Mac::Files;
@@ -231,13 +376,13 @@ sub updir {
 =item file_name_is_absolute
 
 Takes as argument a path and returns true, if it is an absolute path.
-This does not consult the local filesystem. If
-the path has a leading ":", it's a relative path. Otherwise, it's an
+If the path has a leading ":", it's a relative path. Otherwise, it's an
 absolute path, unless the path doesn't contain any colons, i.e. it's a name
 like "a". In this particular case, the path is considered to be relative
 (i.e. it is considered to be a filename). Use ":" in the appropriate place
 in the path if you want to distinguish unambiguously. As a special case,
-the filename '' is always considered to be absolute.
+the filename '' is always considered to be absolute. Note that with version 
+1.2 of File::Spec::Mac, this does no longer consult the local filesystem. 
 
 E.g.
 
@@ -263,7 +408,7 @@ sub file_name_is_absolute {
 =item path
 
 Returns the null list for the MacPerl application, since the concept is
-usually meaningless under MacOS. But if you're using the MacPerl tool under
+usually meaningless under Mac OS. But if you're using the MacPerl tool under
 MPW, it gives back $ENV{Commands} suitably split, as is done in
 :lib:ExtUtils:MM_Mac.pm.
 
@@ -291,9 +436,9 @@ $no_file is true or a trailing separator ":" is present.
 The volume portion is always returned with a trailing ":". The directory portion
 is always returned with a leading (to denote a relative path) and a trailing ":"
 (to denote a directory). The file portion is always returned I<without> a leading ":".
-Empty portions are returned as "".
+Empty portions are returned as empty string ''.
 
-The results can be passed to L</catpath()> to get back a path equivalent to
+The results can be passed to C<catpath()> to get back a path equivalent to
 (usually identical to) the original path.
 
 
@@ -334,13 +479,13 @@ sub splitpath {
 
 =item splitdir
 
-The opposite of L</catdir()>.
+The opposite of C<catdir()>.
 
     @dirs = File::Spec->splitdir( $directories );
 
-$directories must be only the directory portion of the path on systems
+$directories should be only the directory portion of the path on systems
 that have the concept of a volume or that have path syntax that differentiates
-files from directories.
+files from directories. Consider using C<splitpath()> otherwise.
 
 Unlike just splitting the directories on the separator, empty directory names
 (C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
@@ -354,7 +499,7 @@ Hence, on Mac OS, both
 
 yield:
 
-    ( "", "a", "b", "", "c")
+    ( "a", "b", "::", "c")
 
 while
 
@@ -362,46 +507,48 @@ while
 
 yields:
 
-    ( "", "a", "b", "", "c", "")
+    ( "a", "b", "::", "c", "::")
 
 
 =cut
 
 sub splitdir {
-    my ($self,$directories) = @_ ;
-
-    if ($directories =~ /^:*\Z(?!\n)/) {
-       # dir is an empty string or a colon path like ':', i.e. the
-       # current dir, or '::', the parent dir, etc. We return that
-       # dir (as is done on Unix).
-       return $directories;
-    }
-
-    # remove a trailing colon, if any (this way, splitdir is the
-    # opposite of catdir, which automatically appends a ':')
-    $directories =~ s/:\Z(?!\n)//;
-
-    #
-    # split() likes to forget about trailing null fields, so here we
-    # check to be sure that there will not be any before handling the
-    # simple case.
-    #
-    if ( $directories !~ m@:\Z(?!\n)@ ) {
-        return split( m@:@, $directories );
-    }
-    else {
-        #
-        # since there was a trailing separator, add a file name to the end,
-        # then do the split, then replace it with ''.
-        #
-        my( @directories )= split( m@:@, "${directories}dummy" ) ;
-        $directories[ $#directories ]= '' ;
-        return @directories ;
-    }
+    my ($self, $path) = @_;
+       my @result = ();
+       my ($head, $sep, $tail, $volume, $directories);
+    
+       return ('') if ( (!defined($path)) || ($path eq '') );
+       return (':') if ($path eq ':');
+
+       ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
+
+       # deprecated, but handle it correctly
+       if ($volume) {
+               push (@result, $volume);
+               $sep .= ':';
+       }
+       
+       while ($sep || $directories) {
+               if (length($sep) > 1) {
+                       my $updir_count = length($sep) - 1;
+                       for (my $i=0; $i<$updir_count; $i++) {
+                               # push '::' updir_count times;
+                               # simulate Unix '..' updirs
+                               push (@result, '::'); 
+                       }
+               }
+               $sep = '';
+               if ($directories) {
+                       ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
+                       push (@result, $head);
+                       $directories = $tail;
+               }
+       }       
+       return @result;
 }
 
 
-=item catpath
+=item catpath()
 
     $path = File::Spec->catpath($volume,$directory,$file);
 
@@ -521,14 +668,18 @@ sub abs2rel {
         shift @pathchunks ;
         shift @basechunks ;
     }
-
+       
     # @pathchunks now has the directories to descend in to.
-    $path_dirs = $self->catdir( @pathchunks );
+       if ( (@pathchunks) && ($pathchunks[0] ne '') ) {
+       $path_dirs = $self->catdir( @pathchunks );
+       } else {
+               $path_dirs = '';
+       }
 
     # @basechunks now contains the number of directories to climb out of.
     $base_dirs = (':' x @basechunks) . ':' ;
 
-    return $self->catpath( '', $base_dirs . $path_dirs, $path_file ) ;
+    return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
 }
 
 =item rel2abs
@@ -591,7 +742,7 @@ sub rel2abs {
 
 =head1 AUTHORS
 
-See the authors list in L<File::Spec>. Mac OS support by Paul Schinder
+See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
 <schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
 
 
index 6d26660..fcbe767 100644 (file)
@@ -25,7 +25,7 @@ override specific methods.
 
 =over 2
 
-=item canonpath
+=item canonpath()
 
 No physical check on the filesystem, but a logical cleanup of a
 path. On UNIX eliminates successive slashes and successive "/.".
@@ -50,7 +50,7 @@ sub canonpath {
     return "$node$path";
 }
 
-=item catdir
+=item catdir()
 
 Concatenate two or more directory names to form a complete path ending
 with a directory. But remove the trailing slash from the resulting
@@ -175,9 +175,8 @@ sub case_tolerant {
 
 Takes as argument a path and returns true if it is an absolute path.
 
-This does not consult the local filesystem on Unix, Win32, or OS/2.  It
-does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
-It does consult the working environment for VMS (see
+This does not consult the local filesystem on Unix, Win32, OS/2 or Mac 
+OS (Classic).  It does consult the working environment for VMS (see
 L<File::Spec::VMS/file_name_is_absolute>).
 
 =cut
@@ -260,7 +259,7 @@ files from directories.
 
 Unlike just splitting the directories on the separator, empty
 directory names (C<''>) can be returned, because these are significant
-on some OSs (e.g. MacOS).
+on some OSs.
 
 On Unix,
 
@@ -294,7 +293,7 @@ sub splitdir {
 }
 
 
-=item catpath
+=item catpath()
 
 Takes volume, directory and file portions and returns an entire path. Under
 Unix, $volume is ignored, and directory and file are catenated.  A '/' is
@@ -327,9 +326,9 @@ from the base path to the destination path:
     $rel_path = File::Spec->abs2rel( $path ) ;
     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 
-If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 On systems with the concept of a volume, this assumes that both paths 
 are on the $destination volume, and ignores the $base volume. 
@@ -339,11 +338,9 @@ $base filename as well. Otherwise all path components are assumed to be
 directories.
 
 If $path is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L<cwd()>.
+This means that it is taken to be relative to L<cwd()|Cwd>.
 
-No checks against the filesystem are made on most systems.  On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+No checks against the filesystem are made.  On VMS, there is
 interaction with the working environment, as logicals and
 macros are expanded.
 
@@ -401,16 +398,16 @@ sub abs2rel {
     return $self->canonpath( $path ) ;
 }
 
-=item rel2abs
+=item rel2abs()
 
 Converts a relative path to an absolute path. 
 
     $abs_path = File::Spec->rel2abs( $path ) ;
     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 
-If $base is not present or '', then L<cwd()> is used. If $base is relative, 
+If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
 then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()>.
+is taken to be relative to L<cwd()|Cwd>.
 
 On systems with the concept of a volume, this assumes that both paths 
 are on the $base volume, and ignores the $path volume. 
@@ -421,9 +418,7 @@ directories.
 
 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
 
-No checks against the filesystem are made on most systems.  On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
+No checks against the filesystem are made.  On VMS, there is
 interaction with the working environment, as logicals and
 macros are expanded.
 
index 7ee10a1..4b10a7f 100644 (file)
@@ -163,7 +163,7 @@ sub splitpath {
 
 =item splitdir
 
-The opposite of L</catdir()>.
+The opposite of L<catdir()|File::Spec/catdir()>.
 
     @dirs = File::Spec->splitdir( $directories );
 
index dfd722c..0acd62a 100644 (file)
@@ -11,7 +11,7 @@
 
 package Math::BigFloat;
 
-$VERSION = '1.21';
+$VERSION = '1.23';
 require 5.005;
 use Exporter;
 use Math::BigInt qw/objectify/;
@@ -29,7 +29,7 @@ use Math::BigInt qw/objectify/;
 
 #@EXPORT = qw( );
 use strict;
-use vars qw/$AUTOLOAD $accuracy $precision $div_scale $rnd_mode/;
+use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode/;
 my $class = "Math::BigFloat";
 
 use overload
@@ -49,23 +49,30 @@ my $NaNOK=1;
 # constant for easier life
 my $nan = 'NaN'; 
 
-# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
-$rnd_mode = 'even';
-$accuracy = undef;
-$precision = undef;
-$div_scale = 40;
+# class constants, use Class->constant_name() to access
+$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+$accuracy   = undef;
+$precision  = undef;
+$div_scale  = 40;
 
 # in case we call SUPER::->foo() and this wants to call modify()
 # sub modify () { 0; }
 
 {
-  # checks for AUTOLOAD
+  # valid method aliases for AUTOLOAD
   my %methods = map { $_ => 1 }  
    qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
-        fabs fneg fint fcmp fzero fnan finc fdec
+        fneg fint facmp fcmp fzero fnan finf finc fdec
+       fceil ffloor
+      /;
+  # valid method's that need to be hand-ed up (for AUTOLOAD)
+  my %hand_ups = map { $_ => 1 }  
+   qw / is_nan is_inf is_negative is_positive
+        accuracy precision div_scale round_mode fabs babs
       /;
 
-  sub method_valid { return exists $methods{$_[0]||''}; } 
+  sub method_alias { return exists $methods{$_[0]||''}; } 
+  sub method_hand_up { return exists $hand_ups{$_[0]||''}; } 
 }
 
 ##############################################################################
@@ -97,11 +104,12 @@ sub new
     }
   # got string
   # handle '+inf', '-inf' first
-  if ($wanted =~ /^[+-]inf$/)
+  if ($wanted =~ /^[+-]?inf$/)
     {
     $self->{_e} = Math::BigInt->new(0);
     $self->{_m} = Math::BigInt->new(0);
     $self->{sign} = $wanted;
+    $self->{sign} = '+inf' if $self->{sign} eq 'inf';
     return $self->bnorm();
     }
   #print "new string '$wanted'\n";
@@ -125,7 +133,7 @@ sub new
   #print "$wanted => $self->{sign} $self->{value}\n";
   $self->bnorm();      # first normalize
   # if any of the globals is set, round to them and thus store them insid $self
-  $self->round($accuracy,$precision,$rnd_mode)
+  $self->round($accuracy,$precision,$class->round_mode)
    if defined $accuracy || defined $precision;
   return $self;
   }
@@ -202,7 +210,9 @@ sub bstr
   # (ref to BFLOAT or num_str ) return num_str
   # Convert number from internal format to (non-scientific) string format.
   # internal format is always normalized (no leading zeros, "-0" => "+0")
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+  #my $x = shift; my $class = ref($x) || $x;
+  #$x = $class->new(shift) unless ref($x);
 
   #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
   #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
@@ -272,7 +282,9 @@ sub bsstr
   # (ref to BFLOAT or num_str ) return num_str
   # Convert number from internal format to scientific string format.
   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+  #my $x = shift; my $class = ref($x) || $x;
+  #$x = $class->new(shift) unless ref($x);
 
   #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
   #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
@@ -290,7 +302,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) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
   return $x->bsstr(); 
   }
 
@@ -377,21 +389,63 @@ sub bacmp
   # Returns one of undef, <0, =0, >0. (suitable for sort)
   # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
   my ($self,$x,$y) = objectify(2,@_);
-  return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
-
-  # signs are ignored, so check length
-  # length(x) is length(m)+e aka length of non-fraction part
-  # the longer one is bigger
-  my $l = $x->length() - $y->length();
-  #print "$l\n";
-  return $l if $l != 0;
-  #print "equal lengths\n";
-
-  # if both are equal long, make full compare
-  # first compare only the mantissa
-  # if mantissa are equal, compare fractions
+
+  # handle +-inf and NaN's
+  if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]/)
+    {
+    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+    return 0 if ($x->is_inf() && $y->is_inf());
+    return 1 if ($x->is_inf() && !$y->is_inf());
+    return -1 if (!$x->is_inf() && $y->is_inf());
+    }
+
+  # shortcut 
+  my $xz = $x->is_zero();
+  my $yz = $y->is_zero();
+  return 0 if $xz && $yz;                              # 0 <=> 0
+  return -1 if $xz && !$yz;                            # 0 <=> +y
+  return 1 if $yz && !$xz;                             # +x <=> 0
+
+  # adjust so that exponents are equal
+  my $lxm = $x->{_m}->length();
+  my $lym = $y->{_m}->length();
+  my $lx = $lxm + $x->{_e};
+  my $ly = $lym + $y->{_e};
+  # print "x $x y $y lx $lx ly $ly\n";
+  my $l = $lx - $ly; # $l = -$l if $x->{sign} eq '-';
+  # print "$l $x->{sign}\n";
+  return $l <=> 0 if $l != 0;
   
-  return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
+  # lengths (corrected by exponent) are equal
+  # so make mantissa euqal length by padding with zero (shift left)
+  my $diff = $lxm - $lym;
+  my $xm = $x->{_m};           # not yet copy it
+  my $ym = $y->{_m};
+  if ($diff > 0)
+    {
+    $ym = $y->{_m}->copy()->blsft($diff,10);
+    }
+  elsif ($diff < 0)
+    {
+    $xm = $x->{_m}->copy()->blsft(-$diff,10);
+    }
+  my $rc = $xm->bcmp($ym);
+  # $rc = -$rc if $x->{sign} eq '-';           # -124 < -123
+  return $rc <=> 0;
+
+#  # signs are ignored, so check length
+#  # length(x) is length(m)+e aka length of non-fraction part
+#  # the longer one is bigger
+#  my $l = $x->length() - $y->length();
+#  #print "$l\n";
+#  return $l if $l != 0;
+#  #print "equal lengths\n";
+#
+#  # if both are equal long, make full compare
+#  # first compare only the mantissa
+#  # if mantissa are equal, compare fractions
+#  
+#  return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
   }
 
 sub badd 
@@ -481,20 +535,20 @@ sub bsub
 sub binc
   {
   # increment arg by one
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
-  $x->badd($self->_one())->round($a,$p,$r);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+  $x->badd($self->bone())->round($a,$p,$r);
   }
 
 sub bdec
   {
   # decrement arg by one
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
-  $x->badd($self->_one('-'))->round($a,$p,$r);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+  $x->badd($self->bone('-'))->round($a,$p,$r);
   } 
 
 sub blcm 
   { 
-  # (BINT or num_str, BINT or num_str) return BINT
+  # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
   # does not modify arguments, but returns new object
   # Lowest Common Multiplicator
 
@@ -506,7 +560,7 @@ sub blcm
 
 sub bgcd 
   { 
-  # (BINT or num_str, BINT or num_str) return BINT
+  # (BFLOAT or num_str, BFLOAT or num_str) return BINT
   # does not modify arguments, but returns new object
   # GCD -- Euclids algorithm Knuth Vol 2 pg 296
    
@@ -518,8 +572,8 @@ sub bgcd
 
 sub is_zero
   {
-  # return true if arg (BINT or num_str) is zero (array '+', '0')
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  # return true if arg (BFLOAT or num_str) is zero (array '+', '0')
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
   return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
   return 0;
@@ -527,33 +581,35 @@ sub is_zero
 
 sub is_one
   {
-  # return true if arg (BINT or num_str) is +1 (array '+', '1')
+  # return true if arg (BFLOAT or num_str) is +1 (array '+', '1')
   # or -1 if signis given
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  #my ($self,$x) = objectify(1,@_); 
-  my $sign = $_[2] || '+';
-  return ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one()); 
+  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->{_e}->is_zero() && $x->{_m}->is_one()); 
+  return 0;
   }
 
 sub is_odd
   {
-  # return true if arg (BINT or num_str) is odd or false if even
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  #my ($self,$x) = objectify(1,@_); 
+  # 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 0 if $x->{sign} !~ /^[+-]$/;                  # NaN & +-inf aren't
-  return ($x->{_e}->is_zero() && $x->{_m}->is_odd()); 
+  return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_odd()); 
+  return 0;
   }
 
 sub is_even
   {
   # return true if arg (BINT or num_str) is even or false if odd
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  #my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
   return 0 if $x->{sign} !~ /^[+-]$/;                  # NaN & +-inf aren't
   return 1 if $x->{_m}->is_zero();                     # 0e1 is even
-  return ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never
+  return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never
+  return 0;
   }
 
 sub bmul 
@@ -596,6 +652,7 @@ sub bdiv
   # (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 
+
   # x / +-inf => 0, reminder x
   return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
    if $y->{sign} =~ /^[+-]inf$/;
@@ -610,23 +667,40 @@ sub bdiv
    ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
    if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
 
-  $y = $class->new($y) if ref($y) ne $class;           # promote bigints
+  # promote BigInts and it's subclasses (except when already a BigFloat)
+  $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
+
+  # old, broken way
+  # $y = $class->new($y) if ref($y) ne $self;          # promote bigints
 
   # print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n"; 
   # we need to limit the accuracy to protect against overflow
-  my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r);       # ignore $p
+
   my $fallback = 0;
-  if (!defined $scale)
+  my $scale = 0;
+#  print "s=$scale a=",$a||'undef'," p=",$p||'undef'," r=",$r||'undef',"\n";
+  my @params = $x->_find_round_parameters($a,$p,$r,$y);
+
+  # no rounding at all, so must use fallback
+  if (scalar @params == 1)
     {
     # simulate old behaviour
-    $scale = $div_scale+1;     # one more for proper riund
-    $a = $div_scale;           # and round to it
-    $fallback = 1;             # to clear a/p afterwards       
+    $scale = $self->div_scale()+1;     # at least one more for proper round
+    $params[1] = $self->div_scale();   # and round to it as accuracy
+    $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
     }
+ # print "s=$scale a=",$params[1]||'undef'," p=",$params[2]||'undef'," f=$fallback\n";
   my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
   $scale = $lx if $lx > $scale;
   $scale = $ly if $ly > $scale;
-  #print "scale $scale $lx $ly\n";
+#  print "scale $scale $lx $ly\n";
   my $diff = $ly - $lx;
   $scale += $diff if $diff > 0;                # if lx << ly, but not if ly << lx!
 
@@ -637,40 +711,48 @@ sub bdiv
   # check for / +-1 ( +/- 1E0)
   if ($y->is_one())
     {
-    return wantarray ? ($x,$self->bzero()) : $x; 
+    return wantarray ? ($x,$self->bzero()) : $x;
     }
 
+  # calculate the result to $scale digits and then round it
   # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+  #$scale = 82;
   #print "self: $self x: $x ref(x) ", ref($x)," m: $x->{_m}\n";
-  # my $scale_10 = 10 ** $scale; $x->{_m}->bmul($scale_10);
   $x->{_m}->blsft($scale,10);
   #print "m: $x->{_m} $y->{_m}\n";
   $x->{_m}->bdiv( $y->{_m} );  # a/c
   #print "m: $x->{_m}\n";
-  #print "e: $x->{_e} $y->{_e}",$scale,"\n";
+  #print "e: $x->{_e} $y->{_e} ",$scale,"\n";
   $x->{_e}->bsub($y->{_e});    # b-d
   #print "e: $x->{_e}\n";
   $x->{_e}->bsub($scale);      # correct for 10**scale
   #print "after div: m: $x->{_m} e: $x->{_e}\n";
   $x->bnorm();                 # remove trailing 0's
-  #print "after div: m: $x->{_m} e: $x->{_e}\n";
-  $x->round($a,$p,$r);         # then round accordingly
+  #print "after norm: m: $x->{_m} e: $x->{_e}\n";
+
+  # shortcut to not run trough _find_round_parameters again
+  if (defined $params[1])
+    {
+    $x->bround($params[1],undef,$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;
+    $x->{_a} = undef; $x->{_p} = undef;
     }
   
   if (wantarray)
     {
     my $rem = $x->copy();
-    $rem->bmod($y,$a,$p,$r);
+    $rem->bmod($y,$params[1],$params[2],$params[3]);
     if ($fallback)
       {
       # clear a/p after round, since user did not request it
-      $x->{_a} = undef;
-      $x->{_p} = undef;
+      $rem->{_a} = undef; $rem->{_p} = undef;
       }
     return ($x,$rem);
     }
@@ -693,21 +775,21 @@ sub bsqrt
   { 
   # calculate square root; this should probably
   # use a different test to see whether the accuracy we want is...
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN
   return $x if $x->{sign} eq '+inf';                             # +inf
   return $x if $x->is_zero() || $x == 1;
 
-  # we need to limit the accuracy to protect against overflow
-  my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r);       # ignore $p
+  # we need to limit the accuracy to protect against overflow (ignore $p)
+  my ($scale) = $x->_scale_a($self->accuracy(),$self->round_mode,$a,$r); 
   my $fallback = 0;
   if (!defined $scale)
     {
     # simulate old behaviour
-    $scale = $div_scale+1;     # one more for proper riund
-    $a = $div_scale;           # and round to it       
-    $fallback = 1;             # to clear a/p afterwards
+    $scale = $self->div_scale()+1;     # one more for proper riund
+    $a = $self->div_scale();           # and round to it
+    $fallback = 1;                     # to clear a/p afterwards
     }
   my $lx = $x->{_m}->length();
   $scale = $lx if $scale < $lx;
@@ -720,28 +802,36 @@ sub bsqrt
   $lx = 1 if $lx < 1;
   my $gs = Math::BigFloat->new('1'. ('0' x $lx));      
   
-  # print "first guess: $gs (x $x) scale $scale\n";
+#   print "first guess: $gs (x $x) scale $scale\n";
  
   my $diff = $e;
   my $y = $x->copy();
   my $two = Math::BigFloat->new(2);
-  $x = Math::BigFloat->new($x) if ref($x) ne $class;   # promote BigInts
+  # promote BigInts and it's subclasses (except when already a BigFloat)
+  $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
+  # old, broken way
+  # $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts
+  my $rem;
   # $scale = 2;
   while ($diff >= $e)
     {
     return $x->bnan() if $gs->is_zero();
-    $r = $y->copy(); $r->bdiv($gs,$scale); 
-    $x = ($r + $gs);
-    $x->bdiv($two,$scale); 
+    $rem = $y->copy(); $rem->bdiv($gs,$scale); 
+    #print "y $y gs $gs ($gs->{_a}) rem (y/gs)\n $rem\n";
+    $x = ($rem + $gs);
+    #print "x $x rem $rem gs $gs gsa: $gs->{_a}\n";
+    $x->bdiv($two,$scale);
+    #print "x $x (/2)\n";
     $diff = $x->copy()->bsub($gs)->babs();
     $gs = $x->copy();
     }
+#  print "before $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
   $x->round($a,$p,$r);
+#  print "after $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
   if ($fallback)
     {
     # clear a/p after round, since user did not request it
-    $x->{_a} = undef;
-    $x->{_p} = undef;
+    $x->{_a} = undef; $x->{_p} = undef;
     }
   $x;
   }
@@ -758,7 +848,7 @@ sub bpow
   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
   return $x->bone() if $y->is_zero();
   return $x         if $x->is_one() || $y->is_one();
-  my $y1 = $y->as_number();            # make bigint
+  my $y1 = $y->as_number();            # make bigint (trunc)
   if ($x == -1)
     {
     # if $x == -1 and odd/even y => +1/-1  because +-1 ^ (+-1) => +-1
@@ -791,17 +881,22 @@ sub bfround
   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
   # $n == 0 means round to integer
   # expects and returns normalized numbers!
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
 
   return $x if $x->modify('bfround');
   
-  my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
+  my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
   return $x if !defined $scale;                        # no-op
 
   # never round a 0, +-inf, NaN
   return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
   # print "MBF bfround $x to scale $scale mode $mode\n";
 
+  # don't round if x already has lower precision
+  return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
+
+  $x->{_p} = $scale;                   # remember round in any case
+  $x->{_a} = undef;                    # and clear A
   if ($scale < 0)
     {
     # print "bfround scale $scale e $x->{_e}\n";
@@ -812,7 +907,7 @@ sub bfround
     my $dad = -$x->{_e};                       # digits after dot
     my $zad = 0;                               # zeros after dot
     $zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style
-    # print "scale $scale dad $dad zad $zad len $len\n";
+    #print "scale $scale dad $dad zad $zad len $len\n";
 
     # number  bsstr   len zad dad      
     # 0.123   123e-3   3   0 3
@@ -824,15 +919,12 @@ sub bfround
     # do not round after/right of the $dad
     return $x if $scale > $dad;                        # 0.123, scale >= 3 => exit
 
-     # round to zero if rounding inside the $zad, but not for last zero like:
-     # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
-     if ($scale < $zad)
-      {
-      return $x->bzero();
-      }
-    if ($scale == $zad)                        # for 0.006, scale -2 and trunc
+    # round to zero if rounding inside the $zad, but not for last zero like:
+    # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
+    return $x->bzero() if $scale < $zad;
+    if ($scale == $zad)                        # for 0.006, scale -3 and trunc
       {
-      $scale = -$len;
+      $scale = -$len-1;
       }
     else
       {
@@ -855,12 +947,10 @@ sub bfround
 
     # calculate digits before dot
     my $dbt = $x->{_m}->length(); $dbt += $x->{_e} if $x->{_e}->sign() eq '-';
-    if (($scale > $dbt) && ($dbt < 0))
-      {
-      # if not enough digits before dot, round to zero
-      return $x->bzero();
-      }
-    if (($scale >= 0) && ($dbt == 0))
+    # if not enough digits before dot, round to zero
+    return $x->bzero() if ($scale > $dbt) && ($dbt < 0);
+    # scale always >= 0 here
+    if ($dbt == 0)
       {
       # 0.49->bfround(1): scale == 1, dbt == 0: => 0.0
       # 0.51->bfround(0): scale == 0, dbt == 0: => 1.0
@@ -890,11 +980,20 @@ sub bfround
 sub bround
   {
   # accuracy: preserve $N digits, and overwrite the rest with 0's
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
-  return $x if !defined $scale;                        # no-op
+  my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
+  
+  die ('bround() needs positive accuracy') if ($_[0] || 0) < 0;
 
+  my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
+  return $x if !defined $scale;                                # no-op
+  
   return $x if $x->modify('bround');
+  
+  # scale is now either $x->{_a}, $accuracy, or the user parameter
+  # test whether $x already has lower accuracy, do nothing in this case 
+  # but do round if the accuracy is the same, since a math operation might
+  # want to round a number with A=5 to 5 digits afterwards again
+  return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0];
 
   # print "bround $scale $mode\n";
   # 0 => return all digits, scale < 0 makes no sense
@@ -906,8 +1005,6 @@ sub bround
   # subtract the delta from scale, to simulate keeping the zeros
   # -5 +5 => 1; -10 +5 => -4
   my $delta = $x->{_e} + $x->{_m}->length() + 1; 
-  # removed by tlr, since causes problems with fraction tests:
-  # $scale += $delta if $delta < 0;
   
   # if we should keep more digits than the mantissa has, do nothing
   return $x if $x->{_m}->length() <= $scale;
@@ -916,13 +1013,15 @@ sub bround
   $x->{_m}->{sign} = $x->{sign};
   $x->{_m}->bround($scale,$mode);      # round mantissa
   $x->{_m}->{sign} = '+';              # fix sign back
+  $x->{_a} = $scale;                   # remember rounding
+  $x->{_p} = undef;                    # and clear P
   $x->bnorm();                         # del trailing zeros gen. by bround()
   }
 
 sub bfloor
   {
   # return integer less or equal then $x
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   return $x if $x->modify('bfloor');
    
@@ -941,7 +1040,7 @@ sub bfloor
 sub bceil
   {
   # return integer greater or equal then $x
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   return $x if $x->modify('bceil');
   return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
@@ -960,7 +1059,7 @@ sub bceil
 
 sub DESTROY
   {
-  # going trough AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
+  # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
   }
 
 sub AUTOLOAD
@@ -971,16 +1070,26 @@ sub AUTOLOAD
 
   $name =~ s/.*:://;   # split package
   #print "$name\n";
-  if (!method_valid($name))
+  no strict 'refs';
+  if (!method_alias($name))
     {
-    #no strict 'refs';
-    ## try one level up
-    #&{$class."::SUPER->$name"}(@_);
-    # delayed load of Carp and avoid recursion 
-    require Carp;
-    Carp::croak ("Can't call $class\-\>$name, not a valid method");
+    if (!defined $name)
+      {
+      # delayed load of Carp and avoid recursion       
+      require Carp;
+      Carp::croak ("Can't call a method without name");
+      }
+    # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
+    if (!method_hand_up($name))
+      {
+      # delayed load of Carp and avoid recursion       
+      require Carp;
+      Carp::croak ("Can't call $class\-\>$name, not a valid method");
+      }
+    # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
+    $name =~ s/^f/b/;
+    return &{'Math::BigInt'."::$name"}(@_);
     }
-  no strict 'refs';
   my $bname = $name; $bname =~ s/^f/b/;
   *{$class."\:\:$name"} = \&$bname;
   &$bname;     # uses @_
@@ -989,22 +1098,28 @@ sub AUTOLOAD
 sub exponent
   {
   # return a copy of the exponent
-  my $self = shift;
-  $self = $class->new($self) unless ref $self;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
-  return bnan() if $self->is_nan();
-  return $self->{_e}->copy();
+  if ($x->{sign} !~ /^[+-]$/)
+    {
+    my $s = $x->{sign}; $s =~ s/^[+-]//;
+    return $self->new($s);                     # -inf, +inf => +inf
+    }
+  return $x->{_e}->copy();
   }
 
 sub mantissa
   {
   # return a copy of the mantissa
-  my $self = shift;
-  $self = $class->new($self) unless ref $self;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  
-  return bnan() if $self->is_nan();
-  my $m = $self->{_m}->copy(); # faster than going via bstr()
-  $m->bneg() if $self->{sign} eq '-';
+  if ($x->{sign} !~ /^[+-]$/)
+    {
+    my $s = $x->{sign}; $s =~ s/^[+]//;
+    return $self->new($s);                     # -inf, +inf => +inf
+    }
+  my $m = $x->{_m}->copy();            # faster than going via bstr()
+  $m->bneg() if $x->{sign} eq '-';
 
   return $m;
   }
@@ -1012,33 +1127,24 @@ sub mantissa
 sub parts
   {
   # return a copy of both the exponent and the mantissa
-  my $self = shift;
-  $self = $class->new($self) unless ref $self;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
-  return (bnan(),bnan()) if $self->is_nan();
-  my $m = $self->{_m}->copy(); # faster than going via bstr()
-  $m->bneg() if $self->{sign} eq '-';
-  return ($m,$self->{_e}->copy());
+  if ($x->{sign} !~ /^[+-]$/)
+    {
+    my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
+    return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
+    }
+  my $m = $x->{_m}->copy();    # faster than going via bstr()
+  $m->bneg() if $x->{sign} eq '-';
+  return ($m,$x->{_e}->copy());
   }
 
 ##############################################################################
 # private stuff (internal use only)
 
-sub _one
-  {
-  # internal speedup, set argument to 1, or create a +/- 1
-  my $self = shift; $self = ref($self) if ref($self);
-  my $x = {}; bless $x, $self;
-  $x->{_m} = Math::BigInt->new(1);
-  $x->{_e} = Math::BigInt->new(0);
-  $x->{sign} = shift || '+'; 
-  return $x;
-  }
-
 sub import
   {
   my $self = shift;
-  #print "import $self\n";
   for ( my $i = 0; $i < @_ ; $i++ )
     {
     if ( $_[$i] eq ':constant' )
@@ -1059,7 +1165,7 @@ sub bnorm
   {
   # adjust m and e so that m is smallest possible
   # round number according to accuracy and precision settings
-  my $x = shift;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
   return $x if $x->{sign} !~ /^[+-]$/;         # inf, nan etc
 
@@ -1068,10 +1174,14 @@ sub bnorm
     {
     $x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
     }
-  # for something like 0Ey, set y to 1
-  $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
+  # for something like 0Ey, set y to 1, and -0 => +0
+  $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
+  # this is to prevent automatically rounding when MBI's globals are set
   $x->{_m}->{_f} = MB_NEVER_ROUND;
   $x->{_e}->{_f} = MB_NEVER_ROUND;
+  # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
+  $x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef;
+  $x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef;
   return $x;                                   # MBI bnorm is no-op
   }
  
@@ -1081,7 +1191,7 @@ sub bnorm
 sub as_number
   {
   # return a bigint representation of this BigFloat number
-  my ($self,$x) = objectify(1,@_);
+  my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x);
 
   my $z;
   if ($x->{_e}->is_zero())
@@ -1105,8 +1215,11 @@ sub as_number
 
 sub length
   {
-  my $x = shift; $x = $class->new($x) unless ref $x; 
+  my $x = shift;
+  my $class = ref($x) || $x;
+  $x = $class->new(shift) unless ref($x);
 
+  return 1 if $x->{_m}->is_zero();
   my $len = $x->{_m}->length();
   $len += $x->{_e} if $x->{_e}->sign() eq '+';
   if (wantarray())
@@ -1341,8 +1454,8 @@ All rounding functions take as a second parameter a rounding mode from one of
 the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
 
 The default rounding mode is 'even'. By using
-C<< Math::BigFloat::round_mode($rnd_mode); >> you can get and set the default
-mode for subsequent rounding. The usage of C<$Math::BigFloat::$rnd_mode> is
+C<< Math::BigFloat::round_mode($round_mode); >> you can get and set the default
+mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
 no longer supported.
 The second parameter to the round functions then overrides the default
 temporarily. 
index df7881c..8aab185 100644 (file)
@@ -19,7 +19,7 @@ package Math::BigInt;
 my $class = "Math::BigInt";
 require 5.005;
 
-$VERSION = '1.42';
+$VERSION = '1.44';
 use Exporter;
 @ISA =       qw( Exporter );
 @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
@@ -33,7 +33,7 @@ use Exporter;
                 objectify _swap
                ); 
 #@EXPORT = qw( );
-use vars qw/$rnd_mode $accuracy $precision $div_scale/;
+use vars qw/$round_mode $accuracy $precision $div_scale/;
 use strict;
 
 # Inside overload, the first arg is always an object. If the original code had
@@ -122,59 +122,116 @@ my $nan = 'NaN';                         # constants for easier life
 my $CALC = 'Math::BigInt::Calc';       # module to do low level math
 sub _core_lib () { return $CALC; }     # for test suite
 
-# Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
-$rnd_mode = 'even';
-$accuracy = undef;
-$precision = undef;
-$div_scale = 40;
+$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+$accuracy   = undef;
+$precision  = undef;
+$div_scale  = 40;
 
 sub round_mode
   {
+  no strict 'refs';
   # make Class->round_mode() work
-  my $self = shift || $class;
-  # shift @_ if defined $_[0] && $_[0] eq $class;
+  my $self = shift;
+  my $class = ref($self) || $self || __PACKAGE__;
   if (defined $_[0])
     {
     my $m = shift;
     die "Unknown round mode $m"
      if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
-    $rnd_mode = $m; return;
+    ${"${class}::round_mode"} = $m; return $m;
     }
-  return $rnd_mode;
+  return ${"${class}::round_mode"};
+  }
+
+sub div_scale
+  {
+  no strict 'refs';
+  # make Class->round_mode() work
+  my $self = shift;
+  my $class = ref($self) || $self || __PACKAGE__;
+  if (defined $_[0])
+    {
+    die ('div_scale must be greater than zero') if $_[0] < 0;
+    ${"${class}::div_scale"} = shift;
+    }
+  return ${"${class}::div_scale"};
   }
 
 sub accuracy
   {
-  # $x->accuracy($a);          ref($x) a
-  # $x->accuracy();            ref($x);
-  # Class::accuracy();         # not supported 
-  #print "MBI @_ ($class)\n";
-  my $x = shift;
+  # $x->accuracy($a);          ref($x) $a
+  # $x->accuracy();            ref($x)
+  # Class->accuracy();         class
+  # Class->accuracy($a);       class $a
 
-  die ("accuracy() needs reference to object as first parameter.")
-   if !ref $x;
+  my $x = shift;
+  my $class = ref($x) || $x || __PACKAGE__;
 
+  no strict 'refs';
+  # need to set new value?
   if (@_ > 0)
     {
-    $x->{_a} = shift;
-    $x->round() if defined $x->{_a};
+    my $a = shift;
+    die ('accuracy must not be zero') if defined $a && $a == 0;
+    if (ref($x))
+      {
+      # $object->accuracy() or fallback to global
+      $x->bround($a) if defined $a;
+      $x->{_a} = $a;                   # set/overwrite, even if not rounded
+      $x->{_p} = undef;                        # clear P
+      }
+    else
+      {
+      # set global
+      ${"${class}::accuracy"} = $a;
+      }
+    return $a;                         # shortcut
+    }
+
+  if (ref($x))
+    {
+    # $object->accuracy() or fallback to global
+    return $x->{_a} || ${"${class}::accuracy"};
     }
-  return $x->{_a};
+  return ${"${class}::accuracy"};
   } 
 
 sub precision
   {
-  my $x = shift;
+  # $x->precision($p);         ref($x) $p
+  # $x->precision();           ref($x)
+  # Class->precision();                class
+  # Class->precision($p);      class $p
 
-  die ("precision() needs reference to object as first parameter.")
-   if !ref $x;
+  my $x = shift;
+  my $class = ref($x) || $x || __PACKAGE__;
 
+  no strict 'refs';
+  # need to set new value?
   if (@_ > 0)
     {
-    $x->{_p} = shift;
-    $x->round() if defined $x->{_p};
+    my $p = shift;
+    if (ref($x))
+      {
+      # $object->precision() or fallback to global
+      $x->bfround($p) if defined $p;
+      $x->{_p} = $p;                   # set/overwrite, even if not rounded
+      $x->{_a} = undef;                        # clear P
+      }
+    else
+      {
+      # set global
+      ${"${class}::precision"} = $p;
+      }
+    return $p;                         # shortcut
     }
-  return $x->{_p};
+
+  if (ref($x))
+    {
+    # $object->precision() or fallback to global
+    return $x->{_p} || ${"${class}::precision"};
+    }
+  return ${"${class}::precision"};
   } 
 
 sub _scale_a
@@ -270,10 +327,10 @@ sub new
 
   my $self = {}; bless $self, $class;
   # handle '+inf', '-inf' first
-  if ($wanted =~ /^[+-]inf$/)
+  if ($wanted =~ /^[+-]?inf$/)
     {
     $self->{value} = $CALC->_zero();
-    $self->{sign} = $wanted;
+    $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
     return $self;
     }
   # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
@@ -336,7 +393,7 @@ sub new
   $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
   #print "$wanted => $self->{sign}\n";
   # if any of the globals is set, use them to round and store them inside $self
-  $self->round($accuracy,$precision,$rnd_mode)
+  $self->round($accuracy,$precision,$round_mode)
    if defined $accuracy || defined $precision;
   return $self;
   }
@@ -418,7 +475,12 @@ sub bsstr
   # (ref to BFLOAT or num_str ) return num_str
   # Convert number from internal format to scientific string format.
   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
-  my ($self,$x) = objectify(1,@_);
+#  print "bsstr $_[0] $_[1]\n";
+#  my $x = shift; $class = ref($x) || $x;
+#  print "class $class $x (",ref($x),") $_[0]\n";
+#  $x = $class->new(shift) if !ref($x);
+# 
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 
 
   if ($x->{sign} !~ /^[+-]$/)
     {
@@ -435,7 +497,9 @@ sub bsstr
 sub bstr 
   {
   # make a string from bigint object
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  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
@@ -461,11 +525,12 @@ sub numify
 sub sign
   {
   # return the sign of the number: +/-/NaN
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 
+  
   return $x->{sign};
   }
 
-sub round
+sub _find_round_parameters
   {
   # After any operation or when calling round(), the result is rounded by
   # regarding the A & P from arguments, local parameters, or globals.
@@ -482,18 +547,13 @@ sub round
   my @args = @_;       # all 'other' arguments (0 for unary, 1 for binary ops)
 
   $self = new($self) unless ref($self);        # if not object, make one
-  my $c = ref($args[0]);                       # find out class of argument
+  my $c = ref($self);                          # find out class of argument(s)
   unshift @args,$self;                         # add 'first' argument
         
   # leave bigfloat parts alone
-  return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+  return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
 
   no strict 'refs';
-  my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
-  if (!defined $aa)
-    {
-    $z = "$c\::precision"; $ap = $$z;
-    }
 
   # now pick $a or $p, but only if we have got "arguments"
   if ((!defined $a) && (!defined $p) && (@args > 0))
@@ -507,33 +567,59 @@ sub round
       {
       foreach (@args)
         {
-        # take the defined one, or if both defined, the one that is smaller
-        $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p);
+        # take the defined one, or if both defined, the one that is bigger
+        # -2 > -3, and 3 > 2
+        $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
         }
       # if none defined, use globals (#2)
       if (!defined $p) 
         {
-        $a = $aa; $p = $ap; # save the check: if !defined $a;
+        my $z = "$c\::accuracy"; my $a = $$z; 
+        if (!defined $a)
+          {
+          $z = "$c\::precision"; $p = $$z;
+          }
         }
       } # endif !$a
     } # endif !$a || !$P && args > 0
-  # for clearity, this is not merged at place (#2)
+  my @params = ($self);
+  if (defined $a || defined $p)
+    {
+#    print "r => ",$r||'r undef'," in $c\n";
+    $r = $r || ${"$c\::round_mode"};
+    die "Unknown round mode '$r'"
+     if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+    push @params, ($a,$p,$r);
+    }
+  return @params;
+  }
+
+sub round
+  {
+  # round $self according to given parameters, or given second argument's
+  # parameters or global defaults 
+  my $self = shift;
+  
+  my @params = $self->_find_round_parameters(@_);
+  return $self->bnorm() if @params == 1;       # no-op
+
   # now round, by calling fround or ffround:
-  if (defined $a)
+  if (defined $params[1])
     {
-    $self->{_a} = $a; $self->bround($a,$r);
+    $self->bround($params[1],$params[3]);
     }
-  elsif (defined $p)
+  else
     {
-    $self->{_p} = $p; $self->bfround($p,$r);
+    $self->bfround($params[2],$params[3]);
     }
-  return $self->bnorm();
+  return $self->bnorm();                       # after round, normalize
   }
 
 sub bnorm
   { 
-  # (num_str or BINT) return BINT
+  # (numstr or or BINT) return BINT
   # Normalize number -- no-op here
+  return Math::BigInt->new($_[0]) if !ref($_[0]);
   return $_[0];
   }
 
@@ -541,7 +627,8 @@ sub babs
   {
   # (BINT or num_str) return BINT
   # make number absolute, or return absolute BINT from string
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
   return $x if $x->modify('babs');
   # post-normalized abs for internal use (does nothing for NaN)
   $x->{sign} =~ s/^-/+/;
@@ -552,7 +639,8 @@ sub bneg
   { 
   # (BINT or num_str) return BINT
   # negate number or make a negated number from string
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+  
   return $x if $x->modify('bneg');
   # for +0 dont negate (to have always normalized)
   return $x if $x->is_zero();
@@ -692,8 +780,7 @@ sub bsub
 sub binc
   {
   # increment arg by one
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
-  # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
   return $x if $x->modify('binc');
   $x->badd($self->__one())->round($a,$p,$r);
   }
@@ -701,7 +788,7 @@ sub binc
 sub bdec
   {
   # decrement arg by one
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
   return $x if $x->modify('bdec');
   $x->badd($self->__one('-'))->round($a,$p,$r);
   } 
@@ -775,59 +862,69 @@ sub bnot
   {
   # (num_str or BINT) return BINT
   # represent ~x as twos-complement number
-  my ($self,$x) = objectify(1,@_);
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
   return $x if $x->modify('bnot');
-  $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday
-  $x;
+  $x->bneg(); $x->bdec();              # was: bsub(-1,$x);, time it someday
+  return $x->round($a,$p,$r);
   }
 
 sub is_zero
   {
   # return true if arg (BINT or num_str) is zero (array '+', '0')
-  #my ($self,$x) = objectify(1,@_);
-  my $x = shift; $x = $class->new($x) unless ref $x;
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
   
   return 0 if $x->{sign} !~ /^\+$/;                    # -, NaN & +-inf aren't
   $CALC->_is_zero($x->{value});
-  #return $CALC->_is_zero($x->{value});
   }
 
 sub is_nan
   {
   # return true if arg (BINT or num_str) is NaN
-  #my ($self,$x) = objectify(1,@_);
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  return ($x->{sign} eq $nan); 
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+  return 1 if $x->{sign} eq $nan;
+  return 0;
   }
 
 sub is_inf
   {
   # return true if arg (BINT or num_str) is +-inf
-  #my ($self,$x) = objectify(1,@_);
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  my $sign = shift || '';
+  my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+  $sign = '' if !defined $sign;
+  return 0 if $sign !~ /^([+-]|)$/;
 
-  return $x->{sign} =~ /^[+-]inf$/ if $sign eq '';
-  return $x->{sign} =~ /^[$sign]inf$/;
+  if ($sign eq '')
+    {
+    return 1 if ($x->{sign} =~ /^[+-]inf$/); 
+    return 0;
+    }
+  $sign = quotemeta($sign.'inf');
+  return 1 if ($x->{sign} =~ /^$sign$/);
+  return 0;
   }
 
 sub is_one
   {
   # return true if arg (BINT or num_str) is +1
   # or -1 if sign is given
-  #my ($self,$x) = objectify(1,@_); 
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  my $sign = shift || ''; $sign = '+' if $sign ne '-';
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
+    
+  $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
  
-  return 0 if $x->{sign} ne $sign; 
+  return 0 if $x->{sign} ne $sign;     # -1 != +1, NaN, +-inf aren't either
   return $CALC->_is_one($x->{value});
   }
 
 sub is_odd
   {
   # return true when arg (BINT or num_str) is odd, false for even
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  #my ($self,$x) = objectify(1,@_);
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 
   return 0 if $x->{sign} !~ /^[+-]$/;                  # NaN & +-inf aren't
   return $CALC->_is_odd($x->{value});
@@ -836,8 +933,8 @@ sub is_odd
 sub is_even
   {
   # return true when arg (BINT or num_str) is even, false for odd
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  #my ($self,$x) = objectify(1,@_);
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 
   return 0 if $x->{sign} !~ /^[+-]$/;                  # NaN & +-inf aren't
   return $CALC->_is_even($x->{value});
@@ -846,15 +943,21 @@ sub is_even
 sub is_positive
   {
   # return true when arg (BINT or num_str) is positive (>= 0)
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  return ($x->{sign} =~ /^\+/);
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+  
+  return 1 if $x->{sign} =~ /^\+/;
+  return 0;
   }
 
 sub is_negative
   {
   # return true when arg (BINT or num_str) is negative (< 0)
-  my $x = shift; $x = $class->new($x) unless ref $x;
-  return ($x->{sign} =~ /^-/);
+  # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+  
+  return 1 if ($x->{sign} =~ /^-/);
+  return 0;
   }
 
 ###############################################################################
@@ -943,15 +1046,15 @@ sub bdiv
   # call div here 
   my $rem = $self->bzero(); 
   $rem->{sign} = $y->{sign};
-  #($x->{value},$rem->{value}) = div($x->{value},$y->{value});
   ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
-  # do not leave rest "-0";
+  # do not leave reminder "-0";
   # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0);
   $rem->{sign} = '+' if $CALC->_is_zero($rem->{value});
   if (($x->{sign} eq '-') and (!$rem->is_zero()))
     {
     $x->bdec();
     }
+#  print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n";
   $x->round($a,$p,$r,$y); 
   if (wantarray)
     {
@@ -1200,7 +1303,7 @@ sub bxor
 
 sub length
   {
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
   my $e = $CALC->_len($x->{value}); 
   #  # fallback, since we do not know the underlying representation
@@ -1238,7 +1341,7 @@ sub _trailing_zeros
 
 sub bsqrt
   {
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
   return $x->bnan() if $x->{sign} =~ /\-|$nan/;        # -x or NaN => NaN
   return $x->bzero() if $x->is_zero();         # 0 => 0
@@ -1266,9 +1369,13 @@ sub bsqrt
 sub exponent
   {
   # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
-  my ($self,$x) = objectify(1,@_);
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  
-  return bnan() if $x->is_nan();
+  if ($x->{sign} !~ /^[+-]$/)
+    {
+    my $s = $x->{sign}; $s =~ s/^[+-]//;
+    return $self->new($s);             # -inf,+inf => inf
+    }
   my $e = $class->bzero();
   return $e->binc() if $x->is_zero();
   $e += $x->_trailing_zeros();
@@ -1277,10 +1384,14 @@ sub exponent
 
 sub mantissa
   {
-  # return a copy of the mantissa (here always $self)
-  my ($self,$x) = objectify(1,@_);
+  # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
-  return bnan() if $x->is_nan();
+  if ($x->{sign} !~ /^[+-]$/)
+    {
+    my $s = $x->{sign}; $s =~ s/^[+]//;
+    return $self->new($s);             # +inf => inf
+    }
   my $m = $x->copy();
   # that's inefficient
   my $zeros = $m->_trailing_zeros();
@@ -1290,11 +1401,10 @@ sub mantissa
 
 sub parts
   {
-  # return a copy of both the exponent and the mantissa (here 0 and self)
-  my $self = shift;
-  $self = $class->new($self) unless ref $self;
+  # return a copy of both the exponent and the mantissa
+  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 
-  return ($self->mantissa(),$self->exponent());
+  return ($x->mantissa(),$x->exponent());
   }
    
 ##############################################################################
@@ -1303,15 +1413,21 @@ sub parts
 sub bfround
   {
   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
-  # $n == 0 => round to integer
+  # $n == 0 || $n == 1 => round to integer
   my $x = shift; $x = $class->new($x) unless ref $x;
-  my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
+  my ($scale,$mode) = $x->_scale_p($precision,$round_mode,@_);
   return $x if !defined $scale;                # no-op
 
   # no-op for BigInts if $n <= 0
-  return $x if $scale <= 0;
+  if ($scale <= 0)
+    {
+    $x->{_p} = $scale; return $x;
+    }
 
   $x->bround( $x->length()-$scale, $mode);
+  $x->{_a} = undef;                            # bround sets {_a}
+  $x->{_p} = $scale;                           # so correct it
+  $x;
   }
 
 sub _scan_for_nonzero
@@ -1348,37 +1464,43 @@ sub bround
   # and overwrite the rest with 0's, return normalized number
   # do not return $x->bnorm(), but $x
   my $x = shift; $x = $class->new($x) unless ref $x;
-  my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
+  my ($scale,$mode) = $x->_scale_a($accuracy,$round_mode,@_);
   return $x if !defined $scale;                # no-op
   
   # print "MBI round: $x to $scale $mode\n";
-  # -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
   return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
 
   # we have fewer digits than we want to scale to
   my $len = $x->length();
-  # print "$len $scale\n";
-  return $x if $len < abs($scale);
+  # print "$scale $len\n";
+  # scale < 0, but > -len (not >=!)
+  if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
+    {
+    $x->{_a} = $scale if !defined $x->{_a};    # if not yet defined overwrite
+    return $x; 
+    }
    
   # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
   my ($pad,$digit_round,$digit_after);
   $pad = $len - $scale;
-  $pad = abs($scale)+1 if $scale < 0;
+  $pad = abs($scale-1) if $scale < 0;
+
   # do not use digit(), it is costly for binary => decimal
   #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len;
   #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0;
+
   my $xs = $CALC->_str($x->{value});
   my $pl = -$pad-1;
+  # print "pad $pad pl $pl scale $scale len $len\n";
   # pad:   123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
   # pad+1: 123: 0 => 0,  at 1 => -1, at 2 => -2, at 3 => -3
   $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
   $pl++; $pl ++ if $pad >= $len;
   $digit_after = '0'; $digit_after = substr($$xs,$pl,1)
    if $pad > 0;
-  
-  #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len;
-  #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0;
-  # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n";
+
+ #  print "$pad $pl $$xs dr $digit_round da $digit_after\n";
 
   # in case of 01234 we round down, for 6789 up, and only in case 5 we look
   # closer at the remaining digits of the original $x, remember decision
@@ -1428,21 +1550,31 @@ sub bround
       {
       $x->bzero();                                     # round to '0'
       }
-    # print "res $pad $len $x $$xs\n";
+  #   print "res $pad $len $x $$xs\n";
     }
   # move this later on after the inc of the string
   #$x->{value} = $CALC->_new($xs);                     # put back in
   if ($round_up)                                       # what gave test above?
     {
+    #print " $pad => ";
     $pad = $len if $scale < 0;                         # tlr: whack 0.51=>1.0  
     # modify $x in place, undef, undef to avoid rounding
     # str creation much faster than 10 ** something
+    #print " $pad, $x => ";
     $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) );
+    #print "$x\n";
     # increment string in place, to avoid dec=>hex for the '1000...000'
     # $xs ...blah foo
     }
   # to here:
   #$x->{value} = $CALC->_new($xs);                     # put back in
+
+  $x->{_a} = $scale if $scale >= 0;
+  if ($scale < 0)
+    {
+    $x->{_a} = $len+$scale;
+    $x->{_a} = 0 if $scale < -$len;
+    }
   $x;
   }
 
@@ -1450,10 +1582,9 @@ sub bfloor
   {
   # return integer less or equal then number, since it is already integer,
   # always returns $self
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   # not needed: return $x if $x->modify('bfloor');
-
   return $x->round($a,$p,$r);
   }
 
@@ -1461,10 +1592,9 @@ sub bceil
   {
   # return integer greater or equal then number, since it is already integer,
   # always returns $self
-  my ($self,$x,$a,$p,$r) = objectify(1,@_);
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 
   # not needed: return $x if $x->modify('bceil');
-
   return $x->round($a,$p,$r);
   }
 
@@ -1530,7 +1660,17 @@ sub objectify
   # $class,1,2. (We can not take '1' as class ;o)
   # badd($class,1) is not supported (it should, eventually, try to add undef)
   # currently it tries 'Math::BigInt' + 1, which will not work.
+
+  # some shortcut for the common cases
+
+  # $x->unary_op();
+  return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
+  # $x->binary_op($y);
+  #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2)
+  # && ref($_[1]) && ref($_[2]);
+
+#  print "obj '",join ("' '", @_),"'\n";
+
   my $count = abs(shift || 0);
   
   #print caller(),"\n";
@@ -1575,6 +1715,7 @@ sub objectify
       #print "$count\n";
       $count--; 
       $k = shift; 
+  #    print "$k (",ref($k),") => \n";
       if (!ref($k))
         {
         $k = $a[0]->new($k);
@@ -1584,6 +1725,7 @@ sub objectify
        # foreign object, try to convert to integer
         $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
        }
+   #   print "$k (",ref($k),")\n";
       push @a,$k;
       }
     push @a,@_;                # return other params, too
@@ -1810,10 +1952,9 @@ sub as_hex
 
   my $es = ''; my $s = '';
   $s = $x->{sign} if $x->{sign} eq '-';
-  $s .= '0x';
   if ($CALC->can('_as_hex'))
     {
-    $es = $CALC->_as_hex($x->{value});
+    $es = ${$CALC->_as_hex($x->{value})};
     }
   else
     {
@@ -1826,6 +1967,7 @@ sub as_hex
       }
     $es = reverse $es;
     $es =~ s/^[0]+//;  # strip leading zeros
+    $s .= '0x';
     }
   $s . $es;
   }
@@ -1840,10 +1982,9 @@ sub as_bin
 
   my $es = ''; my $s = '';
   $s = $x->{sign} if $x->{sign} eq '-';
-  $s .= '0b';
   if ($CALC->can('_as_bin'))
     {
-    $es = $CALC->_as_bin($x->{value});
+    $es = ${$CALC->_as_bin($x->{value})};
     }
   else
     {
@@ -1856,6 +1997,7 @@ sub as_bin
       }
     $es = reverse $es; 
     $es =~ s/^[0]+//;  # strip leading zeros
+    $s .= '0b';
     }
   $s . $es;
   }
@@ -2008,7 +2150,7 @@ Math::BigInt - Arbitrary size integer math package
                                # latter is always 0 digits long for BigInt's
 
   $x->exponent();              # return exponent as BigInt
-  $x->mantissa();              # return mantissa as BigInt
+  $x->mantissa();              # return (signed) mantissa as BigInt
   $x->parts();                 # return (mantissa,exponent) as BigInt
   $x->copy();                  # make a true copy of $x (unlike $y = $x;)
   $x->as_number();             # return as BigInt (in BigInt: same as copy())
@@ -2019,7 +2161,6 @@ Math::BigInt - Arbitrary size integer math package
   $x->as_hex();                        # as signed hexadecimal string with prefixed 0x
   $x->as_bin();                        # as signed binary string with prefixed 0b
 
-
 =head1 DESCRIPTION
 
 All operators (inlcuding basic math operations) are overloaded if you
@@ -2366,11 +2507,11 @@ This is how it works now:
     following rounding modes (R):
     'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
   * you can set and get the global R by using Math::SomeClass->round_mode()
-    or by setting $Math::SomeClass::rnd_mode
+    or by setting $Math::SomeClass::round_mode
   * after each operation, $result->round() is called, and the result may
     eventually be rounded (that is, if A or P were set either locally,
     globally or as parameter to the operation)
-  * to manually round a number, call $x->round($A,$P,$rnd_mode);
+  * to manually round a number, call $x->round($A,$P,$round_mode);
     this will round the number by using the appropriate rounding function
     and then normalize it.
   * rounding modifies the local settings of the number:
index ebaf5a1..a2b73e0 100644 (file)
@@ -8,7 +8,7 @@ require Exporter;
 use vars qw/@ISA $VERSION/;
 @ISA = qw(Exporter);
 
-$VERSION = '0.10';
+$VERSION = '0.12';
 
 # Package to store unsigned big integers in decimal and do math with them
 
@@ -19,7 +19,8 @@ $VERSION = '0.10';
 # - fully remove funky $# stuff (maybe)
 
 # USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
-# instead of "/ 1e5" at some places, (marked with USE_MUL).
+# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
+# BS2000, some Crays need USE_DIV instead.
 # The BEGIN block is used to determine which of the two variants gives the
 # correct result.
 
@@ -29,9 +30,36 @@ $VERSION = '0.10';
 # constants for easier life
 my $nan = 'NaN';
 
-my $BASE_LEN = 7;
-my $BASE = int("1e".$BASE_LEN);                # var for trying to change it to 1e7
-my $RBASE = abs('1e-'.$BASE_LEN);      # see USE_MUL
+my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL);
+
+sub _base_len 
+  {
+  my $b = shift;
+  if (defined $b)
+    {
+    $BASE_LEN = $b;
+    $BASE = int("1e".$BASE_LEN);
+    $RBASE = abs('1e-'.$BASE_LEN);     # see USE_MUL
+    $MAX_VAL = $BASE-1;
+    # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL\n";
+    # print "int: ",int($BASE * $RBASE),"\n";
+    if (int($BASE * $RBASE) == 0)              # should be 1
+      {
+      # must USE_MUL
+     # print "use mul\n";
+      *{_mul} = \&_mul_use_mul;
+      *{_div} = \&_div_use_mul;
+      }
+    else
+      {
+    #  print "use div\n";
+      # can USE_DIV instead
+      *{_mul} = \&_mul_use_div;
+      *{_div} = \&_div_use_div;
+      }
+    }
+  $BASE_LEN-1;
+  }
 
 BEGIN
   {
@@ -43,23 +71,10 @@ BEGIN
     $num = ('9' x ++$e) + 0;
     $num *= $num + 1;
     } until ($num == $num - 1 or $num - 1 == $num - 2);
-  $BASE_LEN = $e-1;
-  $BASE = int("1e".$BASE_LEN);
-  $RBASE = abs('1e-'.$BASE_LEN);       # see USE_MUL
+  _base_len($e-1);
   }
 
 # for quering and setting, to debug/benchmark things
-sub _base_len 
-  {
-  my $b = shift;
-  if (defined $b)
-    {
-    $BASE_LEN = $b;
-    $BASE = int("1e".$BASE_LEN);
-    $RBASE = abs('1e-'.$BASE_LEN);     # see USE_MUL
-    }
-  $BASE_LEN;
-  }
 
 ##############################################################################
 # create objects from various representations
@@ -208,7 +223,7 @@ sub _sub
     }
   }                                                                             
 
-sub _mul
+sub _mul_use_mul
   {
   # (BINT, BINT) return nothing
   # multiply two numbers in internal representation
@@ -252,7 +267,37 @@ sub _mul
   return $xv;
   }                                                                             
 
-sub _div
+sub _mul_use_div
+  {
+  # (BINT, BINT) return nothing
+  # multiply two numbers in internal representation
+  # modifies first arg, second need not be different from first
+  my ($c,$xv,$yv) = @_;
+  my @prod = (); my ($prod,$car,$cty,$xi,$yi);
+  # since multiplying $x with $x fails, make copy in this case
+  $yv = [@$xv] if "$xv" eq "$yv";      # same references?
+  for $xi (@$xv)
+    {
+    $car = 0; $cty = 0;
+    # looping through this if $xi == 0 is silly - so optimize it away!
+    $xi = (shift @prod || 0), next if $xi == 0;
+    for $yi (@$yv)
+      {
+      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+      $prod[$cty++] =
+       $prod - ($car = int($prod / $BASE)) * $BASE;
+      }
+    $prod[$cty] += $car if $car; # need really to check for 0?
+    $xi = shift @prod;
+    }
+  push @$xv, @prod;
+  __strip_zeros($xv);
+  # normalize (handled last to save check for $y->is_zero()
+  return $xv;
+  }                                                                             
+
+sub _div_use_mul
   {
   # ref to array, ref to array, modify first array and return remainder if 
   # in list context
@@ -291,7 +336,8 @@ sub _div
     $u2 = 0 unless $u2;
     #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
     # if $v1 == 0;
-    $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+    # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1));
     --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
     if ($q)
       {
@@ -341,6 +387,96 @@ sub _div
   return $x;
   }
 
+sub _div_use_div
+  {
+  # ref to array, ref to array, modify first array and return remainder if 
+  # in list context
+  # no longer handles sign
+  my ($c,$x,$yorg) = @_;
+  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
+
+  my (@d,$tmp,$q,$u2,$u1,$u0);
+
+  $car = $bar = $prd = 0;
+  
+  my $y = [ @$yorg ];
+  if (($dd = int($BASE/($y->[-1]+1))) != 1) 
+    {
+    for $xi (@$x) 
+      {
+      $xi = $xi * $dd + $car;
+      $xi -= ($car = int($xi / $BASE)) * $BASE;
+      }
+    push(@$x, $car); $car = 0;
+    for $yi (@$y) 
+      {
+      $yi = $yi * $dd + $car;
+      $yi -= ($car = int($yi / $BASE)) * $BASE;
+      }
+    }
+  else 
+    {
+    push(@$x, 0);
+    }
+  @q = (); ($v2,$v1) = @$y[-2,-1];
+  $v2 = 0 unless $v2;
+  while ($#$x > $#$y) 
+    {
+    ($u2,$u1,$u0) = @$x[-3..-1];
+    $u2 = 0 unless $u2;
+    #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
+    # if $v1 == 0;
+    # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1));
+    --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
+    if ($q)
+      {
+      ($car, $bar) = (0,0);
+      for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) 
+        {
+        $prd = $q * $y->[$yi] + $car;
+        $prd -= ($car = int($prd / $BASE)) * $BASE;
+       $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+       }
+      if ($x->[-1] < $car + $bar) 
+        {
+        $car = 0; --$q;
+       for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) 
+          {
+         $x->[$xi] -= $BASE
+          if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE));
+         }
+       }   
+      }
+      pop(@$x); unshift(@q, $q);
+    }
+  if (wantarray) 
+    {
+    @d = ();
+    if ($dd != 1)  
+      {
+      $car = 0; 
+      for $xi (reverse @$x) 
+        {
+        $prd = $car * $BASE + $xi;
+        $car = $prd - ($tmp = int($prd / $dd)) * $dd;
+        unshift(@d, $tmp);
+        }
+      }
+    else 
+      {
+      @d = @$x;
+      }
+    @$x = @q;
+    __strip_zeros($x); 
+    __strip_zeros(\@d);
+    return ($x,\@d);
+    }
+  @$x = @q;
+  __strip_zeros($x); 
+  return $x;
+  }
+
 ##############################################################################
 # shifts
 
@@ -614,9 +750,9 @@ Math::BigInt::Calc - Pure Perl module to support Math::BigInt
 
 =head1 SYNOPSIS
 
-Provides support for big integer calculations. Not intended
-to be used by other modules. Other modules which export the
-same functions can also be used to support Math::Bigint
+Provides support for big integer calculations. Not intended to be used by other
+modules (except Math::BigInt::Cached). Other modules which sport the same
+functions can also be used to support Math::Bigint, like Math::BigInt::Pari.
 
 =head1 DESCRIPTION
 
@@ -625,7 +761,7 @@ was rewritten to use library modules for core math routines. Any
 module which follows the same API as this can be used instead by
 using the following call:
 
-       use Math::BigInt lib => BigNum;
+       use Math::BigInt lib => 'libname';
 
 =head1 EXPORT
 
@@ -670,12 +806,19 @@ the use by Math::BigInt:
                        return 0 for ok, otherwise error message as string
 
 The following functions are optional, and can be defined if the underlying lib
-has a fast way to do them. If not defined, Math::BigInt will use a pure, but
+has a fast way to do them. If undefined, Math::BigInt will use a pure, but
 slow, Perl way as fallback to emulate these:
 
        _from_hex(str)  return ref to new object from ref to hexadecimal string
        _from_bin(str)  return ref to new object from ref to binary string
        
+       _as_hex(str)    return ref to scalar string containing the value as
+                       unsigned hex string, with the '0x' prepended.
+                       Leading zeros must be stripped.
+       _as_bin(str)    Like as_hex, only as binary string containing only
+                       zeros and ones. Leading zeros must be stripped and a
+                       '0b' must be prepended.
+       
        _rsft(obj,N,B)  shift object in base B by N 'digits' right
        _lsft(obj,N,B)  shift object in base B by N 'digits' left
        
@@ -737,7 +880,7 @@ Seperated from BigInt and shaped API with the help of John Peacock.
 
 =head1 SEE ALSO
 
-L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect> and
-L<Math::BigInt::Pari>.
+L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
+L<Math::BigInt::GMP>, L<Math::BigInt::Cached> and L<Math::BigInt::Pari>.
 
 =cut
diff --git a/lib/Math/BigInt/t/Math/Subclass.pm b/lib/Math/BigInt/t/Math/Subclass.pm
new file mode 100644 (file)
index 0000000..c78731c
--- /dev/null
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+
+package Math::Subclass;
+
+require 5.005_02;
+use strict;
+
+use Exporter;
+use Math::BigFloat(1.23);
+use vars qw($VERSION @ISA @EXPORT
+            @EXPORT_OK %EXPORT_TAGS $PACKAGE
+            $accuracy $precision $round_mode $div_scale);
+
+@ISA = qw(Exporter Math::BigFloat);
+
+%EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+@EXPORT = qw(
+);
+$VERSION = 0.01;
+
+# Globals
+$accuracy = $precision = undef;
+$round_mode = 'even';
+$div_scale = 40;
+
+sub new
+{
+        my $proto  = shift;
+        my $class  = ref($proto) || $proto;
+
+        my $value       = shift || 0;   # Set to 0 if not provided
+        my $decimal     = shift;
+        my $radix       = 0;
+
+        # Store the floating point value
+        my $self = bless Math::BigFloat->new($value), $class;
+        $self->{'_custom'} = 1; # make sure this never goes away
+        return $self;
+}
+
+1;
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
new file mode 100644 (file)
index 0000000..9599253
--- /dev/null
@@ -0,0 +1,1026 @@
+#include this file into another test for subclass testing...
+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->finf('$args[1]');";
+      } elsif ($f eq "fnan") {
+        $try .= "\$x->fnan();";
+      } elsif ($f eq "numify") {
+        $try .= "\$x->numify();";
+      } elsif ($f eq "fone") {
+        $try .= "\$x->bone('$args[1]');";
+      } elsif ($f eq "fstr") {
+        $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
+        $try .= '$x->fstr();';
+      } elsif ($f eq "fsstr") {
+        $try .= '$x->fsstr();';
+      } elsif ($f eq "parts") {
+        # ->bstr() to see if a BigFloat is returned
+        $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
+        $try .= '"$a $b";';
+      } elsif ($f eq "length") {
+        $try .= '$x->length();';
+      } elsif ($f eq "exponent") {
+        # ->bstr() to see if a BigFloat is returned
+        $try .= '$x->exponent()->bstr();';
+      } elsif ($f eq "mantissa") {
+        # ->bstr() to see if a BigFloat is returned
+        $try .= '$x->mantissa()->bstr();';
+      } elsif ($f eq "fneg") {
+        $try .= '$x->bneg();';
+      } elsif ($f eq "fnorm") {
+        $try .= '$x->fnorm();';
+      } elsif ($f eq "bfloor") {
+        $try .= '$x->ffloor();';
+      } elsif ($f eq "bceil") {
+        $try .= '$x->fceil();';
+      } elsif ($f eq "is_zero") {
+        $try .= '$x->is_zero();';
+      } elsif ($f eq "is_one") {
+        $try .= '$x->is_one();';
+      } elsif ($f eq "is_positive") {
+        $try .= '$x->is_positive();';
+      } elsif ($f eq "is_negative") {
+        $try .= '$x->is_negative();';
+      } elsif ($f eq "is_odd") {
+        $try .= '$x->is_odd();';
+      } elsif ($f eq "is_even") {
+        $try .= '$x->is_even();';
+      } elsif ($f eq "as_number") {
+        $try .= '$x->as_number();';
+      } elsif ($f eq "fabs") {
+        $try .= '$x->fabs();';
+      } elsif ($f eq "finc") {
+        $try .= '++$x;';
+      } elsif ($f eq "fdec") {
+        $try .= '--$x;';
+      }elsif ($f eq "fround") {
+        $try .= "$setup; \$x->fround($args[1]);";
+      } elsif ($f eq "ffround") {
+        $try .= "$setup; \$x->ffround($args[1]);";
+      } elsif ($f eq "fsqrt") {
+        $try .= "$setup; \$x->fsqrt();";
+      }
+    else
+      {
+      $try .= "\$y = new $class \"$args[1]\";";
+      if ($f eq "fcmp") {
+        $try .= '$x <=> $y;';
+      } elsif ($f eq "facmp") {
+        $try .= '$x->facmp($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 "fmod") {
+        $try .= '$x % $y;';
+      } else { warn "Unknown op '$f'"; }
+    }
+    $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")
+         {
+         #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 new() for BigInts destroys them ($y == 12 in this case)
+$x = Math::BigInt->new(1200); $y = $class->new($x);
+ok ($y,1200); ok ($x,1200);
+
+###############################################################################
+# fdiv() in list context
+$x = $class->bzero(); ($x,$y) = $x->fdiv(0);
+ok ($x,'NaN'); ok ($y,'NaN');
+
+# fdiv() in list context
+$x = $class->bzero(); ($x,$y) = $x->fdiv(1);
+ok ($x,0); ok ($y,0);
+
+# 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__
+&fnorm
+1:1
+-0:0
+fnormNaN:NaN
++inf:inf
+-inf:-inf
+123:123
+-123.4567:-123.4567
+&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
+# 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
+&finc
+fincNaN:NaN
++inf:inf
+-inf:-inf
++0:1
++1:2
+-1:0
+1.23:2.23
+-1.23:-0.23
+&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
+$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
+$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
+# 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
+# reset scale for further tests
+$div_scale = 40
+&fmod
++0:0:NaN
++0:1:0
++3:1:0
+#+5:2:1
+#+9:4:1
+#+9:5:4
+#+9000:56:40
+#+56:9000:56
+&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
++16:4
++100:10
++123.456:11.11107555549866648462149404118219234119
++15241.38393:123.4559999756998444766131352122991626468
++1.44:1.2
+&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_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
+&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
+&bfloor
+0:0
+abc:NaN
++inf:inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-52
+12.2:12
+&bceil
+0:0
+abc:NaN
++inf:inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-51
+12.2:13
index 0ee6ff3..dd85adc 100755 (executable)
@@ -6,908 +6,17 @@ use strict;
 BEGIN
   {
   $| = 1;
-  unshift @INC, '../lib'; # for running manually
+  unshift @INC, '../../lib'; # for running manually
+  my $location = $0; $location =~ s/bigfltpm.t//;
+  unshift @INC, $location; # to locate the testing files
   # chdir 't' if -d 't';
-  plan tests => 1162;
+  plan tests => 1273;
   }
 
 use Math::BigInt;
 use Math::BigFloat;
 
-my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
-while (<DATA>)
-  {
-  chop;
-  $_ =~ s/#.*$//;      # remove comments
-  $_ =~ s/\s+$//;      # trailing spaces
-  next if /^$/;                # skip empty lines & comments
-  if (s/^&//)
-    {
-    $f = $_;
-    }
-  elsif (/^\$/)
-    {
-    $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/;  # rnd_mode, div_scale 
-    # print "$setup\n";
-    }
-  else
-    {
-    if (m|^(.*?):(/.+)$|)
-      {
-      $ans = $2;
-      @args = split(/:/,$1,99);
-      }
-    else
-      {
-      @args = split(/:/,$_,99); $ans = pop(@args);
-      }
-    $try = "\$x = new Math::BigFloat \"$args[0]\";";
-    if ($f eq "fnorm")
-      {
-        $try .= "\$x;";
-      } elsif ($f eq "binf") {
-        $try .= "\$x->binf('$args[1]');";
-      } elsif ($f eq "bnan") {
-        $try .= "\$x->bnan();";
-      } elsif ($f eq "numify") {
-        $try .= "\$x->numify();";
-      } elsif ($f eq "bone") {
-        $try .= "\$x->bone('$args[1]');";
-      } elsif ($f eq "bstr") {
-        $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
-        $try .= '$x->bstr();';
-      } elsif ($f eq "bsstr") {
-        $try .= '$x->bsstr();';
-      } elsif ($f eq "parts") {
-        $try .= '($a,$b) = $x->parts(); "$a $b";';
-      } elsif ($f eq "fneg") {
-        $try .= '$x->bneg();';
-      } elsif ($f eq "bfloor") {
-        $try .= "\$x->bfloor();";
-      } elsif ($f eq "bceil") {
-        $try .= "\$x->bceil();";
-      } elsif ($f eq "is_zero") {
-        $try .= "\$x->is_zero()+0;";
-      } elsif ($f eq "is_one") {
-        $try .= "\$x->is_one()+0;";
-      } elsif ($f eq "is_positive") {
-        $try .= "\$x->is_positive()+0;";
-      } elsif ($f eq "is_negative") {
-        $try .= "\$x->is_negative()+0;";
-      } elsif ($f eq "is_odd") {
-        $try .= "\$x->is_odd()+0;";
-      } elsif ($f eq "is_even") {
-        $try .= "\$x->is_even()+0;";
-      } elsif ($f eq "as_number") {
-        $try .= "\$x->as_number();";
-      } elsif ($f eq "fabs") {
-        $try .= '$x->babs();';
-      } elsif ($f eq "finc") {
-        $try .= '++$x;';
-      } elsif ($f eq "fdec") {
-        $try .= '--$x;'; 
-      }elsif ($f eq "fround") {
-        $try .= "$setup; \$x->fround($args[1]);";
-      } elsif ($f eq "ffround") {
-        $try .= "$setup; \$x->ffround($args[1]);";
-      } elsif ($f eq "fsqrt") {
-        $try .= "$setup; \$x->fsqrt();";
-      }
-    else
-      {
-      $try .= "\$y = new Math::BigFloat \"$args[1]\";";
-      if ($f eq "fcmp") {
-        $try .= "\$x <=> \$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 "fmod") {
-        $try .= "\$x % \$y;";
-      } else { warn "Unknown op '$f'"; }
-    }
-    $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 'Math::BigFloat')
-         {
-         #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 new() for BigInts destroys them ($y == 12 in this case)
-$x = Math::BigInt->new(1200); $y = Math::BigFloat->new($x);
-ok ($y,1200); ok ($x,1200);
-
-# 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');
-  }
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+$class = "Math::BigFloat";
    
-__END__
-&as_number
-0:0
-1:1
-1.2:1
-2.345:2
--2:-2
--123.456:-123
--200:-200
-&binf
-1:+:inf
-2:-:-inf
-3:abc:inf
-&numify
-0:0e+1
-+1:1e+0
-1234:1234e+0
-NaN:NaN
-+inf:inf
--inf:-inf
-&bnan
-abc:NaN
-2:NaN
--2:NaN
-0:NaN
-&bone
-2:+:1
--2:-:-1
--2:+:1
-2:-:-1
-0::1
--2::1
-abc::1
-2:abc:1
-&bsstr
-+inf:inf
--inf:-inf
-abcbsstr:NaN
-1234.567:1234567e-3
-&bstr
-+inf:::inf
--inf:::-inf
-abcbsstr:::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
-+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
-$rnd_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
-$rnd_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
-$rnd_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
-$rnd_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
-$rnd_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
-$rnd_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
-$rnd_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.23
-+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.0061:-1:0
--0.00612:-1:0
--0.00612:-2:0
--0.006:-1:0
--0.006:-2:0
--0.0006:-2:0
--0.0006:-3:0
--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
-$rnd_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.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
-$rnd_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.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
-$rnd_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.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
-$rnd_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.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
-$rnd_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.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.01234567
-0.01234567:-12:0.01234567
-&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:
-&fdec
-fdecNaN:NaN
-+inf:inf
--inf:-inf
-+0:-1
-+1:0
--1:-2
-1.23:0.23
--1.23:-2.23
-&finc
-fincNaN:NaN
-+inf:inf
--inf:-inf
-+0:1
-+1:2
--1:0
-1.23:2.23
--1.23:-0.23
-&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
-$div_scale = 40; $Math::BigFloat::rnd_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
-$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
-# 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
-# reset scale for further tests
-$div_scale = 40
-&fmod
-+0:0:NaN
-+0:1:0
-+3:1:0
-#+5:2:1
-#+9:4:1
-#+9:5:4
-#+9000:56:40
-#+56:9000:56
-&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
-+16:4
-+100:10
-+123.456:11.11107555549866648462149404118219234119
-+15241.38393:123.4559999756998444766131352122991626468
-+1.44:1.2
-&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_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
-&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
-&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
-&bfloor
-0:0
-abc:NaN
-+inf:inf
--inf:-inf
-1:1
--51:-51
--51.2:-52
-12.2:12
-&bceil
-0:0
-abc:NaN
-+inf:inf
--inf:-inf
-1:1
--51:-51
--51.2:-51
-12.2:13
+require 'bigfltpm.inc';        # all tests here for sharing
index e33e028..eb1b43f 100755 (executable)
@@ -8,9 +8,9 @@ BEGIN
   $| = 1;
   # chdir 't' if -d 't';
   unshift @INC, '../lib'; # for running manually
-  plan tests => 1447;
+  plan tests => 1457;
   }
-my $version = '1.42';  # for $VERSION tests, match current release (by hand!)
+my $version = '1.43';  # for $VERSION tests, match current release (by hand!)
 
 ##############################################################################
 # for testing inheritance of _swap
@@ -72,25 +72,25 @@ while (<DATA>)
     $ans = pop(@args);
     $try = "\$x = Math::BigInt->new(\"$args[0]\");";
     if ($f eq "bnorm"){
-      # $try .= '$x+0;';
+      $try = "\$x = Math::BigInt::bnorm(\"$args[0]\");";
     } elsif ($f eq "is_zero") {
-      $try .= '$x->is_zero()+0;';
+      $try .= '$x->is_zero();';
     } elsif ($f eq "is_one") {
-      $try .= '$x->is_one()+0;';
+      $try .= '$x->is_one();';
     } elsif ($f eq "is_odd") {
-      $try .= '$x->is_odd()+0;';
+      $try .= '$x->is_odd();';
     } elsif ($f eq "is_even") {
-      $try .= '$x->is_even()+0;';
+      $try .= '$x->is_even();';
     } elsif ($f eq "is_negative") {
-      $try .= '$x->is_negative()+0;';
+      $try .= '$x->is_negative();';
     } elsif ($f eq "is_positive") {
-      $try .= '$x->is_positive()+0;';
+      $try .= '$x->is_positive();';
     } elsif ($f eq "as_hex") {
       $try .= '$x->as_hex();';
     } elsif ($f eq "as_bin") {
       $try .= '$x->as_bin();';
     } elsif ($f eq "is_inf") {
-      $try .= "\$x->is_inf('$args[1]')+0;";
+      $try .= "\$x->is_inf('$args[1]');";
     } elsif ($f eq "binf") {
       $try .= "\$x->binf('$args[1]');";
     } elsif ($f eq "bone") {
@@ -116,13 +116,16 @@ while (<DATA>)
     }elsif ($f eq "bsqrt") {
       $try .= '$x->bsqrt();';
     }elsif ($f eq "length") {
-      $try .= "\$x->length();";
+      $try .= '$x->length();';
     }elsif ($f eq "exponent"){
+      # ->bstr() to see if a BigInt is returned
       $try .= '$x = $x->exponent()->bstr();';
     }elsif ($f eq "mantissa"){
+      # ->bstr() to see if a BigInt is returned
       $try .= '$x = $x->mantissa()->bstr();';
     }elsif ($f eq "parts"){
-      $try .= "(\$m,\$e) = \$x->parts();"; 
+      $try .= '($m,$e) = $x->parts();'; 
+      # ->bstr() to see if a BigInt is returned
       $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
       $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
       $try .= '"$m,$e";';
@@ -133,19 +136,19 @@ while (<DATA>)
       }elsif ($f eq "bround") {
       $try .= "$round_mode; \$x->bround(\$y);";
       }elsif ($f eq "bacmp"){
-        $try .= "\$x->bacmp(\$y);";
+        $try .= '$x->bacmp($y);';
       }elsif ($f eq "badd"){
-        $try .= "\$x + \$y;";
+        $try .= '$x + $y;';
       }elsif ($f eq "bsub"){
-        $try .= "\$x - \$y;";
+        $try .= '$x - $y;';
       }elsif ($f eq "bmul"){
-        $try .= "\$x * \$y;";
+        $try .= '$x * $y;';
       }elsif ($f eq "bdiv"){
-        $try .= "\$x / \$y;";
+        $try .= '$x / $y;';
       }elsif ($f eq "bdiv-list"){
         $try .= 'join (",",$x->bdiv($y));';
       }elsif ($f eq "bmod"){
-        $try .= "\$x % \$y;";
+        $try .= '$x % $y;';
       }elsif ($f eq "bgcd")
         {
         if (defined $args[2])
@@ -204,7 +207,7 @@ while (<DATA>)
       }
     else
       {
-      #print "try: $try ans: $ans1 $ans\n";
+      # print "try: $try ans: $ans1 $ans\n";
       print "# Tried: '$try'\n" if !ok ($ans1, $ans);
       }
     # check internal state of number objects
@@ -483,9 +486,11 @@ ok ($args[4],7); ok (ref($args[4]),'');
 # test for floating-point input (other tests in bnorm() below)
 
 $z = 1050000000000000;          # may be int on systems with 64bit?
-$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13');        # not 1.03e+15
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13');        # not 1.05e+15
 $z = 1e+129;                   # definitely a float (may fail on UTS)
-$x = Math::BigInt->new($z); ok ($x->bsstr(),$z);
+# don't compare to $z, since some Perl versions stringify $z into something
+# like '1.e+129' or something equally ugly
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'1e+129');
 
 ###############################################################################
 # prime number tests, also test for **= and length()
@@ -534,11 +539,10 @@ ok (ref($x),'Math::Foo');
 # Test whether +inf eq inf
 # This tried to test whether BigInt inf equals Perl inf. Unfortunately, Perl
 # hasn't (before 5.7.3 at least) a consistent way to say inf, and some things
-# like 1e100000 crash on some platforms. So simple test for 'inf'
+# like 1e100000 crash on some platforms. So simple test for the string 'inf'
 $x = Math::BigInt->new('+inf'); ok ($x,'inf');
 
-###############################################################################
-# all tests done
+### all tests done ############################################################
 
 ###############################################################################
 # Perl 5.005 does not like ok ($x,undef)
@@ -667,6 +671,7 @@ NaN:-inf:
 0x1_2_3_4_56_78:305419896
 0x_123:NaN
 # inf input
+inf:inf
 +inf:inf
 -inf:-inf
 0inf:NaN
@@ -1047,6 +1052,7 @@ abc:+1:abc:NaN
 4:-3:-2
 123:+inf:0
 123:-inf:0
+10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576
 &bmod
 abc:abc:NaN
 abc:+1:abc:NaN
@@ -1204,6 +1210,8 @@ abc:NaN
 123:123
 -1:-1
 -2:-2
++inf:inf
+-inf:-inf
 &exponent
 abc:NaN
 1e4:4
@@ -1212,6 +1220,8 @@ abc:NaN
 -1:0
 -2:0
 0:1
++inf:inf
+-inf:inf
 &parts
 abc:NaN,NaN
 1e4:1,4
@@ -1220,6 +1230,8 @@ abc:NaN,NaN
 -1:-1,0
 -2:-2,0
 0:0,1
++inf:inf,inf
+-inf:-inf,inf
 &bpow
 abc:12:NaN
 12:abc:NaN
diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t
new file mode 100644 (file)
index 0000000..4559d43
--- /dev/null
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+# test calling conventions
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 100;
+  }
+
+package Math::BigInt::Test;
+
+use Math::BigInt;
+use vars qw/@ISA/;
+@ISA = qw/Math::BigInt/;               # child of MBI
+use overload;
+
+package Math::BigFloat::Test;
+
+use Math::BigFloat;
+use vars qw/@ISA/;
+@ISA = qw/Math::BigFloat/;             # child of MBI
+use overload;
+
+package main;
+
+use Math::BigInt;
+use Math::BigFloat;
+
+my ($x,$y,$z,$u);
+
+###############################################################################
+# check whether op's accept normal strings, even when inherited by subclasses
+
+# do one positive and one negative test to avoid false positives by "accident"
+
+my ($func,@args,$ans,$rc,$class,$try);
+while (<DATA>)
+  {
+  chop;
+  next if /^#/; # skip comments
+  if (s/^&//)
+    {
+    $func = $_;
+    }
+  else
+    {
+    @args = split(/:/,$_,99);
+    $ans = pop @args;
+    foreach $class (qw/
+      Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
+      {
+      $try = "$class\->$func('$args[0]');";
+      $rc = eval $try;
+      print "# Tried: '$try'\n" if !ok ($rc, $ans);
+      }
+    } 
+
+  }
+
+# 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');
+  }
+
+__END__
+&is_zero
+1:0
+0:1
+&is_one
+1:1
+0:0
+&is_positive
+1:1
+-1:0
+&is_negative
+1:0
+-1:1
+&is_nan
+abc:1
+1:0
+&is_inf
+inf:1
+0:0
+&bstr
+5:5
+10:10
+abc:NaN
++inf:inf
+-inf:-inf
+&bsstr
+1:1e+0
+0:0e+1
+2:2e+0
+200:2e+2
+&babs
+-1:1
+1:1
+&bnot
+-2:1
+1:-2
index 51cf41b..e5b6f36 100644 (file)
@@ -1,6 +1,7 @@
 #!/usr/bin/perl -w
 
-# test accuracy, precicion and fallback, round_mode
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes
 
 use strict;
 use Test;
@@ -10,9 +11,59 @@ BEGIN
   $| = 1;
   # chdir 't' if -d 't';
   unshift @INC, '../lib'; # for running manually
-  plan tests => 103;
+  plan tests => 246;
   }
 
+# for finding out whether round finds correct class
+package Foo;
+
+use Math::BigInt;
+use vars qw/@ISA $precision $accuracy $div_scale $round_mode/;
+@ISA = qw/Math::BigInt/;
+
+$precision = 6;
+$accuracy = 8;
+$div_scale = 5;
+$round_mode = 'odd';
+
+sub new
+  {
+  my $class = shift; 
+  my $self = { _a => undef, _p => undef, value => 5 };
+  bless $self, $class;
+  }
+
+sub bstr
+  { 
+  my $self = shift;
+
+  return "$self->{value}";
+  }
+
+# these will be called with the rounding precision or accuracy, depending on
+# class
+sub bround
+  {
+  my ($self,$a,$r) = @_;
+  $self->{value} = 'a' x $a;
+  return $self;
+  }
+
+sub bnorm
+  {
+  my $self = shift;
+  return $self;
+  }
+
+sub bfround
+  {
+  my ($self,$p,$r) = @_;
+  $self->{value} = 'p' x $p;
+  return $self;
+  }
+
+package main;
+
 use Math::BigInt;
 use Math::BigFloat;
 
@@ -23,14 +74,45 @@ my ($x,$y,$z,$u);
 
 ok_undef ($Math::BigInt::accuracy);
 ok_undef ($Math::BigInt::precision);
+ok_undef (Math::BigInt->accuracy());
+ok_undef (Math::BigInt->precision());
 ok ($Math::BigInt::div_scale,40);
+ok (Math::BigInt::div_scale(),40);
+ok ($Math::BigInt::round_mode,'even');
 ok (Math::BigInt::round_mode(),'even');
-ok ($Math::BigInt::rnd_mode,'even');
 
 ok_undef ($Math::BigFloat::accuracy);
 ok_undef ($Math::BigFloat::precision);
+ok_undef (Math::BigFloat->accuracy());
+ok_undef (Math::BigFloat->precision());
 ok ($Math::BigFloat::div_scale,40);
-ok ($Math::BigFloat::rnd_mode,'even');
+ok (Math::BigFloat::div_scale(),40);
+ok ($Math::BigFloat::round_mode,'even');
+ok (Math::BigFloat::round_mode(),'even');
+
+# accessors
+foreach my $class (qw/Math::BigInt Math::BigFloat/)
+  {
+  ok_undef ($class->accuracy());
+  ok_undef ($class->precision());
+  ok ($class->round_mode(),'even');
+  ok ($class->div_scale(),40);
+   
+  ok ($class->div_scale(20),20);
+  $class->div_scale(40); ok ($class->div_scale(),40);
+  
+  ok ($class->round_mode('odd'),'odd');
+  $class->round_mode('even'); ok ($class->round_mode(),'even');
+  
+  ok ($class->accuracy(2),2);
+  $class->accuracy(3); ok ($class->accuracy(),3);
+  ok_undef ($class->accuracy(undef));
+
+  ok ($class->precision(2),2);
+  ok ($class->precision(-2),-2);
+  $class->precision(3); ok ($class->precision(),3);
+  ok_undef ($class->precision(undef));
+  }
 
 # accuracy
 foreach (qw/5 42 -1 0/)
@@ -61,12 +143,12 @@ foreach (qw/5 42 1/)
 # round_mode
 foreach (qw/odd even zero trunc +inf -inf/)
   {
-  ok ($Math::BigFloat::rnd_mode = $_,$_);
-  ok ($Math::BigInt::rnd_mode = $_,$_);
+  ok ($Math::BigFloat::round_mode = $_,$_);
+  ok ($Math::BigInt::round_mode = $_,$_);
   }
-$Math::BigFloat::rnd_mode = 4;
-ok ($Math::BigFloat::rnd_mode,4);
-ok ($Math::BigInt::rnd_mode,'-inf');   # from above
+$Math::BigFloat::round_mode = 'zero';
+ok ($Math::BigFloat::round_mode,'zero');
+ok ($Math::BigInt::round_mode,'-inf'); # from above
 
 $Math::BigInt::accuracy = undef;
 $Math::BigInt::precision = undef;
@@ -138,9 +220,22 @@ $y = $x->copy()->round(undef,2);
 ok ($y->precision(),2);
 ok_undef ($y->accuracy());             # P has precedence, so A still unset
 
+# see if setting A clears P and vice versa
+$x = Math::BigFloat->new(123.4567);
+ok ($x,123.4567);                      
+ok ($x->accuracy(4),4);
+ok ($x->precision(-2),-2);             # clear A
+ok_undef ($x->accuracy());
+
+$x = Math::BigFloat->new(123.4567);
+ok ($x,123.4567);                      
+ok ($x->precision(-2),-2);
+ok ($x->accuracy(4),4);                        # clear P
+ok_undef ($x->precision());
+
 # does copy work?
 $x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
-$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2);
+$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
 
 ###############################################################################
 # test wether operations round properly afterwards
@@ -157,6 +252,7 @@ $z = $y - $x;               ok ($z,530.9);
 $z = $y * $x;          ok ($z,80780);
 $z = $x ** 2;          ok ($z,15241);
 $z = $x * $x;          ok ($z,15241);
+
 # not: $z = -$x;               ok ($z,-123.46); ok ($x,123.456);
 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
 $x = Math::BigFloat->new(123456); $x->{_a} = 4;
@@ -175,6 +271,18 @@ $z = $x ** 2;              ok ($z,15241000000);
 $z = $x->copy; $z++;   ok ($z,123460);
 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
 
+$x = Math::BigInt->new(123400); $x->{_a} = 4;
+ok ($x->bnot(),-123400);                       # not -1234001
+
+# both babs() and bneg() don't need to round, since the input will already
+# be rounded (either as $x or via new($string)), and they don't change the
+# value
+# The two tests below peek at this by using _a illegally
+$x = Math::BigInt->new(-123401); $x->{_a} = 4;
+ok ($x->babs(),123401);
+$x = Math::BigInt->new(-123401); $x->{_a} = 4;
+ok ($x->bneg(),123401);
+
 ###############################################################################
 # test mixed arguments
 
@@ -199,6 +307,229 @@ $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
 # $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
 # $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
 
+###############################################################################
+# rounding in bdiv with fallback and already set A or P
+
+$Math::BigFloat::accuracy = undef;
+$Math::BigFloat::precision = undef;
+$Math::BigFloat::div_scale = 40;
+
+$x = Math::BigFloat->new(10); $x->{_a} = 4;
+ok ($x->bdiv(3),'3.333');
+ok ($x->{_a},4);                       # set's it since no fallback
+
+$x = Math::BigFloat->new(10); $x->{_a} = 4; $y = Math::BigFloat->new(3);
+ok ($x->bdiv($y),'3.333');
+ok ($x->{_a},4);                       # set's it since no fallback
+
+# rounding to P of x
+$x = Math::BigFloat->new(10); $x->{_p} = -2;
+ok ($x->bdiv(3),'3.33');
+
+# round in div with requested P
+$x = Math::BigFloat->new(10);
+ok ($x->bdiv(3,undef,-2),'3.33');
+
+# round in div with requested P greater than fallback
+$Math::BigFloat::div_scale = 5;
+$x = Math::BigFloat->new(10);
+ok ($x->bdiv(3,undef,-8),'3.33333333');
+$Math::BigFloat::div_scale = 40;
+
+$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_a} = 4;
+ok ($x->bdiv($y),'3.333');
+ok ($x->{_a},4); ok ($y->{_a},4);      # set's it since no fallback
+ok_undef ($x->{_p}); ok_undef ($y->{_p});
+
+# rounding to P of y
+$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_p} = -2;
+ok ($x->bdiv($y),'3.33');
+ok ($x->{_p},-2);
+ ok ($y->{_p},-2);
+ok_undef ($x->{_a}); ok_undef ($y->{_a});
+
+###############################################################################
+# test whether bround(-n) fails in MBF (undocumented in MBI)
+eval { $x = Math::BigFloat->new(1); $x->bround(-2); };
+ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
+
+# test whether rounding to higher accuracy is no-op
+$x = Math::BigFloat->new(1); $x->{_a} = 4;
+ok ($x,'1.000');
+$x->bround(6);                  # must be no-op
+ok ($x->{_a},4);
+ok ($x,'1.000');
+
+$x = Math::BigInt->new(1230); $x->{_a} = 3;
+ok ($x,'1230');
+$x->bround(6);                  # must be no-op
+ok ($x->{_a},3);
+ok ($x,'1230');
+
+# bround(n) should set _a
+$x->bround(2);                  # smaller works
+ok ($x,'1200');
+ok ($x->{_a},2);
+# bround(-n) is undocumented and only used by MBF
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345);
+$x->bround(-1);
+ok ($x,'12300');
+ok ($x->{_a},4);
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345);
+$x->bround(-2);
+ok ($x,'12000');
+ok ($x->{_a},3);
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(-3);
+ok ($x,'10000');
+ok ($x->{_a},2);
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(-4);
+ok ($x,'00000');
+ok ($x->{_a},1);
+
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(12345);
+$x->bround(-5);
+ok ($x,'0');                   # scale to "big" => 0
+ok ($x->{_a},0);
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(54321);
+$x->bround(-5);
+ok ($x,'100000');              # used by MBF to round 0.0054321 at 0.0_6_00000
+ok ($x->{_a},0);
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(54321); $x->{_a} = 5;
+$x->bround(-6);
+ok ($x,'100000');              # no-op
+ok ($x->{_a},0);
+# bround(n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(5);                  # must be no-op
+ok ($x,'12345');
+ok ($x->{_a},5);
+# bround(n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(6);                  # must be no-op
+ok ($x,'12345');
+
+$x = Math::BigFloat->new(0.0061); $x->bfround(-2);
+ok ($x,0.01);
+
+###############################################################################
+# rounding with already set precision/accuracy
+
+$x = Math::BigFloat->new(1); $x->{_p} = -5;
+ok ($x,'1.00000');
+
+# further rounding donw
+ok ($x->bfround(-2),'1.00');
+ok ($x->{_p},-2);
+
+$x = Math::BigFloat->new(12345); $x->{_a} = 5;
+ok ($x->bround(2),'12000');
+ok ($x->{_a},2);
+
+$x = Math::BigFloat->new(1.2345); $x->{_a} = 5;
+ok ($x->bround(2),'1.2');
+ok ($x->{_a},2);
+
+# mantissa/exponent format and A/P
+$x = Math::BigFloat->new(12345.678); $x->accuracy(4);
+ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
+ok ($x->{_m}->{_f},1); ok ($x->{_e}->{_f},1);
+ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
+ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
+
+# check for no A/P in case of fallback
+# result
+$x = Math::BigFloat->new(100) / 3;
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+# result & reminder
+$x = Math::BigFloat->new(100) / 3; ($x,$y) = $x->bdiv(3);
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ok_undef ($y->{_a}); ok_undef ($y->{_p});
+
+###############################################################################
+# math with two numbers with differen A and P
+
+$x = Math::BigFloat->new(12345); $x->accuracy(4);      # '12340'
+$y = Math::BigFloat->new(12345); $y->accuracy(2);      # '12000'
+ok ($x+$y,24000);                              # 12340+12000=> 24340 => 24000
+
+$x = Math::BigFloat->new(54321); $x->accuracy(4);      # '12340'
+$y = Math::BigFloat->new(12345); $y->accuracy(3);      # '12000'
+ok ($x-$y,42000);                              # 54320+12300=> 42020 => 42000
+
+$x = Math::BigFloat->new(1.2345); $x->precision(-2);   # '1.23'
+$y = Math::BigFloat->new(1.2345); $y->precision(-4);   # '1.2345'
+ok ($x+$y,2.46);                       # 1.2345+1.2300=> 2.4645 => 2.46
+
+###############################################################################
+# round should find and use proper class
+
+$x = Foo->new();
+ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
+ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
+ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
+ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
+
+###############################################################################
+# find out whether _find_round_parameters is doing what's it's supposed to do
+$Math::BigInt::accuracy = undef;
+$Math::BigInt::precision = undef;
+$Math::BigInt::div_scale = 40;
+$Math::BigInt::round_mode = 'odd';
+$x = Math::BigInt->new(123);
+my @params = $x->_find_round_parameters();
+ok (scalar @params,1);                         # nothing to round
+
+@params = $x->_find_round_parameters(1);
+ok (scalar @params,4);                         # a=1
+ok ($params[0],$x);                            # self
+ok ($params[1],1);                             # a
+ok_undef ($params[2]);                         # p
+ok ($params[3],'odd');                         # round_mode
+
+@params = $x->_find_round_parameters(undef,2);
+ok (scalar @params,4);                         # p=2
+ok ($params[0],$x);                            # self
+ok_undef ($params[1]);                         # a
+ok ($params[2],2);                             # p
+ok ($params[3],'odd');                         # round_mode
+
+eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
+ok ($@ =~ /^Unknown round mode 'foo'/,1);
+
+@params = $x->_find_round_parameters(undef,2,'+inf');
+ok (scalar @params,4);                         # p=2
+ok ($params[0],$x);                            # self
+ok_undef ($params[1]);                         # a
+ok ($params[2],2);                             # p
+ok ($params[3],'+inf');                                # round_mode
+
+@params = $x->_find_round_parameters(2,-2,'+inf');
+ok (scalar @params,4);                         # p=2
+ok ($params[0],$x);                            # self
+ok ($params[1],2);                             # a
+ok ($params[2],-2);                            # p
+ok ($params[3],'+inf');                                # round_mode
+
 # all done
 
 ###############################################################################
diff --git a/lib/Math/BigInt/t/subclass.t b/lib/Math/BigInt/t/subclass.t
new file mode 100644 (file)
index 0000000..332d0c8
--- /dev/null
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+  {
+  $| = 1;
+  unshift @INC, '../lib';      # for running manually
+  my $location = $0; $location =~ s/subclass.t//;
+  unshift @INC, $location; # to locate the testing files
+  #chdir 't' if -d 't';
+  plan tests => 1277;
+  }
+
+use Math::BigInt;
+use Math::Subclass;
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+$class = "Math::Subclass";
+
+require 'bigfltpm.inc';        # perform same tests as bigfltpm
+
+# Now do custom tests for Subclass itself
+my $ms = new Math::Subclass 23;
+print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
+
+use Math::BigFloat;
+
+my $bf = new Math::BigFloat 23;        # same as other
+$ms += $bf;
+print "# Tried: \$ms += \$bf, got $ms" if !ok (46, $ms);
+print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
+print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));
index 0e783de..308af04 100644 (file)
@@ -5,7 +5,7 @@ require Exporter;
 use strict;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(Complete);
-our $VERSION = '1.3';
+our $VERSION = '1.4';
 
 #      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91
 
@@ -24,8 +24,7 @@ This routine provides word completion on the list of words in
 the array (or array ref).
 
 The tty driver is put into raw mode and restored using an operating
-system specific command, in UNIX-like environments C<stty raw -echo>
-and C<stty -raw echo>.
+system specific command, in UNIX-like environments C<stty>.
 
 The following command characters are defined:
 
@@ -67,16 +66,18 @@ Wayne Thompson
 
 =cut
 
-our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore);
+our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty);
+our($tty_saved_state) = '';
 CONFIG: {
     $complete = "\004";
     $kill     = "\025";
     $erase1 =   "\177";
     $erase2 =   "\010";
-    foreach my $stty (qw(/bin/stty /usr/bin/stty)) {
-       if (-x $stty) {
-           $tty_raw_noecho = "$stty raw -echo";
-           $tty_restore    = "$stty -raw echo";
+    foreach my $s (qw(/bin/stty /usr/bin/stty)) {
+       if (-x $s) {
+           $tty_raw_noecho = "$s raw -echo";
+           $tty_restore    = "$s -raw echo";
+           $stty = $s;
            last;
        }
     }
@@ -97,6 +98,17 @@ sub Complete {
        @cmp_lst = sort(@_);
     }
 
+    # Attempt to save the current stty state, to be restored later
+    if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') {
+       $tty_saved_state = qx($stty -g 2>/dev/null);
+       if ($?) {
+           # stty -g not supported
+           $tty_saved_state = undef;
+       }
+       else {
+           $tty_restore = qq($stty "$tty_saved_state");
+       }
+    }
     system $tty_raw_noecho if defined $tty_raw_noecho;
     LOOP: {
         print($prompt, $return);
index bfff3fb..81253cc 100644 (file)
@@ -7,69 +7,66 @@ BEGIN {
 
 use warnings;
 use Test::More tests => 8;
-use vars qw( $Term::Complete::complete $complete );
-my $restore;
+use vars qw( $Term::Complete::complete $complete $Term::Complete::stty );
 
 SKIP: {
-    skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST} or !(-t STDIN);
+    skip('PERL_SKIP_TTY_TEST', 8) if $ENV{PERL_SKIP_TTY_TEST};
     
-    my $TTY;
-    if ($^O eq 'rhapsody' && -c "/dev/ttyp0") { $TTY = "/dev/ttyp0" }
-    elsif (-c "/dev/tty")                     { $TTY = "/dev/tty"   }
-    if (defined $TTY) {
-       open(TTY, $TTY)               or die "open $TTY failed: $!";
-       skip("$TTY not a tty", 8)     if defined $TTY && ! -t TTY;
-       $restore = `stty -g`;
-       skip("Can't reliably restore $TTY", 8) if $?;
-    }
-
-use_ok( 'Term::Complete' );
-
-*complete = \$Term::Complete::complete;
-
-my $in = tie *STDIN, 'FakeIn', "fro\t";
-my $out = tie *STDOUT, 'FakeOut';
-my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
-
-Complete('', \@words);
-my $data = get_expected('fro', @words);
-
-# there should be an \a after our word
-like( $$out, qr/fro\a/, 'found bell character' );
-
-# now remove the \a -- there should be only one
-is( $out->scrub(), 1, '(single) bell removed');
-
-# 'fro' should match all three words
-like( $$out, qr/$data/, 'all three words possible' );
-$out->clear();
-
-# should only find 'frobnitz' and 'frobozz'
-$in->add('frob');
-Complete('', @words);
-$out->scrub();
-is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
-$out->clear();
-
-# should only do 'frobozz'
-$in->add('frobo');
-Complete('', @words);
-$out->scrub();
-is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
-$out->clear();
-
-# change the completion character
-$complete = "!";
-$in->add('frobn');
-Complete('prompt:', @words);
-$out->scrub();
-like( $$out, qr/prompt:frobn/, 'prompt is okay' );
-
-# now remove the prompt and we should be okay
-$$out =~ s/prompt://g;
-is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' );
-
-`stty $restore` if defined $restore;
+    use_ok( 'Term::Complete' );
+  
+    # this skips tests AND prevents the "used only once" warning
+    skip('No stty, Term::Complete will not run here', 8)
+       unless defined $Term::Complete::tty_raw_noecho &&
+              defined $Term::Complete::tty_restore;
+
+    # also prevent Term::Complete from running stty and messing up the terminal
+    undef $Term::Complete::tty_restore;
+    undef $Term::Complete::tty_raw_noecho;
+    undef $Term::Complete::stty;
+
+    *complete = \$Term::Complete::complete;
+
+    my $in = tie *STDIN, 'FakeIn', "fro\t";
+    my $out = tie *STDOUT, 'FakeOut';
+    my @words = ( 'frobnitz', 'frobozz', 'frostychocolatemilkshakes' );
+
+    Complete('', \@words);
+    my $data = get_expected('fro', @words);
+    
+    # there should be an \a after our word
+    like( $$out, qr/fro\a/, 'found bell character' );
+
+    # now remove the \a -- there should be only one
+    is( $out->scrub(), 1, '(single) bell removed');
+
+    # 'fro' should match all three words
+    like( $$out, qr/$data/, 'all three words possible' );
+    $out->clear();
+
+    # should only find 'frobnitz' and 'frobozz'
+    $in->add('frob');
+    Complete('', @words);
+    $out->scrub();
+    is( $$out, get_expected('frob', 'frobnitz', 'frobozz'), 'expected frob*' );
+    $out->clear();
+
+    # should only do 'frobozz'
+    $in->add('frobo');
+    Complete('', @words);
+    $out->scrub();
+    is( $$out, get_expected( 'frobo', 'frobozz' ), 'only frobozz possible' );
+    $out->clear();
+
+    # change the completion character
+    $complete = "!";
+    $in->add('frobn');
+    Complete('prompt:', @words);
+    $out->scrub();
+    like( $$out, qr/prompt:frobn/, 'prompt is okay' );
+
+    # now remove the prompt and we should be okay
+    $$out =~ s/prompt://g;
+    is( $$out, get_expected('frobn', 'frobnitz' ), 'works with new $complete' );
 
 } # end of SKIP, end of tests
 
index 1b26c89..912edae 100644 (file)
@@ -5,7 +5,9 @@
 # hence are not checked.  File existence is checked with -e though.
 # This test depends on File::Path::rmtree() to clean up with.
 #  - pvhp
-
+#
+# We are now checking that the correct use $version; is present in
+# Makefile.PL and $module.pm
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -14,7 +16,7 @@ BEGIN {
 # use strict; # we are not really testing this
 use File::Path;  # for cleaning up with rmtree()
 use Test;
-
+use File::Spec;
 
 my $extracted_program = '../utils/h2xs'; # unix, nt, ...
 if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2xs.com'; }
@@ -38,9 +40,38 @@ if ($^O eq 'MacOS') {
 # not already be found in the t/ subdirectory for perl.
 my $name = 'h2xst';
 my $header = "$name.h";
+my $thisversion = sprintf "%vd", $^V;
 
 my @tests = (
-"-f -n $name", <<"EOXSFILES",
+"-f -n $name", $], <<"EOXSFILES",
+Defaulting to backwards compatibility with perl $thisversion
+If you intend this module to be compatible with earlier perl versions, please
+specify a minimum perl version with the -b option.
+
+Writing $name/$name.pm
+Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
+Writing $name/Makefile.PL
+Writing $name/README
+Writing $name/t/1.t
+Writing $name/Changes
+Writing $name/MANIFEST
+EOXSFILES
+
+"-f -n $name -b $thisversion", $], <<"EOXSFILES",
+Writing $name/$name.pm
+Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
+Writing $name/Makefile.PL
+Writing $name/README
+Writing $name/t/1.t
+Writing $name/Changes
+Writing $name/MANIFEST
+EOXSFILES
+
+"-f -n $name -b 5.6.1", "5.006001", <<"EOXSFILES",
 Writing $name/$name.pm
 Writing $name/$name.xs
 Writing $name/fallback.c
@@ -52,7 +83,19 @@ Writing $name/Changes
 Writing $name/MANIFEST
 EOXSFILES
 
-"\"-X\" -f -n $name", <<"EONOXSFILES",
+"-f -n $name -b 5.5.3", "5.00503", <<"EOXSFILES",
+Writing $name/$name.pm
+Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
+Writing $name/Makefile.PL
+Writing $name/README
+Writing $name/t/1.t
+Writing $name/Changes
+Writing $name/MANIFEST
+EOXSFILES
+
+"\"-X\" -f -n $name -b $thisversion", $], <<"EONOXSFILES",
 Writing $name/$name.pm
 Writing $name/Makefile.PL
 Writing $name/README
@@ -61,7 +104,7 @@ Writing $name/Changes
 Writing $name/MANIFEST
 EONOXSFILES
 
-"-f -n $name $header", <<"EOXSFILES",
+"-f -n $name $header -b $thisversion", $], <<"EOXSFILES",
 Writing $name/$name.pm
 Writing $name/$name.xs
 Writing $name/fallback.c
@@ -75,10 +118,11 @@ EOXSFILES
 );
 
 my $total_tests = 3; # opening, closing and deleting the header file.
-for (my $i = $#tests; $i > 0; $i-=2) {
+for (my $i = $#tests; $i > 0; $i-=3) {
   # 1 test for running it, 1 test for the expected result, and 1 for each file
+  # plus 1 to open and 1 to check for the use in $name.pm and Makefile.PL
   # use the () to force list context and hence count the number of matches.
-  $total_tests += 2 + (() = $tests[$i] =~ /(Writing)/sg);
+  $total_tests += 6 + (() = $tests[$i] =~ /(Writing)/sg);
 }
 
 plan tests => $total_tests;
@@ -90,7 +134,7 @@ print HEADER <<HEADER or die $!;
 HEADER
 ok (close (HEADER));
 
-while (my ($args, $expectation) = splice @tests, 0, 2) {
+while (my ($args, $version, $expectation) = splice @tests, 0, 3) {
   # h2xs warns about what it is writing hence the (possibly unportable)
   # 2>&1 dupe:
   # does it run?
@@ -109,9 +153,7 @@ while (my ($args, $expectation) = splice @tests, 0, 2) {
   # Was the output the list of files that were expected?
   ok ($result, $expectation, "running $prog");
 
-  $expectation =~ s/Writing //; # remove leader
-  foreach (split(/Writing /,$expectation)) {
-    chomp;  # remove \n
+  foreach ($expectation =~ /Writing\s+(\S+)/gm) {
     if ($^O eq 'MacOS') {
       $_ = ':' . join(':',split(/\//,$_));
       $_ =~ s/$name:t:1.t/$name:t\/1.t/; # is this an h2xs bug?
@@ -119,6 +161,18 @@ while (my ($args, $expectation) = splice @tests, 0, 2) {
     ok (-e $_, 1, "$_ missing");
   }
 
+  foreach my $leaf ("$name.pm", 'Makefile.PL') {
+    my $file = File::Spec->catfile($name, $leaf);
+    if (ok (open (FILE, $file), 1, "open $file")) {
+      my $match = qr/use $version;/;
+      my $found;
+      while (<FILE>) {
+        last if $found = /$match/;
+      }
+      ok ($found, 1, "looking for /$match/ in $file");
+      close FILE or die "close $file: $!";
+    }
+  }
   # clean up
   rmtree($name);
 }
index 61fa496..b16ee22 100644 (file)
@@ -1,5 +1,5 @@
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
-# This file is built by mktables.PL from e.g. Unicode.txt.
+# This file is built by mktables from e.g. Unicode.txt.
 # Any changes made here will be lost!
 return <<'END';
 0621           U
@@ -8,40 +8,40 @@ return <<'END';
 0627           R
 0628           D
 0629           R
-062a   062e    D
-062f   0632    R
-0633   063a    D
+062A   062E    D
+062F   0632    R
+0633   063A    D
 0640           C
 0641   0647    D
 0648           R
-0649   064a    D
+0649   064A    D
 0671   0673    R
 0674           U
 0675   0677    R
 0678   0687    D
 0688   0699    R
-069a   06bf    D
-06c0           R
-06c1           D
-06c2   06cb    R
-06cc           D
-06cd           R
-06ce           D
-06cf           R
-06d0   06d1    D
-06d2   06d3    R
-06d5           R
-06fa   06fc    D
+069A   06BF    D
+06C0           R
+06C1           D
+06C2   06CB    R
+06CC           D
+06CD           R
+06CE           D
+06CF           R
+06D0   06D1    D
+06D2   06D3    R
+06D5           R
+06FA   06FC    D
 0710           R
 0712   0714    D
 0715   0719    R
-071a   071d    D
-071e           R
-071f   0727    D
+071A   071D    D
+071E           R
+071F   0727    D
 0728           R
 0729           D
-072a           R
-072b           D
-072c           R
-200d           C
+072A           R
+072B           D
+072C           R
+200D           C
 END
index c293d9f..4a3d92a 100644 (file)
@@ -1,5 +1,5 @@
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
-# This file is built by mktables.PL from e.g. Unicode.txt.
+# This file is built by mktables from e.g. Unicode.txt.
 # Any changes made here will be lost!
 return <<'END';
 0621           <no shaping>
@@ -10,14 +10,14 @@ return <<'END';
 0627           ALEF
 0628           BEH
 0629           TEH MARBUTA
-062a   062b    BEH
-062c   062e    HAH
-062f   0630    DAL
+062A   062B    BEH
+062C   062E    HAH
+062F   0630    DAL
 0631   0632    REH
 0633   0634    SEEN
 0635   0636    SAD
 0637   0638    TAH
-0639   063a    AIN
+0639   063A    AIN
 0640           <no shaping>
 0641           FEH
 0642           QAF
@@ -27,7 +27,7 @@ return <<'END';
 0646           NOON
 0647           HEH
 0648           WAW
-0649   064a    YEH
+0649   064A    YEH
 0671   0673    ALEF
 0674           <no shaping>
 0675           ALEF
@@ -37,35 +37,35 @@ return <<'END';
 0681   0687    HAH
 0688   0690    DAL
 0691   0699    REH
-069a   069c    SEEN
-069d   069e    SAD
-069f           TAH
-06a0           AIN
-06a1   06a6    FEH
-06a7   06a8    QAF
-06a9           GAF
-06aa           SWASH KAF
-06ab           GAF
-06ac   06ae    KAF
-06af   06b4    GAF
-06b5   06b8    LAM
-06b9   06bd    NOON
-06be           KNOTTED HEH
-06bf           HAH
-06c0           TEH MARBUTA
-06c1           HEH GOAL
-06c2   06c3    HAMZA ON HEH GOAL
-06c4   06cb    WAW
-06cc           YEH
-06cd           YEH WITH TAIL
-06ce           YEH
-06cf           WAW
-06d0   06d1    YEH
-06d2   06d3    YEH BARREE
-06d5           TEH MARBUTA
-06fa           SEEN
-06fb           SAD
-06fc           AIN
+069A   069C    SEEN
+069D   069E    SAD
+069F           TAH
+06A0           AIN
+06A1   06A6    FEH
+06A7   06A8    QAF
+06A9           GAF
+06AA           SWASH KAF
+06AB           GAF
+06AC   06AE    KAF
+06AF   06B4    GAF
+06B5   06B8    LAM
+06B9   06BD    NOON
+06BE           KNOTTED HEH
+06BF           HAH
+06C0           TEH MARBUTA
+06C1           HEH GOAL
+06C2   06C3    HAMZA ON HEH GOAL
+06C4   06CB    WAW
+06CC           YEH
+06CD           YEH WITH TAIL
+06CE           YEH
+06CF           WAW
+06D0   06D1    YEH
+06D2   06D3    YEH BARREE
+06D5           TEH MARBUTA
+06FA           SEEN
+06FB           SAD
+06FC           AIN
 0710           ALAPH
 0712           BETH
 0713   0714    GAMAL
@@ -73,11 +73,11 @@ return <<'END';
 0717           HE
 0718           WAW
 0719           ZAIN
-071a           HETH
-071b   071c    TETH
-071d           YUDH
-071e           YUDH HE
-071f           KAPH
+071A           HETH
+071B   071C    TETH
+071D           YUDH
+071E           YUDH HE
+071F           KAPH
 0720           LAMADH
 0721           MIM
 0722           NUN
@@ -88,8 +88,8 @@ return <<'END';
 0727           REVERSED PE
 0728           SADHE
 0729           QAPH
-072a           DALATH RISH
-072b           SHIN
-072c           TAW
-200d           <no shaping>
+072A           DALATH RISH
+072B           SHIN
+072C           TAW
+200D           <no shaping>
 END
index cc893d7..216522e 100644 (file)
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
-# This file is built by mktables.PL from e.g. Unicode.txt.
+# This file is built by mktables from e.g. Unicode.txt.
 # Any changes made here will be lost!
 return <<'END';
 0000   0008    BN
 0009           S
-000a           B
-000b           S
-000c           WS
-000d           B
-000e   001b    BN
-001c   001e    B
-001f           S
+000A           B
+000B           S
+000C           WS
+000D           B
+000E   001B    BN
+001C   001E    B
+001F           S
 0020           WS
 0021   0022    ON
 0023   0025    ET
-0026   002a    ON
-002b           ET
-002c           CS
-002d           ET
-002e           CS
-002f           ES
+0026   002A    ON
+002B           ET
+002C           CS
+002D           ET
+002E           CS
+002F           ES
 0030   0039    EN
-003a           CS
-003b   0040    ON
-0041   005a    L
-005b   0060    ON
-0061   007a    L
-007b   007e    ON
-007f   0084    BN
+003A           CS
+003B   0040    ON
+0041   005A    L
+005B   0060    ON
+0061   007A    L
+007B   007E    ON
+007F   0084    BN
 0085           B
-0086   009f    BN
-00a0           CS
-00a1           ON
-00a2   00a5    ET
-00a6   00a9    ON
-00aa           L
-00ab   00af    ON
-00b0   00b1    ET
-00b2   00b3    EN
-00b4           ON
-00b5           L
-00b6   00b8    ON
-00b9           EN
-00ba           L
-00bb   00bf    ON
-00c0   00d6    L
-00d7           ON
-00d8   00f6    L
-00f7           ON
-00f8   021f    L
+0086   009F    BN
+00A0           CS
+00A1           ON
+00A2   00A5    ET
+00A6   00A9    ON
+00AA           L
+00AB   00AF    ON
+00B0   00B1    ET
+00B2   00B3    EN
+00B4           ON
+00B5           L
+00B6   00B8    ON
+00B9           EN
+00BA           L
+00