Abhijit Menon-Sen <ams@wiw.org>
Abigail <abigail@foad.org>
Achim Bohnet <ach@mpe.mpg.de>
-Adam Milner <carmiac@nmt.edu>
Adam Krolnik <adamk@gypsy.cyrix.com>
+Adam Milner <carmiac@nmt.edu>
Akim Demaille <akim@epita.fr>
Alan Burlison <Alan.Burlison@uk.sun.com>
Alan Champion <achampio@lehman.com>
Albert Chin-A-Young <china@thewrittenword.com>
Albert Dvornik <bert@genscan.com>
Alessandro Forghieri <alf@orion.it>
-Alex Cough <alex@rcon.rog>
+Alex Gough <alex@rcon.rog>
Alexander Gough <alexander.gough@st-hughs.oxford.ac.uk>
Alexander Klimov <ask@wisdom.weizmann.ac.il>
Alexander Smishlajev <als@turnhere.com>
-Alexey V. Barantzev <barancev@kazbek.ispras.ru>
+Alexey Mahotkin <alexm@netli.com>
+Alexey V. Barantsev <barancev@kazbek.ispras.ru>
Allen Smith <easmith@beatrice.rutgers.edu>
Ambrose Kofi Laing
Ananth Kesari <HYanantha@novell.com>
Andreas Klussmann <andreas@infosys.heitec.de>
Andreas König <a.koenig@mind.de>
Andreas Schwab <schwab@suse.de>
+Andrej Borsenkow <Andrej.Borsenkow@mow.siemens.ru>
Andrew Bettison <andrewb@zip.com.au>
Andrew Cohen <cohen@andy.bu.edu>
andrew deryabin <djsf@technarchy.ru>
Bruce P. Schuck <bruce@aps.org>
Bud Huff <BAHUFF@us.oracle.com>
Byron Brummer <byron@omix.com>
-Calle Dybedahl <calle@lysator.liu.se>
C Aditya <caditya@novell.com>
+Calle Dybedahl <calle@lysator.liu.se>
Carl Eklof <CEklof@endeca.com>
Carl M. Fongheiser <cmf@ins.infonet.net>
Carl Witty <cwitty@newtonlabs.com>
Charles Randall <cfriv@yahoo.com>
Charles Wilson <cwilson@ece.gatech.edu>
Chip Salzenberg <chip@pobox.com>
+Chris Ball <chris@cpan.org>
Chris Bongaarts <cab@tc.umn.edu>
Chris Faylor <cgf@bbc.com>
Chris Nandor <pudge@pobox.com>
Colin Watson <colin@zeus.com>
Conrad Augustin
Conrad E. Kimball <cek@tblv021.ca.boeing.com>
+Coral <coral@moonlight.crystalflame.net>
Craig A. Berry <craig.berry@psinetcs.com>
Craig Milo Rogers <Rogers@ISI.EDU>
Curtis Poe <cp@onsitetech.com>
David Billinghurst <David.Billinghurst@riotinto.com.au>
David Campbell
David Couture
-David Denholm <denholm@conmat.phys.soton.ac.uk>
David D. Kilzer <ddkilzer@lubricants-oil.com>
+David Denholm <denholm@conmat.phys.soton.ac.uk>
David Dyck <dcd@tc.fluke.com>
David F. Haertig <dfh@dwroll.lucent.com>
David Filo
Dominique Dumont <Dominique_Dumont@grenoble.hp.com>
Doug Campbell <soup@ampersand.com>
Doug MacEachern <dougm@covalent.net>
-Douglas Wilson <dougw@cpan.org>
Douglas E. Wegscheid <dwegscheid@qtm.net>
Douglas Lankshear <dougl@activestate.com>
+Douglas Wilson <dougw@cpan.org>
Dov Grobgeld <dov@Orbotech.Co.IL>
Drago Goricanec <drago@raptor.otsd.ts.fujitsu.co.jp>
Ed Mooring <mooring@Lynx.COM>
Ed Peschko <epeschko@den-mdev1>
Edward Avis <epa98@doc.ic.ac.uk>
-Edward Peschko <edwardp@excitehome.net>
Edward Moy <emoy@apple.com>
+Edward Peschko <edwardp@excitehome.net>
Elaine -HFB- Ashton <elaine@chaos.wustl.edu>
Elizabeth Mattijsen <liz@dijkmat.nl>
Eric Arnold <eric.arnold@sun.com>
Hal Pomeranz <pomeranz@netcom.com>
Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
Hannu Napari <Hannu.Napari@hut.fi>
+Hans de Graaff <J.J.deGraaff@twi.tudelft.nl>
Hans Ginzel <hans@kolej.mff.cuni.cz>
Hans Mulder <hansmu@xs4all.nl>
-Hans de Graaff <J.J.deGraaff@twi.tudelft.nl>
Harmon S. Nine <hnine@netarx.com>
Harold O Morris <hom00@utsglobal.com>
Harri Pasanen <harri.pasanen@trema.com>
Hunter Kelly <retnuh@zule.pixar.com>
Huw Rogers <count0@gremlin.straylight.co.jp>
I. N. Golubev <gin@mo.msk.ru>
+Iain Truskett <spoon@cpan.org>
Ian Maloney <ian.malonet@ubs.com>
Ian Phillipps <Ian.Phillipps@iname.com>
Ignasi Roca <ignasi.roca@fujitsu-siemens.com>
Irving Reid <irving@tor.securecomputing.com>
J. David Blackstone <jdb@dfwnet.sbms.sbc.com>
J. van Krieken <John.van.Krieken@ATComputing.nl>
-JD Laub <jdl@access-health.com>
-JT McDuffie <jt@kpc.com>
Jack Shirazi <JackS@GemStone.com>
Jacqui Caren <Jacqui.Caren@ig.co.uk>
Jake Hamby <jehamby@lightside.com>
Jared Rhine <jared@organic.com>
Jarkko Hietaniemi <jhi@iki.fi>
Jason A. Smith <smithj4@rpi.edu>
+Jason E. Stewart <jason@openinformatics.com>
Jason Shirk
Jason Stewart <jasons@cs.unm.edu>
Jason Varsoke <jjv@caesun10.msd.ray.com>
Jay Rogers <jay@rgrs.com>
+JD Laub <jdl@access-health.com>
Jeff Bouis
Jeff McDougal <jmcdo@cris.com>
Jeff Okamoto <okamoto@corp.hp.com>
Joachim Huober
Jochen Wiedmann <joe@ispsoft.de>
Joe Buehler <jbuehler@hekimian.com>
-Joe Orton <jorton@redhat.com>
Joe McMahon <mcmahon@metalab.unc.edu>
+Joe Orton <jorton@redhat.com>
Joe Smith <jsmith@inwap.com>
Joel Rosi-Schwartz <j.schwartz@agonet.it>
Joerg Porath <Joerg.Porath@informatik.tu-chemnitz.de>
Joseph S. Myers <jsm28@hermes.cam.ac.uk>
Joshua E. Rodd <jrodd@pbs.org>
Joshua Pritikin <joshua.pritikin@db.com>
+JT McDuffie <jt@kpc.com>
Juan Gallego <Little.Boss@physics.mcgill.ca>
Juha Laiho <juha.laiho@Elma.Net>
Julian Yip <julian@imoney.com>
Kevin Ruscoe <Kevin.Ruscoe@ubsw.com>
Kevin White <klwhite@magnus.acs.ohio-state.edu>
Kim Frutiger
+Kingpin <mthurn@copper.dulles.tasc.com>
Kirrily Robert <skud@infotrope.net>
Kragen Sitaker <kragen@dnaco.net>
Krishna Sethuraman <krishna@sgi.com>
Les Peters <lpeters@aol.net>
Lincoln D. Stein <lstein@cshl.org>
Lionel Cons <lionel.cons@cern.ch>
-Luc St Louis <luc.st-louis@ca.transport.bombardier.com>
+Luc St-Louis <luc.st-louis@ca.transport.bombardier.com>
Luca Fini
Lupe Christoph <lupe@lupe-christoph.de>
Luther Huffman <lutherh@stratcom.com>
Peter Jaspers-Fayer
Peter Prymmer <pvhp@best.com>
Peter Scott <Peter@PSDT.com>
-Peter Wolfe <wolfe@teloseng.com>
Peter van Heusden <pvh@junior.uwc.ac.za>
+Peter Wolfe <wolfe@teloseng.com>
Petter Reinholdtsen <pere@hungry.com>
Phil Lobbes <phil@finchcomputer.com>
Philip Hazel <ph10@cus.cam.ac.uk>
Philip Newton <pne@cpan.org>
Piers Cawley <pdcawley@bofh.org.uk>
Piotr Klaban <makler@oryl.man.torun.pl>
+Pixel <pixel@mandrakesoft.com>
Prymmer/Kahn <pvhp@best.com>
Quentin Fennessy <quentin@arrakeen.amd.com>
Radu Greab <radu@netsoft.ro>
Rickard Westman
Rob Brown <bbb@cpan.org>
Rob Henderson <robh@cs.indiana.edu>
+Rob Napier <rnapier@employees.org>
Robert Partington <rjp@riffraff.plig.net>
Robert Sanders <Robert.Sanders@linux.org>
Robert Spier <rspier@pobox.com>
Wilfredo Sánchez <wsanchez@mit.edu>
William J. Middleton <William.Middleton@oslo.mobil.telenor.no>
William Mann <wmann@avici.com>
-William Williams <biwillia@cisco.com>
William R Ward <hermit@BayView.COM>
William Setzer <William_Setzer@ncsu.edu>
+William Williams <biwillia@cisco.com>
Winfried König <win@in.rhein-main.de>
Wolfgang Laun <Wolfgang.Laun@alcatel.at>
Yary Hluchan
Version v5.7.X Development release working toward v5.8
--------------
____________________________________________________________________________
+[ 17411] By: jhi on 2002/07/07 20:36:18
+ Log: Regen toc, modlib.
+ Branch: perl
+ ! pod/perlmodlib.pod pod/perltoc.pod
+____________________________________________________________________________
+[ 17410] By: rgs on 2002/07/07 20:31:37
+ Log: Replace the word "discipline" by "layer" almost everywhere,
+ by Elizabeth Mattijsen.
+ Branch: perl
+ ! MANIFEST lib/open.pm pod/perldelta.pod pod/perlfunc.pod
+ ! pod/perlpodspec.pod pod/perlrun.pod pod/perlunicode.pod
+ ! pod/perluniintro.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 17409] By: jhi on 2002/07/07 19:58:36
+ Log: Use the same name for the QP test as MIME::Base64 does.
+ Branch: perl
+ + ext/MIME/Base64/t/quoted-print.t
+ - ext/MIME/Base64/t/qp.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 17408] By: jhi on 2002/07/07 18:48:06
+ Log: Don't install test pods.
+ Branch: perl
+ ! installman
+____________________________________________________________________________
+[ 17407] By: jhi on 2002/07/07 17:04:27
+ Log: Integrate maint patches #13474, #13478, #13584, and #16539;
+ introduce the test case of [ID 20020623.009]. Once upon a
+ time #13474 introduced evil coredumps, but now things seem
+ to be better (tried both with and without ithreads).
+ Branch: perl
+ ! op.c t/run/fresh_perl.t
+____________________________________________________________________________
+[ 17406] By: jhi on 2002/07/07 15:29:28
+ Log: Upgrade to Math::BigInt 1.60.
+ Branch: perl
+ + lib/Math/BigInt/t/bare_mif.t
+ ! MANIFEST lib/Math/BigFloat.pm lib/Math/BigInt.pm
+ ! lib/Math/BigInt/Calc.pm lib/Math/BigInt/t/bare_mbf.t
+ ! lib/Math/BigInt/t/bare_mbi.t lib/Math/BigInt/t/bigfltpm.inc
+ ! lib/Math/BigInt/t/bigfltpm.t lib/Math/BigInt/t/bigintpm.inc
+ ! lib/Math/BigInt/t/bigintpm.t lib/Math/BigInt/t/inf_nan.t
+ ! lib/Math/BigInt/t/mbimbf.inc lib/Math/BigInt/t/mbimbf.t
+ ! lib/Math/BigInt/t/sub_mbf.t lib/Math/BigInt/t/sub_mbi.t
+ ! lib/Math/BigInt/t/sub_mif.t lib/Math/BigInt/t/with_sub.t
+____________________________________________________________________________
+[ 17405] By: rgs on 2002/07/06 18:39:30
+ Log: Subject: Re: FreeBSD 4.6 imminent
+ From: Nicholas Clark <nick@unfortu.net>
+ Date: Sat, 6 Jul 2002 16:07:38 +0100
+ Message-ID: <20020706150737.GC301@Bagpuss.unfortu.net>
+ Branch: perl
+ ! README.freebsd
+____________________________________________________________________________
+[ 17404] By: nick on 2002/07/06 07:04:02
+ Log: Integrate mainline
+ Branch: perlio
+ !> t/README
+____________________________________________________________________________
+[ 17403] By: rgs on 2002/07/05 12:46:22
+ Log: Precisions and updates about running and writing tests.
+ Branch: perl
+ ! t/README
+____________________________________________________________________________
+[ 17402] By: nick on 2002/07/05 07:05:40
+ Log: Integrate mainline
+ Branch: perlio
+ !> (integrate 32 files)
+____________________________________________________________________________
+[ 17401] By: rgs on 2002/07/04 20:21:10
+ Log: Goes with change #17400.
+ Branch: perl
+ ! t/pod/podselect.xr
+____________________________________________________________________________
+[ 17400] By: rgs on 2002/07/04 14:44:32
+ Log: Subject: [DOC PATCH] minor typo in podselect.PL
+ From: Dave Mitchell <davem@fdgroup.com>
+ Date: Thu, 4 Jul 2002 15:30:53 +0100
+ Message-ID: <20020704153052.C1322@fdgroup.com>
+ Branch: perl
+ ! pod/podselect.PL
+____________________________________________________________________________
+[ 17399] By: rgs on 2002/07/04 12:01:21
+ Log: Typos and missing warning categories.
+ Branch: perl
+ ! pod/perldiag.pod
+____________________________________________________________________________
+[ 17398] By: rgs on 2002/07/04 10:19:11
+ Log: Subject: Re: autom4te and perl 5.8.0
+ From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Wed, 3 Jul 2002 11:56:05 -0400 (EDT)
+ Message-ID: <Pine.SOL.4.10.10207031150540.6601-100000@maxwell.phys.lafayette.edu>
+
+ (with an additional paranoid nit : skip test unless -c $devnull)
+ Branch: perl
+ ! doio.c ext/Fcntl/t/fcntl.t
+____________________________________________________________________________
+[ 17397] By: rgs on 2002/07/04 08:58:23
+ Log: Subject: [PATCH] Win32 build broken
+ From: "Mattia Barbon" <mbarbon@dsi.unive.it>
+ Date: Wed, 3 Jul 2002 23:44:49 +0200
+ Message-ID: <3D238C71.6138.2E20AFC@localhost>
+
+ (needed by change #17391)
+ Branch: perl
+ ! embed.fnc global.sym
+____________________________________________________________________________
+[ 17396] By: rgs on 2002/07/02 08:27:41
+ Log: Subject: [PATCH perl@17384] opendir() nit for VMS
+ From: "Craig A. Berry" <craigberry@mac.com>
+ Date: Mon, 1 Jul 2002 22:55:30 -0500
+ Message-ID: <a05111b02b946cb14a2a8@[172.16.52.1]>
+ Branch: perl
+ ! vms/vms.c
+____________________________________________________________________________
+[ 17395] By: rgs on 2002/07/01 18:41:17
+ Log: Subject: Re: Change 17385: AUTHORS updates.
+ From: Philip Newton <Philip.Newton@gmx.net>
+ Date: Mon, 01 Jul 2002 20:30:59 +0200
+ Message-ID: <gt71iuch89r0ektao7g62l32ntgiub1jse@4ax.com>
+ Branch: perl
+ ! AUTHORS
+____________________________________________________________________________
+[ 17394] By: rgs on 2002/07/01 18:35:37
+ Log: Subject: [PATCH perl@17384] more dangerous logical name warnings for VMS
+ From: "Craig A. Berry" <craigberry@mac.com>
+ Date: Mon, 01 Jul 2002 13:52:36 -0500
+ Message-ID: <5.1.1.5.0.20020701130645.01aa8258@exchi01>
+ Branch: perl
+ ! configure.com vms/test.com
+____________________________________________________________________________
+[ 17393] By: rgs on 2002/07/01 18:25:22
+ Log: Allow PerlIO::Via to look for modules in the default
+ namespace PerlIO::Via::.
+ Branch: perl
+ ! ext/PerlIO/Via/Via.pm ext/PerlIO/Via/Via.xs ext/PerlIO/t/via.t
+____________________________________________________________________________
+[ 17392] By: jhi on 2002/07/01 14:14:37
+ Log: Small speedup by inlining the easy bits of is_utf8_char()
+ into is_utf8_string().
+ Branch: perl
+ ! utf8.c
+____________________________________________________________________________
+[ 17391] By: jhi on 2002/07/01 13:42:28
+ Log: Subject: -Dr and unicode
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Mon, 01 Jul 2002 13:28:05 +0100
+ Message-Id: <200207011228.g61CS5r06772@crypt.compulink.co.uk>
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 17390] By: jhi on 2002/07/01 13:40:44
+ Log: Subject: Re: [ID 20020630.002] utf8 regex only matches 32k
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Message-Id: <200207011228.g61CS4T06766@crypt.compulink.co.uk>
+ Date: Mon, 01 Jul 2002 13:28:04 +0100
+ Branch: perl
+ ! regexec.c t/op/pat.t
+____________________________________________________________________________
+[ 17389] By: rgs on 2002/07/01 13:04:18
+ Log: Goes with lib/open.pm diagnostics changes
+ Branch: perl
+ ! lib/open.t
+____________________________________________________________________________
+[ 17388] By: rgs on 2002/07/01 09:27:47
+ Log: Subject: [DOC PATCH] perliol.pod nit
+ From: Elizabeth Mattijsen <liz@dijkmat.nl>
+ Date: Sun, 30 Jun 2002 23:52:05 +0200
+ Message-ID: <4.2.0.58.20020630235023.02443670@mickey.dijkmat.nl>
+
+ Subject: [DOC PATCH] open.pm, no more discipline
+ From: Elizabeth Mattijsen <liz@dijkmat.nl>
+ Date: Sun, 30 Jun 2002 23:02:50 +0200
+ Message-ID: <4.2.0.58.20020630230134.0289d300@mickey.dijkmat.nl>
+ Branch: perl
+ ! lib/open.pm pod/perliol.pod
+____________________________________________________________________________
+[ 17387] By: rgs on 2002/07/01 09:26:02
+ Log: Subject: Threads doc patch
+ From: Iain Truskett <spoon@cpan.org>
+ Date: Mon, 1 Jul 2002 14:58:14 +1000
+ Message-ID: <20020701045814.GB1805@eh.org>
+ Branch: perl
+ ! pod/perlthrtut.pod
+____________________________________________________________________________
+[ 17386] By: jhi on 2002/06/30 16:51:44
+ Log: Regen toc (skip the XS:: since they do not get installed)
+ Branch: perl
+ ! pod/buildtoc.PL pod/perltoc.pod
+____________________________________________________________________________
+[ 17385] By: jhi on 2002/06/30 16:31:35
+ Log: AUTHORS updates.
+ Branch: perl
+ ! AUTHORS
+____________________________________________________________________________
+[ 17384] By: jhi on 2002/06/30 15:31:53
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 17383] By: jhi on 2002/06/30 02:45:58
Log: Retract #17380, the refcnt tweak was misplaced (re_dup is used
when creation of new threads needs to duplicate the re struct)
ext/MIME/Base64/Makefile.PL MIME::Base64 extension
ext/MIME/Base64/QuotedPrint.pm MIME::Base64 extension
ext/MIME/Base64/t/base64.t See whether MIME::Base64 works
-ext/MIME/Base64/t/qp.t See whether MIME::QuotedPrint works
+ext/MIME/Base64/t/quoted-print.t See whether MIME::QuotedPrint works
ext/MIME/Base64/t/unicode.t See whether MIME::Base64 works
ext/NDBM_File/hints/cygwin.pl Hint for NDBM_File for named architecture
ext/NDBM_File/hints/dec_osf.pl Hint for NDBM_File for named architecture
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc
lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc
+lib/Math/BigInt/t/bare_mif.t Rounding tests under BareCalc
lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.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/NEXT/t/actuns.t NEXT
lib/NEXT/t/next.t NEXT
lib/NEXT/t/unseen.t NEXT
-lib/open.pm Pragma to specify default I/O disciplines
+lib/open.pm Pragma to specify default I/O layers
lib/open.t See if the open pragma works
lib/open2.pl Open a two-ended pipe (uses IPC::Open2)
lib/open3.pl Open a three-ended pipe (uses IPC::Open3)
When perl is configured to use ithreads, it will use re-entrant library calls
in preference to non-re-entrant versions. There is a bug in FreeBSD's
-C<readdir_r> function that can cause a SEGV when reading large directories.
-A patch is available
+C<readdir_r> function in versions 4.5 and earlier that can cause a SEGV when
+reading large directories. A patch for FreeBSD libc is available
(see http://www.freebsd.org/cgi/query-pr.cgi?pr=misc/30631 )
-and will hopefully be integrated into FreeBSD 4.6.
+which has been integrated into FreeBSD 4.6.
=head2 $^X doesn't always contain a full path in FreeBSD
In these cases perl will fall back to the old behaviour of using C's
argv[0] value for C<$^X>.
-=head2 Perl will no more be part of "base FreeBSD"
+=head2 Perl will no longer be part of "base FreeBSD"
-Not as bad as it sounds--what is means is that Perl will no more be
+Not as bad as it sounds--what this means is that Perl will no longer be
part of the B<kernel build system> of FreeBSD. Perl will still very
probably be part of the "default install", and in any case the latest
version will be in the ports system. The first FreeBSD version this
If you use gcc, make sure your installation is recent and
complete. As a point of reference, perl-5.6.0 built fine with
-gcc-2.8.1 on both Solaris 2.6 and Solaris 8. You'll be able to
+gcc-2.8.1 on both Solaris 2.6 and Solaris 8. You should
Configure perl with
sh Configure -Dcc=gcc
This document describes various features of HP's (formerly Compaq's,
formerly Digital's) Unix operating system (Tru64) that will affect
-how Perl version 5 is configured, compiled and/or runs.
+how Perl version 5 (hereafter just Perl) is configured, compiled
+and/or runs.
=head2 Compiling Perl 5 on Tru64
The recommended compiler to use in Tru64 is the native C compiler.
The native compiler produces much faster code (the speed difference is
noticeable: several dozen percentages) and also more correct code: if
-you are considering using the GNU C compiler you should use the gcc
-2.95.3 since all older gcc releases are known to produce broken code
-when compiling Perl. One manifestation of this brokenness is the
-lib/sdbm test dumping core; another is the op/regexp and op/pat,
-or ext/Storable tests dumping core (depending on the GCC release).
+you are considering using the GNU C compiler you should use at the
+very least the release of 2.95.3 since all older gcc releases are
+known to produce broken code when compiling Perl. One manifestation
+of this brokenness is the lib/sdbm test dumping core; another is many
+of the op/regexp and op/pat, or ext/Storable tests dumping core
+(the exact pattern of failures depending on the GCC release and
+optimization flags).
=head2 Using Large Files with Perl on Tru64
In Tru64 Perl is automatically able to use large files, that is,
files larger than 2 gigabytes, there is no need to use the Configure
--Duselargefiles option as described in INSTALL.
+-Duselargefiles option as described in INSTALL (though using the option
+is harmless).
=head2 Threaded Perl on Tru64
=head2 Long Doubles on Tru64
-You cannot Configure Perl to use long doubles unless you have at
-least Tru64 V5.0, the long double support simply wasn't functional
-enough before that.
+You cannot Configure Perl to use long doubles unless you have at least
+Tru64 V5.0, the long double support simply wasn't functional enough
+before that. Perl's Configure will override attempts to use the long
+doubles (you can notice this by Configure finding out that the modfl()
+function does not work as it should).
At the time of this writing (June 2002), there is a known bug in the
Tru64 libc printing of long doubles when not using "e" notation.
return HUGE_VAL;
-------------------^
-The exact line numbers may vary between Perl releases.
-The warnings are benign and can be ignored: in later C compiler
-releases the warnings should be gone.
+The exact line numbers may vary between Perl releases. The warnings
+are benign and can be ignored: in later C compiler releases the warnings
+should be gone.
When the file F<pp_sys.c> is being compiled you may (depending on the
operating system release) see an additional compiler flag being used:
Can't load '.../OSF1/lib/perl5/5.8.0/alpha-dec_osf/auto/IO/IO.so' for module IO: Unresolved symbol in .../lib/perl5/5.8.0/alpha-dec_osf/auto/IO/IO.so: sockatmark at .../lib/perl5/5.8.0/alpha-dec_osf/XSLoader.pm line 75.
you need to either recompile your Perl in Tru64 4.0D or upgrade your
-Tru64 4.0D: the sockatmark() system call was added in Tru64 4.0F, and
-the IO extension refers that symbol.
+Tru64 4.0D to at least 4.0F: the sockatmark() system call was
+added in Tru64 4.0F, and the IO extension refers that symbol.
=head1 AUTHOR
@ISA = qw(Exporter);
@EXPORT = qw(encode_qp decode_qp);
+use Carp qw(croak);
+
$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
sub encode_qp ($)
{
my $res = shift;
+ croak("The Quoted-Printable encoding is only defined for bytes")
+ if $res =~ /[^\0-\xFF]/;
+
# Do not mention ranges such as $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
# since that will not even compile on an EBCDIC machine (where ord('!') > ord('<')).
if (ord('A') == 193) { # EBCDIC style machine
# line width
);
-$notests = @tests + 2;
+$notests = @tests + 3;
print "1..$notests\n";
$testno = 0;
"foo\r\n\r\nfoo \r\nfoo \r\n\r\n";
$testno++; print "ok $testno\n";
+print "not " if eval { encode_qp("XXX \x{100}") } || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/;
+$testno++; print "ok $testno\n";
=head1 NAME
-Thread::Signal - Start a thread which runs signal handlers reliably
+Thread::Signal - Start a thread which runs signal handlers reliably (for old code)
+
+=head1 CAVEAT
+
+For new code the use of the C<Thread::Signal> module is discouraged and
+the direct use of the C<threads> and associated modules is encouraged instead.
+
+However, there is no direct equivalent of the Thread::Signal module in the
+new implementation of threads. On the bright side: signals are now delivered
+reliably to Perl programs that do not use threads. The handling of signals
+with the new threading features is up to the underlying thread implementation
+that is being used and may therefor be less reliable.
+
+If you want to specify a thread-specific signal, you can alter the %SIG hash
+in the thread where you want to handle a signal differently from other threads.
+This at least seems to work under Linux. But there are no guarantees and your
+mileage may vary.
+
+For the whole story about the development of threads in Perl, and why you
+should B<not> be using this module unless you know what you're doing, see the
+CAVEAT of the C<Thread> module.
=head1 SYNOPSIS
my $tmp;
# Skip .pm files that have corresponding .pod files, and Functions.pm.
next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp);
+ next if $mod =~ m:/t/:; # no pods from test directories
next if ($manpage eq 'Pod/Functions.pm'); #### Used only by pod itself
# Convert name from File/Basename.pm to File::Basename.3 format,
$tail .= $taint if defined $tail; # avoid warning if $tail == undef
wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
- : $basename .= $taint;
+ : ($basename .= $taint);
}
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my @dirlist = ($ENV{TMPDIR}, "/tmp");
+ my @dirlist = ( "/tmp" );
+ if ( exists $ENV{TMPDIR} )
{
+ unshift @dirlist, $ENV{TMPDIR};
no strict 'refs';
if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
require Scalar::Util;
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.34';
+$VERSION = '1.35';
require 5.005;
use Exporter;
use File::Spec;
{
# Compares 2 values. 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,@_);
+
+ # set up parameters
+ my ($self,$x,$y) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y) = objectify(2,@_);
+ }
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# Compares 2 values, ignoring their signs.
# 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,@_);
+
+ # set up parameters
+ my ($self,$x,$y) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y) = objectify(2,@_);
+ }
# handle +-inf and NaN's
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
{
# add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
# return result as BFLOAT
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
# inf and NaN handling
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# (BigFloat or num_str, BigFloat or num_str) return BigFloat
# subtract second arg from first, modify first
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
if ($y->is_zero()) # still round for not adding zero
{
{
# simulate old behaviour
$params[1] = $self->div_scale(); # and round to it as accuracy
+ $params[0] = undef;
$scale = $params[1]+4; # at least four more for proper round
$params[3] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
return $x->bzero(@params) if $x->is_one();
return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
- #return $x->bone('+',@params) if $x->bcmp($base) == 0;
+ return $x->bone('+',@params) if $x->bcmp($base) == 0;
# when user set globals, they would interfere with our calculation, so
# disable then and later re-enable them
{
# multiply two numbers -- stolen from Knuth Vol 2 pg 233
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
{
# (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
# (BFLOAT,BFLOAT) (quo,rem) or BFLOAT (only rem)
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
sub bmod
{
# (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
my ($d,$re) = $self->SUPER::_div_inf($x,$y);
- return $re->round($a,$p,$r,$y);
+ $x->{sign} = $re->{sign};
+ $x->{_e} = $re->{_e};
+ $x->{_m} = $re->{_m};
+ return $x->round($a,$p,$r,$y);
}
return $x->bnan() if $x->is_zero() && $y->is_zero();
return $x if $y->is_zero();
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_e}->{sign} ne '+')); # digits after dot?
- return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+ return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
# use BigInt's bfac() for faster calc
$x->{_m}->blsft($x->{_e},10); # un-norm m
# compute power of two numbers, second arg is used as integer
# modifies first argument
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $x if $x->{sign} =~ /^[+-]inf$/;
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
return $x;
}
return $x if $x->{sign} !~ /^[+-]$/;
- # 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->{_a} = undef; # and clear A
if ($scale < 0)
{
- # print "bfround scale $scale e $x->{_e}\n";
# round right from the '.'
- return $x if $x->{_e} >= 0; # nothing to round
+
+ return $x if $x->{_e}->{sign} eq '+'; # e >= 0 => nothing to round
+
$scale = -$scale; # positive for simplicity
my $len = $x->{_m}->length(); # length of mantissa
- my $dad = -$x->{_e}; # digits after dot
+
+ # the following poses a restriction on _e, but if _e is bigger than a
+ # scalar, you got other problems (memory etc) anyway
+ my $dad = -($x->{_e}->numify()); # digits after dot
my $zad = 0; # zeros after dot
- $zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style
+ $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style
+
#print "scale $scale dad $dad zad $zad len $len\n";
-
# number bsstr len zad dad
# 0.123 123e-3 3 0 3
# 0.0123 123e-4 3 1 4
$scale = $dbd+$scale;
}
}
- # print "round to $x->{_m} to $scale\n";
}
else
{
+ # round left from the '.'
+
# 123 => 100 means length(123) = 3 - $scale (2) => 1
my $dbt = $x->{_m}->length();
# digits before dot
- my $dbd = $dbt + $x->{_e};
+ my $dbd = $dbt + $x->{_e}->numify();
# should be the same, so treat it as this
$scale = 1 if $scale == 0;
# shortcut if already integer
{
$scale = $dbd - $scale;
}
-
}
- # print "using $scale for $x->{_m} with '$mode'\n";
# pass sign to bround for rounding modes '+inf' and '-inf'
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode);
# if $x has digits after dot
if ($x->{_e}->{sign} eq '-')
{
- #$x->{_m}->brsft(-$x->{_e},10);
- #$x->{_e}->bzero();
- #$x-- if $x->{sign} eq '-';
-
$x->{_e}->{sign} = '+'; # negate e
$x->{_m}->brsft($x->{_e},10); # cut off digits after dot
$x->{_e}->bzero(); # trunc/norm
sub brsft
{
- # shift right by $y (divide by power of 2)
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ # shift right by $y (divide by power of $n)
+
+ # set up parameters
+ my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ }
return $x if $x->modify('brsft');
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
- $x->bdiv($n ** $y,$a,$p,$r,$y);
+ $n = 2 if !defined $n; $n = $self->new($n);
+ $x->bdiv($n->bpow($y),$a,$p,$r,$y);
}
sub blsft
{
- # shift right by $y (divide by power of 2)
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ # shift left by $y (multiply by power of $n)
+
+ # set up parameters
+ my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ }
- return $x if $x->modify('brsft');
+ return $x if $x->modify('blsft');
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
- $x->bmul($n ** $y,$a,$p,$r,$y);
+ $n = 2 if !defined $n; $n = $self->new($n);
+ $x->bmul($n->bpow($y),$a,$p,$r,$y);
}
###############################################################################
$x->length(); # number of digits (w/o sign and '.')
($l,$f) = $x->length(); # number of digits, and length of fraction
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set P $x to $n
+
+ Math::BigFloat->precision(); # get/set global P for all BigFloat objects
+ Math::BigFloat->accuracy(); # get/set global A for all BigFloat objects
+
=head1 DESCRIPTION
All operators (inlcuding basic math operations) are overloaded if you
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.59';
+$VERSION = '1.60';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
'<=>' => sub { $_[2] ?
ref($_[0])->bcmp($_[1],$_[0]) :
- ref($_[0])->bcmp($_[0],$_[1])},
+ $_[0]->bcmp($_[1])},
'cmp' => sub {
$_[2] ?
"$_[1]" cmp $_[0]->bstr() :
return $a; # shortcut
}
- if (ref($x))
- {
- # $object->accuracy() or fallback to global
- return $x->{_a} || ${"${class}::accuracy"};
- }
- return ${"${class}::accuracy"};
+ my $r;
+ # $object->accuracy() or fallback to global
+ $r = $x->{_a} if ref($x);
+ # but don't return global undef, when $x's accuracy is 0!
+ $r = ${"${class}::accuracy"} if !defined $r;
+ $r;
}
sub precision
return $p; # shortcut
}
- if (ref($x))
- {
- # $object->precision() or fallback to global
- return $x->{_p} || ${"${class}::precision"};
- }
- return ${"${class}::precision"};
+ my $r;
+ # $object->precision() or fallback to global
+ $r = $x->{_p} if ref($x);
+ # but don't return global undef, when $x's precision is 0!
+ $r = ${"${class}::precision"} if !defined $r;
+ $r;
}
sub config
$self->{sign} = '+';
if (@_ > 0)
{
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+ if (@_ > 3)
+ {
+ # call like: $x->bzero($a,$p,$r,$y);
+ ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
+ }
+ else
+ {
+ $self->{_a} = $_[0]
+ if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
+ $self->{_p} = $_[1]
+ if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
+ }
}
- return $self;
+ $self;
}
sub bone
my $self = shift;
my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
$self = $class if !defined $self;
-
+
if (!ref($self))
{
my $c = $self; $self = {}; bless $self, $c;
$self->{sign} = $sign;
if (@_ > 0)
{
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+ if (@_ > 3)
+ {
+ # call like: $x->bone($sign,$a,$p,$r,$y);
+ ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
+ }
+ else
+ {
+ $self->{_a} = $_[0]
+ if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
+ $self->{_p} = $_[1]
+ if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
+ }
}
- return $self;
+ $self;
}
##############################################################################
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT or num_str, BINT or num_str) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y) = (ref($_[0]),@_);
+
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y) = objectify(2,@_);
+ }
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
- # shortcut
- my $xz = $x->is_zero();
- my $yz = $y->is_zero();
- return 0 if $xz && $yz; # 0 <=> 0
- return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
- return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
-
+ # have same sign, so compare absolute values. Don't make tests for zero here
+ # because it's actually slower than testin in Calc (especially w/ Pari et al)
+
# post-normalized compare for internal use (honors signs)
if ($x->{sign} eq '+')
{
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swaped (lib returns 0,1,-1)
}
sub bacmp
# Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+ # set up parameters
+ my ($self,$x,$y) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y) = objectify(2,@_);
+ }
+
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# handle +-inf and NaN
{
# add second arg (BINT or string) to first (BINT) (modifies first)
# return result as BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('badd');
return $upgrade->badd($x,$y,@r) if defined $upgrade &&
$x->{sign} = $sx;
}
}
- $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub bsub
{
# (BINT or num_str, BINT or num_str) return num_str
# subtract second arg from first, modify first
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bsub');
if ($y->is_zero())
{
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
$y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
if ($x->{sign} eq '+')
{
$x->{value} = $CALC->_inc($x->{value});
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
elsif ($x->{sign} eq '-')
{
$x->{value} = $CALC->_dec($x->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# inf, nan handling etc
$x->badd($self->__one(),$a,$p,$r); # badd does round
$x->{value} = $CALC->_inc($x->{value});
$x->{sign} = '-' if $zero; # 0 => 1 => -1
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# > 0
elsif ($x->{sign} eq '+')
{
$x->{value} = $CALC->_dec($x->{value});
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# inf, nan handling etc
$x->badd($self->__one('-'),$a,$p,$r); # badd does round
{
# multiply two numbers -- stolen from Knuth Vol 2 pg 233
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bmul');
$x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
- $x->round(@r);
+
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub _div_inf
# x / +-inf => 0, remainder x (works even if x == 0)
if ($y->{sign} =~ /^[+-]inf$/)
{
- my $t = $x->copy(); # binf clobbers up $x
+ my $t = $x->copy(); # bzero clobbers up $x
return wantarray ? ($x->bzero(),$t) : $x->bzero()
}
{
# (dividend: BINT or num_str, divisor: BINT or num_str) return
# (BINT,BINT) (quo,rem) or BINT (only rem)
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bdiv');
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
- #print "mbi bdiv $x $y\n";
return $upgrade->bdiv($upgrade->new($x),$y,@r)
if defined $upgrade && !$y->isa($self);
my $rem = $self->bzero();
($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
+ $rem->{_a} = $x->{_a};
+ $rem->{_p} = $x->{_p};
$x->round(@r);
if (! $CALC->_is_zero($rem->{value}))
{
{
$rem->{sign} = '+'; # dont leave -0
}
- $rem->round(@r);
- return ($x,$rem);
+ return ($x,$rem->round(@r));
}
$x->{value} = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $x->round(@r);
+
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
###############################################################################
{
# modulus (or remainder)
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bmod');
$r[3] = $y; # no push!
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
{
my ($d,$r) = $self->_div_inf($x,$y);
- return $r->round(@r);
+ $x->{sign} = $r->{sign};
+ $x->{value} = $r->{value};
+ return $x->round(@r);
}
if ($CALC->can('_mod'))
$x->{sign} = $y->{sign};
if ($xsign ne $y->{sign})
{
- my $t = [ @{$x->{value}} ]; # copy $x
- $x->{value} = [ @{$y->{value}} ]; # copy $y to $x
+ my $t = $CALC->_copy($x->{value}); # copy $x
+ $x->{value} = $CALC->_copy($y->{value}); # copy $y to $x
$x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
}
}
{
$x->{sign} = '+'; # dont leave -0
}
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
# modify in place
# alogrithm. if the number is not relatively prime to the modulus
# (i.e. their gcd is not one) then NaN is returned.
- my ($self,$num,$mod,@r) = objectify(2,@_);
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
- return $num if $num->modify('bmodinv');
+ return $x if $x->modify('bmodinv');
- return $num->bnan()
- if ($mod->{sign} ne '+' # -, NaN, +inf, -inf
- || $num->is_zero() # or num == 0
- || $num->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
+ return $x->bnan()
+ if ($y->{sign} ne '+' # -, NaN, +inf, -inf
+ || $x->is_zero() # or num == 0
+ || $x->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
);
- # put least residue into $num if $num was negative, and thus make it positive
- $num->bmod($mod) if $num->{sign} eq '-';
+ # put least residue into $x if $x was negative, and thus make it positive
+ $x->bmod($y) if $x->{sign} eq '-';
if ($CALC->can('_modinv'))
{
- $num->{value} = $CALC->_modinv($num->{value},$mod->{value});
- $num->bnan() if !defined $num->{value} ; # in case there was no
- return $num;
+ $x->{value} = $CALC->_modinv($x->{value},$y->{value});
+ $x->bnan() if !defined $x->{value} ; # in case there was none
+ return $x;
}
my ($u, $u1) = ($self->bzero(), $self->bone());
- my ($a, $b) = ($mod->copy(), $num->copy());
+ my ($a, $b) = ($y->copy(), $x->copy());
# first step need always be done since $num (and thus $b) is never 0
# Note that the loop is aligned so that the check occurs between #2 and #1
# if the gcd is not 1, then return NaN! It would be pointless to
# have called bgcd to check this first, because we would then be performing
# the same Euclidean Algorithm *twice*
- return $num->bnan() unless $a->is_one();
+ return $x->bnan() unless $a->is_one();
- $u1->bmod($mod);
- $num->{value} = $u1->{value};
- $num->{sign} = $u1->{sign};
- $num;
+ $u1->bmod($y);
+ $x->{value} = $u1->{value};
+ $x->{sign} = $u1->{sign};
+ $x;
}
sub bmodpow
}
# in the trivial case,
- return $num->bzero() if $mod->is_one();
- return $num->bone() if $num->is_zero() or $num->is_one();
+ return $num->bzero(@r) if $mod->is_one();
+ return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
# $num->bmod($mod); # if $x is large, make it smaller first
my $acc = $num->copy(); # but this is not really faster...
# (BINT or num_str, BINT or num_str) return BINT
# compute factorial numbers
# modifies first argument
- my ($self,$x,@r) = objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bfac');
return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
- return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+ return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
if ($CALC->can('_fac'))
{
my $n = $x->copy();
$x->bone();
+ # seems we need not to temp. clear A/P of $x since the result is the same
my $f = $self->new(2);
while ($f->bacmp($n) < 0)
{
$x->bmul($f); $f->binc();
}
- $x->bmul($f); # last step
- $x->round(@r); # round
+ $x->bmul($f,@r); # last step and also round
}
sub bpow
# (BINT or num_str, BINT or num_str) return BINT
# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
# modifies first argument
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bpow');
$r[3] = $y; # no push!
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bone(@r) if $y->is_zero();
+ return $x->bone('+',@r) if $y->is_zero();
return $x->round(@r) if $x->is_one() || $y->is_one();
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
if ($CALC->can('_pow'))
{
$x->{value} = $CALC->_pow($x->{value},$y->{value});
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# based on the assumption that shifting in base 10 is fast, and that mul
# stripping them out of the multiplication, and add $count * $y zeros
# afterwards like this:
# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
-# creates deep recursion?
+# creates deep recursion since brsft/blsft use bpow sometimes.
# my $zeros = $x->_trailing_zeros();
# if ($zeros > 0)
# {
# $x->bpow($y); # recursion (will not branch into here again)
# $zeros = $y * $zeros; # real number of zeros to add
# $x->blsft($zeros,10);
-# return $x->round($a,$p,$r);
+# return $x->round(@r);
# }
my $pow2 = $self->__one();
$x->bmul($x);
}
$x->bmul($pow2);
- $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub blsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
-
+
+ # set up parameters
+ my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,@r) = objectify(2,@_);
+ }
+
return $x if $x->modify('blsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->round($a,$p,$r) if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
if (defined $t)
{
- $x->{value} = $t; return $x->round($a,$p,$r);
+ $x->{value} = $t; return $x->round(@r);
}
# fallback
- return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
+ return $x->bmul( $self->bpow($n, $y, @r), @r );
}
sub brsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,@r) = objectify(2,@_);
+ }
return $x if $x->modify('brsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->round($a,$p,$r) if $y->is_zero();
- return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
+ return $x->round(@r) if $y->is_zero();
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
# this only works for negative numbers when shifting in base 2
if (($x->{sign} eq '-') && ($n == 2))
{
- return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
+ return $x->round(@r) if $x->is_one('-'); # -1 => -1
if (!$y->is_one())
{
# although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
my $res = $self->new('0b'.$bin); # add prefix and convert back
$res->binc(); # remember to increment
$x->{value} = $res->{value}; # take over value
- return $x->round($a,$p,$r); # we are done now, magic, isn't?
+ return $x->round(@r); # we are done now, magic, isn't?
}
$x->bdec(); # n == 2, but $y == 1: this fixes it
}
if (defined $t)
{
$x->{value} = $t;
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
# fallback
- $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
+ $x->bdiv($self->bpow($n,$y, @r), @r);
$x;
}
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x & y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('band');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->bzero() if $y->is_zero() || $x->is_zero();
+ return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
my $sign = 0; # sign of result
$sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
if ($CALC->can('_and') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_and($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bior
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x | y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bior');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
my $sign = 0; # sign of result
$sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
if ($CALC->can('_or') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_or($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bxor
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x ^ y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
return $x if $x->modify('bxor');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
my $sign = 0; # sign of result
$sign = 1 if $x->{sign} ne $y->{sign};
if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_xor($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub length
{
# return the nth decimal digit, negative values count backward, 0 is right
my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- $n = 0 if !defined $n;
- $CALC->_digit($x->{value},$n);
+ $CALC->_digit($x->{value},$n||0);
}
sub _trailing_zeros
# if not: since we do not know underlying internal representation:
my $es = "$x"; $es =~ /([0]*)$/;
return 0 if !defined $1; # no zeros
- return CORE::length("$1"); # as string, not as +0!
+ CORE::length("$1"); # as string, not as +0!
}
sub bsqrt
{
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bsqrt');
return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
- return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
- return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
+ return $x->round(@r) if $x->is_one(); # 1 => 1
- return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
+ return $upgrade->bsqrt($x,@r) if defined $upgrade;
if ($CALC->can('_sqrt'))
{
$x->{value} = $CALC->_sqrt($x->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
- return $x->bone($a,$p) if $x < 4; # 2,3 => 1
+ return $x->bone('+',@r) if $x < 4; # 2,3 => 1
my $y = $x->copy();
my $l = int($x->length()/2);
$x /= $two;
}
$x-- if $x * $x > $y; # overshot?
- $x->round($a,$p,$r);
+ $x->round(@r);
}
sub exponent
# that's inefficient
my $zeros = $m->_trailing_zeros();
$m->brsft($zeros,10) if $zeros != 0;
-# $m /= 10 ** $zeros if $zeros != 0;
$m;
}
# since we do not know underlying represention of $x, use decimal string
#my $r = substr ($$xs,-$follow);
my $r = substr ("$x",-$follow);
- return 1 if $r =~ /[^0]/; return 0;
+ return 1 if $r =~ /[^0]/;
+ 0;
}
sub fround
$pl++; $pl ++ if $pad >= $len;
$digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
- # 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
my $round_up = 1; # default round up
);
my $put_back = 0; # not yet modified
- # old code, depend on internal representation
- # split mantissa at $pad and then pad with zeros
- #my $s5 = int($pad / 5);
- #my $i = 0;
- #while ($i < $s5)
- # {
- # $x->{value}->[$i++] = 0; # replace with 5 x 0
- # }
- #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
- #my $rem = $pad % 5; # so much left over
- #if ($rem > 0)
- # {
- # #print "remainder $rem\n";
- ## #print "elem $x->{value}->[$s5]\n";
- # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
- # }
- #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
- #print ${$CALC->_str($pad->{value})}," $len\n";
-
if (($pad > 0) && ($pad <= $len))
{
substr($$xs,-$pad,$pad) = '0' x $pad;
$pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
# we modify directly the string variant instead of creating a number and
- # adding it
+ # adding it, since that is faster (we already have the string)
my $c = 0; $pad ++; # for $pad == $len case
while ($pad <= $len)
{
}
$$xs = '1'.$$xs if $c == 0;
- # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
+ $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0)
{
# return integer less or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- # not needed: return $x if $x->modify('bfloor');
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bceil
{
# return integer greater or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- # not needed: return $x if $x->modify('bceil');
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
##############################################################################
my $self = shift;
my $x = $self->bone(); # $x->{value} = $CALC->_one();
$x->{sign} = shift || '+';
- return $x;
+ $x;
}
sub _swap
Math::BigInt->config(); # return hash containing configuration/version
+ # precision and accuracy (see section about rounding for more)
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set P $x to $n
+
+ Math::BigInt->precision(); # get/set global P for all BigInt objects
+ Math::BigInt->accuracy(); # get/set global A for all BigInt objects
+
=head1 DESCRIPTION
All operators (inlcuding basic math operations) are overloaded if you
my ($c,$cx,$cy) = @_;
- # fast comp based on array elements
+ # fast comp based on number of array elements (aka pseudo-length)
my $lxy = scalar @$cx - scalar @$cy;
return -1 if $lxy < 0; # already differs, ret
return 1 if $lxy > 0; # ditto
}
print "# INC = @INC\n";
- plan tests => 1599;
+ plan tests => 1627;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2368;
+ plan tests => 2392;
}
use Math::BigInt lib => 'BareCalc';
$class = "Math::BigInt";
$CL = "Math::BigInt::BareCalc";
-my $version = '1.54'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.60'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
--- /dev/null
+#!/usr/bin/perl -w
+
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes under BareCalc
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/bare_mif.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 617
+ + 1; # our onw tests
+ }
+
+print "# ",Math::BigInt->config()->{lib},"\n";
+
+use Math::BigInt lib => 'BareCalc';
+use Math::BigFloat lib => 'BareCalc';
+
+use vars qw/$mbi $mbf/;
+
+$mbi = 'Math::BigInt';
+$mbf = 'Math::BigFloat';
+
+ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+
+require 'mbimbf.inc';
+
ok ($y,1200); ok ($x,1200);
###############################################################################
+# Really huge, big, ultra-mega-biggy-monster exponents
+# Technically, the exponents should not be limited (they are BigInts), but
+# practically there are a few places were they are limited to a Perl scalar.
+# This is sometimes for speed, sometimes because otherwise the number wouldn't
+# fit into your memory (just think of 1e123456789012345678901234567890 + 1!)
+# anyway. We don't test everything here, but let's make sure it just basically
+# works.
+
+my $monster = '1e1234567890123456789012345678901234567890';
+
+# new
+ok ($class->new($monster)->bsstr(),
+ '1e+1234567890123456789012345678901234567890');
+# cmp
+ok ($class->new($monster) > 0,1);
+
+# sub/mul
+ok ($class->new($monster)->bsub( $monster),0);
+ok ($class->new($monster)->bmul(2)->bsstr(),
+ '2e+1234567890123456789012345678901234567890');
+
+###############################################################################
# zero,inf,one,nan
$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$ans = eval $try;
ok ($ans,"$class 4 5");
+###############################################################################
+# test whether an opp calls objectify properly or not (or at least does what
+# it should do given non-objects, w/ or w/o objectify())
+
+ok ($class->new(123)->badd(123),246);
+ok ($class->badd(123,321),444);
+ok ($class->badd(123,$class->new(321)),444);
+
+ok ($class->new(123)->bsub(122),1);
+ok ($class->bsub(321,123),198);
+ok ($class->bsub(321,$class->new(123)),198);
+
+ok ($class->new(123)->bmul(123),15129);
+ok ($class->bmul(123,123),15129);
+ok ($class->bmul(123,$class->new(123)),15129);
+
+ok ($class->new(15129)->bdiv(123),123);
+ok ($class->bdiv(15129,123),123);
+ok ($class->bdiv(15129,$class->new(123)),123);
+
+ok ($class->new(15131)->bmod(123),2);
+ok ($class->bmod(15131,123),2);
+ok ($class->bmod(15131,$class->new(123)),2);
+
+ok ($class->new(2)->bpow(16),65536);
+ok ($class->bpow(2,16),65536);
+ok ($class->bpow(2,$class->new(16)),65536);
+
+ok ($class->new(2**15)->brsft(1),2**14);
+ok ($class->brsft(2**15,1),2**14);
+ok ($class->brsft(2**15,$class->new(1)),2**14);
+
+ok ($class->new(2**13)->blsft(1),2**14);
+ok ($class->blsft(2**13,1),2**14);
+ok ($class->blsft(2**13,$class->new(1)),2**14);
+
1; # all done
###############################################################################
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 2; # own tests
}
###############################################################################
# bool
-$x = Math::BigInt->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
-$x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
+$x = $class->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
+$x = $class->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
###############################################################################
# objectify()
ok ($args[4],7); ok (ref($args[4]),'');
###############################################################################
+# test whether an opp calls objectify properly or not (or at least does what
+# it should do given non-objects, w/ or w/o objectify())
+
+ok ($class->new(123)->badd(123),246);
+ok ($class->badd(123,321),444);
+ok ($class->badd(123,$class->new(321)),444);
+
+ok ($class->new(123)->bsub(122),1);
+ok ($class->bsub(321,123),198);
+ok ($class->bsub(321,$class->new(123)),198);
+
+ok ($class->new(123)->bmul(123),15129);
+ok ($class->bmul(123,123),15129);
+ok ($class->bmul(123,$class->new(123)),15129);
+
+ok ($class->new(15129)->bdiv(123),123);
+ok ($class->bdiv(15129,123),123);
+ok ($class->bdiv(15129,$class->new(123)),123);
+
+ok ($class->new(15131)->bmod(123),2);
+ok ($class->bmod(15131,123),2);
+ok ($class->bmod(15131,$class->new(123)),2);
+
+ok ($class->new(2)->bpow(16),65536);
+ok ($class->bpow(2,16),65536);
+ok ($class->bpow(2,$class->new(16)),65536);
+
+ok ($class->new(2**15)->brsft(1),2**14);
+ok ($class->brsft(2**15,1),2**14);
+ok ($class->brsft(2**15,$class->new(1)),2**14);
+
+ok ($class->new(2**13)->blsft(1),2**14);
+ok ($class->blsft(2**13,1),2**14);
+ok ($class->blsft(2**13,$class->new(1)),2**14);
+
+###############################################################################
# test for floating-point input (other tests in bnorm() below)
$z = 1050000000000000; # may be int on systems with 64bit?
ok ($x,$y);
-###############################################################################
-# see if mul shortcut for small numbers works
-
-$x = '9' x $bl;
-$x = $class->new($x);
-# 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
-ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+ #############################################################################
+ # see if mul shortcut for small numbers works
- }
+ $x = '9' x $bl;
+ $x = $class->new($x);
+ # 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
+ ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+}
###############################################################################
# bug with rest "-0" in div, causing further div()s to fail
ok ($y,'0'); is_valid($y); # $y not '-0'
###############################################################################
-# bug in $x->bmod($y) if $x < 0 and $y > 0
+# bug in $x->bmod($y)
+# if $x < 0 and $y > 0
$x = $class->new('-629'); ok ($x->bmod(5033),4404);
###############################################################################
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2368;
+ plan tests => 2392;
}
use Math::BigInt;
BEGIN
{
- $| = 1; # 7 values 6 groups 4 oprators 2 classes
- plan tests => 7 * 6 * 4 * 2;
chdir 't' if -d 't';
unshift @INC, '../lib';
}
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/inf_nan.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ # values groups oprators classes tests
+ plan tests => 7 * 6 * 5 * 4 * 2 +
+ 7 * 6 * 2 * 4 * 1; # bmod
+ }
use Math::BigInt;
use Math::BigFloat;
+use Math::BigInt::Subclass;
+use Math::BigFloat::Subclass;
+
+my @classes =
+ qw/Math::BigInt Math::BigFloat
+ Math::BigInt::Subclass Math::BigFloat::Subclass
+ /;
my (@args,$x,$y,$z);
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] + $args[1] should be $args[2] but is $x\n",
- if !ok ($x->badd($y)->bstr(),$args[2]);
+ my $r = $x->badd($y);
+
+ print "# x $class $args[0] + $args[1] should be $args[2] but is $x\n",
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] + $args[1] should be $args[2] but is $r\n",
+ if !ok ($x->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] - $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bsub($y)->bstr(),$args[2]);
+ my $r = $x->bsub($y);
+
+ print "# x $class $args[0] - $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] - $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
$args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $class $args[0] * $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bmul($y)->bstr(),$args[2]);
+ my $r = $x->bmul($y);
+
+ print "# x $class $args[0] * $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] * $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] / $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bdiv($y)->bstr(),$args[2]);
+
+ my $t = $x->copy();
+ my $tmod = $t->copy();
+
+ # bdiv in scalar context
+ my $r = $x->bdiv($y);
+ print "# x $class $args[0] / $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] / $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
+
+ # bmod and bdiv in list context
+ my ($d,$rem) = $t->bdiv($y);
+
+ # bdiv in list context
+ print "# t $class $args[0] / $args[1] should be $args[2] but is $t\n"
+ if !ok ($t->bstr(),$args[2]);
+ print "# d $class $args[0] / $args[1] should be $args[2] but is $d\n"
+ if !ok ($d->bstr(),$args[2]);
+
+ # bmod
+ my $m = $tmod->bmod($y);
+
+ # bmod() agrees with bdiv?
+ print "# m $class $args[0] % $args[1] should be $rem but is $m\n"
+ if !ok ($m->bstr(),$rem->bstr());
+ # bmod() return agrees with set value?
+ print "# o $class $args[0] % $args[1] should be $m ($rem) but is $tmod\n"
+ if !ok ($tmod->bstr(),$m->bstr());
+
}
}
${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
-ok (Math::BigFloat->new('123.456'),'123.456');
+ok ($mbf->new('123.456'),'123.456');
${"$mbi\::accuracy"} = undef; # reset
###############################################################################
$x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); ok ($x,'123.4');
###############################################################################
+# test (also under Bare) that bfac() rounds at last step
+
+ok ($mbi->new(12)->bfac(),'479001600');
+ok ($mbi->new(12)->bfac(2),'480000000');
+$x = $mbi->new(12); $x->accuracy(2); ok ($x->bfac(),'480000000');
+$x = $mbi->new(13); $x->accuracy(2); ok ($x->bfac(),'6200000000');
+$x = $mbi->new(13); $x->accuracy(3); ok ($x->bfac(),'6230000000');
+$x = $mbi->new(13); $x->accuracy(4); ok ($x->bfac(),'6227000000');
+# this does 1,2,3...9,10,11,12...20
+$x = $mbi->new(20); $x->accuracy(1); ok ($x->bfac(),'2000000000000000000');
+
+###############################################################################
+# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
+$x = $mbi->new('123456')->bsqrt(2,undef); ok ($x,'350'); # not 351
+$x = $mbi->new('3')->bsqrt(2,undef); ok ($x->accuracy(),2);
+
+$mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf');
+ok ($x,'360'); # not 355 nor 350
+
+$x = $mbi->new('126025')->bsqrt(undef,2); ok ($x,'400'); # not 355
+
+
+###############################################################################
# test mixed arguments
$x = $mbf->new(10);
###############################################################################
# test whether bone/bzero take additional A & P, or reset it etc
-foreach my $class ($mbi,$mbf)
+foreach my $c ($mbi,$mbf)
{
- $x = $class->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
+ $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
+ $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
+ $x = $c->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2); $x->bone('+',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bone('+',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
+ $x = $c->new(2); $x->bone('-',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bone('-',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
- $x = $class->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+ $x = $c->new(2); $x->bzero(2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bzero(undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
+ }
+
+###############################################################################
+# test whether bone/bzero honour globals
- $x = $class->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+for my $c ($mbi,$mbf)
+ {
+ $c->accuracy(2);
+ $x = $c->bone(); ok ($x->accuracy(),2);
+ $x = $c->bzero(); ok ($x->accuracy(),2);
+ $c->accuracy(undef);
+
+ $c->precision(-2);
+ $x = $c->bone(); ok ($x->precision(),-2);
+ $x = $c->bzero(); ok ($x->precision(),-2);
+ $c->precision(undef);
}
###############################################################################
# new with set accuracy/precision and with parameters
-foreach my $class ($mbi,$mbf)
+foreach my $c ($mbi,$mbf)
{
- ok ($class->new(123,4,-3),'NaN'); # with parameters
- ${"$class\::accuracy"} = 42;
- ${"$class\::precision"} = 2;
- ok ($class->new(123),'NaN'); # with globals
- ${"$class\::accuracy"} = undef;
- ${"$class\::precision"} = undef;
+ ok ($c->new(123,4,-3),'NaN'); # with parameters
+ ${"$c\::accuracy"} = 42;
+ ${"$c\::precision"} = 2;
+ ok ($c->new(123),'NaN'); # with globals
+ ${"$c\::accuracy"} = undef;
+ ${"$c\::precision"} = undef;
}
# binary ops
# print "Check a=$a p=$p\n";
# print "# Tried: '$try'\n";
- ok ($x->{_a}, $a) && ok_undef ($x->{_p}) if $a ne '';
- ok ($x->{_p}, $p) && ok_undef ($x->{_a}) if $p ne '';
+ if ($a ne '')
+ {
+ if (!(ok ($x->{_a}, $a) && ok_undef ($x->{_p})))
+ {
+ print "# Check: A=$a and P=undef\n";
+ print "# Tried: '$try'\n";
+ }
+ }
+ if ($p ne '')
+ {
+ if (!(ok ($x->{_p}, $p) && ok_undef ($x->{_a})))
+ {
+ print "# Check: A=undef and P=$p\n";
+ print "# Tried: '$try'\n";
+ }
+ }
}
# all done
{
my $x = shift;
- ok (1,1) and return if !defined $x;
+ ok (1,1) and return 1 if !defined $x;
ok ($x,'undef');
print "# Called from ",join(' ',caller()),"\n";
+ return 0;
}
###############################################################################
1,,:123,4,:0
1,,:123,,-4:0
1,,-4:123,,:0
+&band
+1,,:3,,:1
+1234,1,:0,,:0
+1234,,:0,1,:0
+1234,,-1:0,,:0
+1234,,:0,,-1:0
+0xFF,,:0x10,,:0x0x10
+0xFF,2,:0xFF,,:250
+0xFF,,:0xFF,2,:250
+0xFF,,1:0xFF,,:250
+0xFF,,:0xFF,,1:250
+&bxor
+1,,:3,,:2
+1234,1,:0,,:1000
+1234,,:0,1,:1000
+1234,,3:0,,:1000
+1234,,:0,,3:1000
+0xFF,,:0x10,,:239
+# 250 ^ 255 => 5
+0xFF,2,:0xFF,,:5
+0xFF,,:0xFF,2,:5
+0xFF,,1:0xFF,,:5
+0xFF,,:0xFF,,1:5
+# 250 ^ 4095 = 3845 => 3800
+0xFF,2,:0xFFF,,:3800
+# 255 ^ 4100 = 4347 => 4300
+0xFF,,:0xFFF,2,:4300
+0xFF,,2:0xFFF,,:3800
+# 255 ^ 4100 = 10fb => 4347 => 4300
+0xFF,,:0xFFF,,2:4300
+&bior
+1,,:3,,:3
+1234,1,:0,,:1000
+1234,,:0,1,:1000
+1234,,3:0,,:1000
+1234,,:0,,3:1000
+0xFF,,:0x10,,:0x0xFF
+# FF | FA = FF => 250
+250,2,:0xFF,,:250
+0xFF,,:250,2,:250
+0xFF,,1:0xFF,,:250
+0xFF,,:0xFF,,1:250
+&bpow
+2,,:3,,:8
+2,,:0,,:1
+2,2,:0,,:1
+2,,:0,2,:1
}
print "# INC = @INC\n";
- plan tests => 438
+ plan tests => 617
+ 16; # own tests
}
-use Math::BigInt 1.53;
-use Math::BigFloat 1.30;
+use Math::BigInt 1.60;
+use Math::BigFloat 1.35;
use vars qw/$mbi $mbf/;
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2368
+ plan tests => 2392
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 438;
+ plan tests => 617;
}
use Math::BigInt::Subclass;
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 1;
}
default).
The C<open> pragma serves as one of the interfaces to declare default
-"layers" for all I/O.
-
-The C<open> pragma is used to declare one or more default layers for
-I/O operations. Any open(), readpipe() (aka qx//) and similar
-operators found within the lexical scope of this pragma will use the
-declared defaults.
+"layers" (also known as "disciplines") for all I/O. Any open(),
+readpipe() (aka qx//) and similar operators found within the lexical
+scope of this pragma will use the declared defaults.
With the C<IN> subpragma you can declare the default layers
of input streams, and with the C<OUT> subpragma you can declare
return first;
}
}
- else if (first->op_type == OP_WANTARRAY) {
- /* XXX true only if this result will be returned, else should
- propagate outer context */
- if (type == OP_AND)
- list(other);
- else
- scalar(other);
- }
else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
OP *k1 = ((UNOP*)first)->op_first;
OP *k2 = k1->op_sibling;
return falseop;
}
}
- else if (first->op_type == OP_WANTARRAY) {
- /* XXX true only if this result will be returned, else should
- propagate outer context */
- list(trueop);
- scalar(falseop);
- }
NewOp(1101, logop, 1, LOGOP);
logop->op_type = OP_COND_EXPR;
logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
void
Perl_cv_undef(pTHX_ CV *cv)
{
+ CV *outsidecv;
+ CV *freecv = Nullcv;
+ bool is_eval = CvEVAL(cv) && !CvGV(cv); /* is this eval"" ? */
+
#ifdef USE_5005THREADS
if (CvMUTEXP(cv)) {
MUTEX_DESTROY(CvMUTEXP(cv));
}
SvPOK_off((SV*)cv); /* forget prototype */
CvGV(cv) = Nullgv;
+ outsidecv = CvOUTSIDE(cv);
/* Since closure prototypes have the same lifetime as the containing
* CV, they don't hold a refcount on the outside CV. This avoids
* the refcount loop between the outer CV (which keeps a refcount to
* the closure prototype in the pad entry for pp_anoncode()) and the
* closure prototype, and the ensuing memory leak. --GSAR */
if (!CvANON(cv) || CvCLONED(cv))
- SvREFCNT_dec(CvOUTSIDE(cv));
+ freecv = outsidecv;
CvOUTSIDE(cv) = Nullcv;
if (CvCONST(cv)) {
SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
if (CvPADLIST(cv)) {
/* may be during global destruction */
if (SvREFCNT(CvPADLIST(cv))) {
- I32 i = AvFILLp(CvPADLIST(cv));
- while (i >= 0) {
- SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
- SV* sv = svp ? *svp : Nullsv;
+ AV *padlist = CvPADLIST(cv);
+ I32 ix;
+ /* pads may be cleared out already during global destruction */
+ if (is_eval && !PL_dirty) {
+ /* inner references to eval's cv must be fixed up */
+ AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV *comppad = (AV*)AvARRAY(padlist)[1];
+ SV **namepad = AvARRAY(comppad_name);
+ SV **curpad = AvARRAY(comppad);
+ for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ SV *namesv = namepad[ix];
+ if (namesv && namesv != &PL_sv_undef
+ && *SvPVX(namesv) == '&'
+ && ix <= AvFILLp(comppad))
+ {
+ CV *innercv = (CV*)curpad[ix];
+ if (innercv && SvTYPE(innercv) == SVt_PVCV
+ && CvOUTSIDE(innercv) == cv)
+ {
+ CvOUTSIDE(innercv) = outsidecv;
+ if (!CvANON(innercv) || CvCLONED(innercv)) {
+ (void)SvREFCNT_inc(outsidecv);
+ if (SvREFCNT(cv))
+ SvREFCNT_dec(cv);
+ }
+ }
+ }
+ }
+ }
+ if (freecv)
+ SvREFCNT_dec(freecv);
+ ix = AvFILLp(padlist);
+ while (ix >= 0) {
+ SV* sv = AvARRAY(padlist)[ix--];
if (!sv)
continue;
if (sv == (SV*)PL_comppad_name)
}
CvPADLIST(cv) = Nullav;
}
+ else if (freecv)
+ SvREFCNT_dec(freecv);
if (CvXSUB(cv)) {
CvXSUB(cv) = 0;
}
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL17383"
+ ,"DEVEL17411"
,NULL
};
=item *
Previous versions of perl and some readings of some sections of Camel III
-implied that C<:raw> "discipline" was the inverse of C<:crlf>.
+implied that the C<:raw> "discipline" was the inverse of C<:crlf>.
Turning off "clrfness" is no longer enough to make a stream truly
-binary. So the PerlIO C<:raw> discipline is now formally defined as being
+binary. So the PerlIO C<:raw> layer (or "discipline", to use the
+Camel book's older terminology) is now formally defined as being
equivalent to binmode(FH) - which is in turn defined as doing whatever
is necessary to pass each byte as-is without any translation.
In particular binmode(FH) - and hence C<:raw> - will now turn off both CRLF
-and UTF-8 translation and remove other "layers" (e.g. :encoding()) which
+and UTF-8 translation and remove other layers (e.g. :encoding()) which
would modify byte stream.
=item *
If your environment variables (LC_ALL, LC_CTYPE, LANG, LANGUAGE) look
like you want to use UTF-8 (any of the the variables match C</utf-?8/i>),
-your STDIN, STDOUT, STDERR handles and the default open discipline
+your STDIN, STDOUT, STDERR handles and the default open layer
(see L<open>) are marked as UTF-8. (This feature, like other new
features that combine Unicode and I/O, work only if you are using
PerlIO, but that's is the default.)
=item *
-C<open> is a new pragma for setting the default I/O disciplines
+C<open> is a new pragma for setting the default I/O layers
for open().
=item *
comp.infosystems.www.authoring.cgi Writing CGI scripts for the Web.
-There is also a Usenet gateway to Perl mailing lists sponsored by perl.org at
-nntp://nntp.perl.org , or a web interface to the same lists at
-http://nntp.perl.org/group/ . Other groups are listed at
-http://lists.perl.org/ .
+There is also a Usenet gateway to Perl mailing lists sponsored by perl.org at
+nntp://nntp.perl.org , a web interface to the same lists at
+http://nntp.perl.org/group/ and these lists are also available under the
+C<perl.*> hierarchy at http://groups.google.com . Other groups are listed at
+http://lists.perl.org/ ( also known as http://lists.cpan.org/ ).
+
+A nice place to ask questions is the PerlMonks site, http://www.perlmonks.org/
+
+Note that none of the above are supposed to write your code for you:
+asking questions about particular problems or general advice is fine,
+but asking someone to write your code for free is not very cool.
=head2 Where should I post source code?
=head2 Perl in Magazines
-The first and only periodical devoted to All Things Perl,
+The first (and for a long time, only) periodical devoted to All Things Perl,
I<The Perl Journal> contains tutorials, demonstrations, case studies,
announcements, contests, and much more. I<TPJ> has columns on web
development, databases, Win32 Perl, graphical programming, regular
mailing lists. Consult the documentation that came with the module for
subscription information.
+A comprehensive list of Perl related mailing lists can be found at:
+
http://lists.cpan.org/
+( also visible as http://lists.perl.org/ )
+
=head2 Archives of comp.lang.perl.misc
The Google search engine now carries archived and searchable newsgroup
packed address of the appropriate type for the socket. See the examples in
L<perlipc/"Sockets: Client/Server Communication">.
-=item binmode FILEHANDLE, DISCIPLINE
+=item binmode FILEHANDLE, LAYER
=item binmode FILEHANDLE
taken as the name of the filehandle. Returns true on success,
C<undef> on failure.
-If DISCIPLINE is omitted or specified as C<:raw> the filehandle is made
+If LAYER is omitted or specified as C<:raw> the filehandle is made
suitable for passing binary data. This includes turning off possible CRLF
translation and marking it as bytes (as opposed to Unicode characters).
Note that as desipite what may be implied in I<"Programming Perl">
(the Camel) or elsewhere C<:raw> is I<not> the simply inverse of C<:crlf>
-- other disciplines which would affect binary nature of the stream are
+-- other layers which would affect binary nature of the stream are
I<also> disabled. See L<PerlIO>, L<perlrun> and the discussion about the
PERLIO environment variable.
+I<The LAYER parameter of the binmode() function is described as "DISCIPLINE"
+in "Programming Perl, 3rd Edition". However, since the publishing of this
+book, by many known as "Camel III", the consensus of the naming of this
+functionality has moved from "discipline" to "layer". All documentation
+of this version of Perl therefore refers to "layers" rather than to
+"disciplines". Now back to the regularly scheduled documentation...>
+
On some systems (in general, DOS and Windows-based systems) binmode()
is necessary when you're not working with a text file. For the sake
of portability it is a good idea to always use it when appropriate,
In other words: regardless of platform, use binmode() on binary files
(like for example images).
-If DISCIPLINE is present it is a single string, but may contain
+If LAYER is present it is a single string, but may contain
multiple directives. The directives alter the behaviour of the
-file handle. When DISCIPLINE is present using binmode on text
+file handle. When LAYER is present using binmode on text
file makes sense.
To mark FILEHANDLE as UTF-8, use C<:utf8>.
The C<:bytes>, C<:crlf>, and C<:utf8>, and any other directives of the
-form C<:...>, are called I/O I<disciplines>. The normal implementation
-of disciplines in Perl 5.8 and later is in terms of I<layers>. See
-L<PerlIO>. (There is typically a one-to-one correspondence between
-layers and disiplines.) The C<open> pragma can be used to establish
-default I/O disciplines. See L<open>.
+form C<:...>, are called I/O I<layers>. The C<open> pragma can be used to
+establish default I/O layers. See L<open>.
In general, binmode() should be called after open() but before any I/O
is done on the filehandle. Calling binmode() will normally flush any
pending buffered output data (and perhaps pending input data) on the
-handle. An exception to this is the C<:encoding> discipline that
+handle. An exception to this is the C<:encoding> layer that
changes the default character encoding of the handle, see L<open>.
-The C<:encoding> discipline sometimes needs to be called in
+The C<:encoding> layer sometimes needs to be called in
mid-stream, and it doesn't flush the stream.
The operating system, device drivers, C libraries, and Perl run-time
In the 2-arguments (and 1-argument) form opening C<'-'> opens STDIN
and opening C<< '>-' >> opens STDOUT.
-You may use the three-argument form of open to specify
-I<I/O disciplines> or IO "layers" to be applied to the handle that affect how the input and output
-are processed: (see L<open> and L<PerlIO> for more details).
-For example
+You may use the three-argument form of open to specify IO "layers"
+(sometimes also referred to as "disciplines") to be applied to the handle
+that affect how the input and output are processed (see L<open> and
+L<PerlIO> for more details). For example
open(FH, "<:utf8", "file")
will open the UTF-8 encoded file containing Unicode characters,
-see L<perluniintro>. (Note that if disciplines are specified in the
-three-arg form then default disciplines set by the C<open> pragma are
+see L<perluniintro>. (Note that if layers are specified in the
+three-arg form then default layers set by the C<open> pragma are
ignored.)
Open returns nonzero upon success, the undefined value otherwise. If
Note the I<characters>: depending on the status of the filehandle,
either (8-bit) bytes or characters are read. By default all
filehandles operate on bytes, but for example if the filehandle has
-been opened with the C<:utf8> discipline (see L</open>, and the C<open>
+been opened with the C<:utf8> I/O layer (see L</open>, and the C<open>
pragma, L<open>), the I/O will operate on characters, not bytes.
=item readdir DIRHANDLE
Note the I<characters>: depending on the status of the socket, either
(8-bit) bytes or characters are received. By default all sockets
operate on bytes, but for example if the socket has been changed using
-binmode() to operate with the C<:utf8> discipline (see the C<open>
+binmode() to operate with the C<:utf8> I/O layer (see the C<open>
pragma, L<open>), the I/O will operate on characters, not bytes.
=item redo LABEL
Note the I<in bytes>: even if the filehandle has been set to
operate on characters (for example by using the C<:utf8> open
-discipline), tell() will return byte offsets, not character offsets
+layer), tell() will return byte offsets, not character offsets
(because implementing that would render seek() and tell() rather slow).
If you want to position file for C<sysread> or C<syswrite>, don't use
Note the I<characters>: depending on the status of the socket, either
(8-bit) bytes or characters are sent. By default all sockets operate
on bytes, but for example if the socket has been changed using
-binmode() to operate with the C<:utf8> discipline (see L</open>, or
+binmode() to operate with the C<:utf8> I/O layer (see L</open>, or
the C<open> pragma, L<open>), the I/O will operate on characters, not
bytes.
Note the I<characters>: depending on the status of the filehandle,
either (8-bit) bytes or characters are read. By default all
filehandles operate on bytes, but for example if the filehandle has
-been opened with the C<:utf8> discipline (see L</open>, and the C<open>
+been opened with the C<:utf8> I/O layer (see L</open>, and the C<open>
pragma, L<open>), the I/O will operate on characters, not bytes.
An OFFSET may be specified to place the read data at some place in the
negative).
Note the I<in bytes>: even if the filehandle has been set to operate
-on characters (for example by using the C<:utf8> discipline), tell()
+on characters (for example by using the C<:utf8> I/O layer), tell()
will return byte offsets, not character offsets (because implementing
that would render sysseek() very slow).
Note the I<characters>: depending on the status of the filehandle,
either (8-bit) bytes or characters are written. By default all
filehandles operate on bytes, but for example if the filehandle has
-been opened with the C<:utf8> discipline (see L</open>, and the open
+been opened with the C<:utf8> I/O layer (see L</open>, and the open
pragma, L<open>), the I/O will operate on characters, not bytes.
=item tell FILEHANDLE
Note the I<in bytes>: even if the filehandle has been set to
operate on characters (for example by using the C<:utf8> open
-discipline), tell() will return byte offsets, not character offsets
+layer), tell() will return byte offsets, not character offsets
(because that would render seek() and tell() rather slow).
The return value of tell() for the standard streams like the STDIN
=item open
-Set default disciplines for input and output
+Set default PerlIO layers for input and output
=item ops
been done in Perl, and avoid re-inventing the wheel unless you have a
good reason.
+Good places to look for pre-existing modules include
+http://search.cpan.org/ and asking on modules@perl.org
+
If an existing module B<almost> does what you want, consider writing a
patch, writing a subclass, or otherwise extending the existing module
rather than rewriting it.
=for comment
If/WHEN some brave soul makes these heuristics into a generic
- text-file class (or file discipline?), we can presumably delete
+ text-file class (or PerlIO layer?), we can presumably delete
mention of these icky details from this file, and can instead
- tell people to just use appropriate class/discipline.
+ tell people to just use appropriate class/layer.
Auto-recognition of newline sequences would be another desirable
- feature of such a class/discipline.
+ feature of such a class/layer.
HINT HINT HINT.
=for comment
Arranges for all accesses go straight to the lowest buffered layer provided
by the configration. That is it strips off any layers above that layer.
-In Perl 5.6 and some books the C<:raw> layer (also called a discipline)
-is documented as the inverse of the C<:crlf> layer. That is no longer
-the case - other layers which would alter binary nature of the
-stream are also disabled. If you want UNIX line endings on a platform
-that normally does CRLF translation, but still want UTF-8 or encoding
-defaults the appropriate thing to do is to add C<:perlio> to PERLIO
-environment variable.
+In Perl 5.6 and some books the C<:raw> layer (previously sometimes also
+referred to as a "discipline") is documented as the inverse of the
+C<:crlf> layer. That is no longer the case - other layers which would
+alter binary nature of the stream are also disabled. If you want UNIX
+line endings on a platform that normally does CRLF translation, but still
+want UTF-8 or encoding defaults the appropriate thing to do is to add
+C<:perlio> to PERLIO environment variable.
=item :stdio
The ithreads code has been available since Perl 5.6.0, and is considered
stable. The user-level interface to ithreads (the L<threads> classes)
-appeared in the 5.8.0 release, and as of this time is considered stable,
-although as with all new features, should be treated with caution.
+appeared in the 5.8.0 release, and as of this time is considered stable
+although it should be treated with caution as with all new features.
=head1 What Is A Thread Anyway?
=head2 Creating Threads
The L<threads> package provides the tools you need to create new
-threads. Like any other module, you need to tell Perl you want to use
+threads. Like any other module, you need to tell Perl that you want to use
it; C<use threads> imports all the pieces you need to create basic
threads.
-The simplest, straightforward way to create a thread is with new():
+The simplest, most straightforward way to create a thread is with new():
use threads;
There are times when you may find it useful to have a thread
explicitly give up the CPU to another thread. Your threading package
might not support preemptive multitasking for threads, for example, or
-you may be doing something compute-intensive and want to make sure
+you may be doing something processor-intensive and want to make sure
that the user-interface thread gets called frequently. Regardless,
there are times that you might want a thread to give up the processor.
except that in this case, the data is just copied to a different part of
memory within the same process rather than a real fork taking place.
-To make use of threading however, one usually want the threads to share
+To make use of threading however, one usually wants the threads to share
at least some data between themselves. This is done with the
L<threads::shared> module and the C< : shared> attribute:
between themselves and their data, to avoid race conditions and the like.
Some of these are designed to resemble the common techniques used in thread
libraries such as C<pthreads>; others are Perl-specific. Often, the
-standard techniques are clumsily and difficult to get right (such as
+standard techniques are clumsy and difficult to get right (such as
condition waits). Where possible, it is usually easier to use Perlish
techniques such as queues, which remove some of the hard work involved.
This program uses the pipeline model to generate prime numbers. Each
thread in the pipeline has an input queue that feeds numbers to be
checked, a prime number that it's responsible for, and an output queue
-that into which it funnels numbers that have failed the check. If the thread
+into which it funnels numbers that have failed the check. If the thread
has a number that's failed its check and there's no child thread, then
the thread must have found a new prime number. In that case, a new
child thread is created for that prime and stuck on the end of the
I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept
NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME,
-binmode FILEHANDLE, DISCIPLINE, binmode FILEHANDLE, bless REF,CLASSNAME,
-bless REF, caller EXPR, caller, chdir EXPR, chmod LIST, chomp VARIABLE,
-chomp( LIST ), chomp, chop VARIABLE, chop( LIST ), chop, chown LIST, chr
-NUMBER, chr, chroot FILENAME, chroot, close FILEHANDLE, close, closedir
-DIRHANDLE, connect SOCKET,NAME, continue BLOCK, cos EXPR, cos, crypt
-PLAINTEXT,SALT, dbmclose HASH, dbmopen HASH,DBNAME,MASK, defined EXPR,
-defined, delete EXPR, die LIST, do BLOCK, do SUBROUTINE(LIST), do EXPR,
-dump LABEL, dump, each HASH, eof FILEHANDLE, eof (), eof, eval EXPR, eval
-BLOCK, exec LIST, exec PROGRAM LIST, exists EXPR, exit EXPR, exp EXPR, exp,
-fcntl FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock
-FILEHANDLE,OPERATION, fork, format, formline PICTURE,LIST, getc FILEHANDLE,
-getc, getlogin, getpeername SOCKET, getpgrp PID, getppid, getpriority
-WHICH,WHO, getpwnam NAME, getgrnam NAME, gethostbyname NAME, getnetbyname
-NAME, getprotobyname NAME, getpwuid UID, getgrgid GID, getservbyname
-NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE,
-getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, getgrent,
-gethostent, getnetent, getprotoent, getservent, setpwent, setgrent,
-sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent
-STAYOPEN, endpwent, endgrent, endhostent, endnetent, endprotoent,
-endservent, getsockname SOCKET, getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR,
-glob, gmtime EXPR, goto LABEL, goto EXPR, goto &NAME, grep BLOCK LIST, grep
-EXPR,LIST, hex EXPR, hex, import, index STR,SUBSTR,POSITION, index
-STR,SUBSTR, int EXPR, int, ioctl FILEHANDLE,FUNCTION,SCALAR, join
-EXPR,LIST, keys HASH, kill SIGNAL, LIST, last LABEL, last, lc EXPR, lc,
-lcfirst EXPR, lcfirst, length EXPR, length, link OLDFILE,NEWFILE, listen
-SOCKET,QUEUESIZE, local EXPR, localtime EXPR, lock THING, log EXPR, log,
-lstat EXPR, lstat, m//, map BLOCK LIST, map EXPR,LIST, mkdir FILENAME,MASK,
-mkdir FILENAME, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgrcv
-ID,VAR,SIZE,TYPE,FLAGS, msgsnd ID,MSG,FLAGS, my EXPR, my TYPE EXPR, my EXPR
-: ATTRS, my TYPE EXPR : ATTRS, next LABEL, next, no Module VERSION LIST, no
-Module VERSION, no Module LIST, no Module, oct EXPR, oct, open
-FILEHANDLE,EXPR, open FILEHANDLE,MODE,EXPR, open FILEHANDLE,MODE,EXPR,LIST,
-open FILEHANDLE,MODE,REFERENCE, open FILEHANDLE, opendir DIRHANDLE,EXPR,
-ord EXPR, ord, our EXPR, our EXPR TYPE, our EXPR : ATTRS, our TYPE EXPR :
-ATTRS, pack TEMPLATE,LIST, package NAMESPACE, package, pipe
-READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos, print FILEHANDLE
-LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, printf FORMAT,
-LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, qq/STRING/,
-qr/STRING/, qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR,
-rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH,
-readdir DIRHANDLE, readline EXPR, readlink EXPR, readlink, readpipe EXPR,
-recv SOCKET,SCALAR,LENGTH,FLAGS, redo LABEL, redo, ref EXPR, ref, rename
-OLDNAME,NEWNAME, require VERSION, require EXPR, require, reset EXPR, reset,
-return EXPR, return, reverse LIST, rewinddir DIRHANDLE, rindex
-STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar
-EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select
-FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl
-ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send
+binmode FILEHANDLE, LAYER, binmode FILEHANDLE, bless REF,CLASSNAME, bless
+REF, caller EXPR, caller, chdir EXPR, chmod LIST, chomp VARIABLE, chomp(
+LIST ), chomp, chop VARIABLE, chop( LIST ), chop, chown LIST, chr NUMBER,
+chr, chroot FILENAME, chroot, close FILEHANDLE, close, closedir DIRHANDLE,
+connect SOCKET,NAME, continue BLOCK, cos EXPR, cos, crypt PLAINTEXT,SALT,
+dbmclose HASH, dbmopen HASH,DBNAME,MASK, defined EXPR, defined, delete
+EXPR, die LIST, do BLOCK, do SUBROUTINE(LIST), do EXPR, dump LABEL, dump,
+each HASH, eof FILEHANDLE, eof (), eof, eval EXPR, eval BLOCK, exec LIST,
+exec PROGRAM LIST, exists EXPR, exit EXPR, exp EXPR, exp, fcntl
+FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock FILEHANDLE,OPERATION,
+fork, format, formline PICTURE,LIST, getc FILEHANDLE, getc, getlogin,
+getpeername SOCKET, getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam
+NAME, getgrnam NAME, gethostbyname NAME, getnetbyname NAME, getprotobyname
+NAME, getpwuid UID, getgrgid GID, getservbyname NAME,PROTO, gethostbyaddr
+ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER,
+getservbyport PORT,PROTO, getpwent, getgrent, gethostent, getnetent,
+getprotoent, getservent, setpwent, setgrent, sethostent STAYOPEN, setnetent
+STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent,
+endhostent, endnetent, endprotoent, endservent, getsockname SOCKET,
+getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL,
+goto EXPR, goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex,
+import, index STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl
+FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill SIGNAL, LIST,
+last LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length,
+link OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR,
+lock THING, log EXPR, log, lstat EXPR, lstat, m//, map BLOCK LIST, map
+EXPR,LIST, mkdir FILENAME,MASK, mkdir FILENAME, msgctl ID,CMD,ARG, msgget
+KEY,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, msgsnd ID,MSG,FLAGS, my EXPR, my
+TYPE EXPR, my EXPR : ATTRS, my TYPE EXPR : ATTRS, next LABEL, next, no
+Module VERSION LIST, no Module VERSION, no Module LIST, no Module, oct
+EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE,MODE,EXPR, open
+FILEHANDLE,MODE,EXPR,LIST, open FILEHANDLE,MODE,REFERENCE, open FILEHANDLE,
+opendir DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, our EXPR TYPE, our EXPR :
+ATTRS, our TYPE EXPR : ATTRS, pack TEMPLATE,LIST, package NAMESPACE,
+package, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos,
+print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST,
+printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/,
+qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta,
+rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read
+FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readline EXPR, readlink EXPR,
+readlink, readpipe EXPR, recv SOCKET,SCALAR,LENGTH,FLAGS, redo LABEL, redo,
+ref EXPR, ref, rename OLDNAME,NEWNAME, require VERSION, require EXPR,
+require, reset EXPR, reset, return EXPR, return, reverse LIST, rewinddir
+DIRHANDLE, rindex STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME,
+rmdir, s///, scalar EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir
+DIRHANDLE,POS, select FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT,
+semctl ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send
SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority
WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY,
shift, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE,
=item Important Caveats
-Input and Output Disciplines, Regular Expressions, C<use utf8> still needed
-to enable UTF-8/UTF-EBCDIC in scripts
+Input and Output Layers, Regular Expressions, C<use utf8> still needed to
+enable UTF-8/UTF-EBCDIC in scripts
=item Byte and Character Semantics
=item Methods in Detail
-size, name, size, kind, PERLIO_K_BUFFERED, PERLIO_K_RAW, PERLIO_K_CANCRLF,
+fsize, name, size, kind, PERLIO_K_BUFFERED, PERLIO_K_RAW, PERLIO_K_CANCRLF,
PERLIO_K_FASTGETS, PERLIO_K_MULTIARG, Pushed, Popped, Open, Binmode,
Getarg, Fileno, Dup, Read, Write, Seek, Tell, Close, Flush, Fill, Eof,
Error, Clearerr, Setlinebuf, Get_base, Get_bufsiz, Get_ptr, Get_cnt,
=item $^X doesn't always contain a full path in FreeBSD
-=item Perl will no more be part of "base FreeBSD"
+=item Perl will no longer be part of "base FreeBSD"
=back
=back
-=head2 open - perl pragma to set default disciplines for input and output
+=head2 open - perl pragma to set default PerlIO layers for input and output
=over 4
=over 4
-=item Input and Output Disciplines
+=item Input and Output Layers
Perl knows when a filehandle uses Perl's internal Unicode encodings
(UTF-8, or UTF-EBCDIC if in EBCDIC) if the filehandle is opened with
for Unicode data and byte semantics for non-Unicode data.
The decision to use character semantics is made transparently. If
input data comes from a Unicode source--for example, if a character
-encoding discipline is added to a filehandle or a literal Unicode
+encoding layer is added to a filehandle or a literal Unicode
string constant appears in a program--character semantics apply.
Otherwise, byte semantics are in effect. The C<bytes> pragma should
be used to force byte semantics on Unicode data.
A user of Perl does not normally need to know nor care how Perl
happens to encode its internal strings, but it becomes relevant when
-outputting Unicode strings to a stream without a discipline--one with
+outputting Unicode strings to a stream without a PerlIO layer -- one with
the "default" encoding. In such a case, the raw bytes used internally
(the native character set or UTF-8, as appropriate for each string)
will be used, and a "Wide character" warning will be issued if those
Wide character in print at ...
-To output UTF-8, use the C<:utf8> output discipline. Prepending
+To output UTF-8, use the C<:utf8> output layer. Prepending
binmode(STDOUT, ":utf8");
binmode(STDOUT, ":encoding(shift_jis)");
The matching of encoding names is loose: case does not matter, and
-many encodings have several aliases. Note that C<:utf8> discipline
+many encodings have several aliases. Note that the C<:utf8> layer
must always be specified exactly like that; it is I<not> subject to
the loose matching of encoding names.
Reading in a file that you know happens to be encoded in one of the
Unicode or legacy encodings does not magically turn the data into
Unicode in Perl's eyes. To do that, specify the appropriate
-discipline when opening files
+layer when opening files
open(my $fh,'<:utf8', 'anything');
my $line_of_unicode = <$fh>;
open(my $fh,'<:encoding(Big5)', 'anything');
my $line_of_unicode = <$fh>;
-The I/O disciplines can also be specified more flexibly with
+The I/O layers can also be specified more flexibly with
the C<open> pragma. See L<open>, or look at the following example.
- use open ':utf8'; # input and output default discipline will be UTF-8
+ use open ':utf8'; # input and output default layer will be UTF-8
open X, ">file";
print X chr(0x100), "\n";
close X;
printf "%#x\n", ord(<Y>); # this should print 0x100
close Y;
-With the C<open> pragma you can use the C<:locale> discipline
+With the C<open> pragma you can use the C<:locale> layer
$ENV{LC_ALL} = $ENV{LANG} = 'ru_RU.KOI8-R';
# the :locale will probe the locale environment variables like LC_ALL
printf "%#x\n", ord(<I>), "\n"; # this should print 0xc1
close I;
-or you can also use the C<':encoding(...)'> discipline
+or you can also use the C<':encoding(...)'> layer
open(my $epic,'<:encoding(iso-8859-7)','iliad.greek');
my $line_of_unicode = <$epic>;
stream. The result is always Unicode.
The L<open> pragma affects all the C<open()> calls after the pragma by
-setting default disciplines. If you want to affect only certain
-streams, use explicit disciplines directly in the C<open()> call.
+setting default layers. If you want to affect only certain
+streams, use explicit layers directly in the C<open()> call.
You can switch encodings on an already opened stream by using
C<binmode()>; see L<perlfunc/binmode>.
C<:utf8> and C<:encoding(...)> methods do work with all of C<open()>,
C<binmode()>, and the C<open> pragma.
-Similarly, you may use these I/O disciplines on output streams to
+Similarly, you may use these I/O layers on output streams to
automatically convert Unicode to the specified encoding when it is
written to the stream. For example, the following snippet copies the
contents of the file "text.jis" (encoded as ISO-2022-JP, aka JIS) to
and C<sysseek()>.
Notice that because of the default behaviour of not doing any
-conversion upon input if there is no default discipline,
+conversion upon input if there is no default layer,
it is easy to mistakenly write code that keeps on expanding a file
by repeatedly encoding the data:
Normal users of Perl should never care how Perl encodes any particular
Unicode string (because the normal ways to get at the contents of a
string with Unicode--via input and output--should always be via
-explicitly-defined I/O disciplines). But if you must, there are two
+explicitly-defined I/O layers). But if you must, there are two
ways of looking behind the scenes.
One way of peeking inside the internal encoding of Unicode characters
=item ${^OPEN}
An internal variable used by PerlIO. A string in two parts, separated
-by a C<\0> byte, the first part is the input disciplines, the second
-part is the output disciplines.
+by a C<\0> byte, the first part describes the input layers, the second
+part describes the output layers.
=item $PERLDB
s = (r->reganch & ROPT_UTF8) ? pv_uni_display(dsv, (U8*)r->precomp,
r->prelen, 60, UNI_DISPLAY_REGEX)
- : pv_display(dsv, (U8*)r->precomp, r->prelen, 0, 60);
+ : pv_display(dsv, r->precomp, r->prelen, 0, 60);
len = SvCUR(dsv);
if (!PL_colorset)
reginitcolors();
@INC = '../lib';
}
-print "1..9\n";
+print "1..10\n";
@oops = @ops = <op/*>;
my $f=0;
$ok="ok 9\n";
$ok="not ok 9\n", undef $f while $x = $f||$f;
-print $ok
+print $ok;
+
+# Better check that glob actually returned some entries
+{
+ my $not = (scalar @oops > 0) ? '' : 'not ';
+ print "${not}ok 10\n";
+}
elsif ($Is_VMS) {
$script = "[]show-shebang";
}
+ else {
+ $script = "./show-shebang";
+ }
if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') { # no shebang
$headmaybe = <<EOH ;
eval 'exec ./perl -S \$0 \${1+"\$\@"}'
s/\.exe//i if $Is_Dos or $Is_os2;
s{\\}{/}g;
ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`");
- ok unlink($script), $!;
+
+ local $ENV{PATH}= ".";
+ (my $script_name = $script) =~ s/.*(show-shebang)/$1/;
+ $s1 = "\$^X is $perl, \$0 is $script_name\n" if $Is_MSWin32;
+ $_ = `$script_name`;
+ s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
+ s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
+ s{is perl}{is $perl}; # for systems where $^X is only a basename
+ s{\\}{/}g;
+ ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:");
+
+ unlink($script) || die "unlink($script): $!";
}
# $], $^O, $^T
#!./perl
-print "1..7\n";
+print "1..9\n";
sub context {
my ( $cona, $testnum ) = @_;
my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
$a = scalar context('S',5);
($a) = context('A',6);
($a) = scalar context('S',7);
+
+{
+ # [ID 20020626.011] incorrect wantarray optimisation
+ sub simple { wantarray ? 1 : 2 }
+ sub inline {
+ my $a = wantarray ? simple() : simple();
+ $a;
+ }
+ my @b = inline();
+ my $c = inline();
+ print +(@b == 1 && "@b" eq "2") ? "ok 8\n" : "not ok 8\t# <@b>\n";
+ print +($c == 2) ? "ok 9\n" : "not ok 9\t# <$c>\n";
+}
+
1;
print $人, "\n";
EXPECT
3
+########
+# test that closures generated by eval"" hold on to the CV of the eval""
+# for their entire lifetime
+$code = eval q[
+ sub { eval '$x = "ok 1\n"'; }
+];
+&{$code}();
+print $x;
+EXPECT
+ok 1
+######## [ID 20020623.009] nested eval/sub segfaults
+$eval = eval 'sub { eval "sub { %S }" }';
+$eval->({});
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
+ else {
+ STRLEN blen;
+ STRLEN llen;
+ char *bstart = SvPV(CopFILESV(PL_curcop),blen);
+ char *lstart = SvPV(x,llen);
+ if (llen < blen) {
+ bstart += blen - llen;
+ if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
+ sv_setpvn(x, ipath, ipathend - ipath);
+ SvSETMAGIC(x);
+ }
+ }
+ }
TAINT_NOT; /* $^X is always tainted, but that's OK */
}
#endif /* ARG_ZERO_IS_SCRIPT */
projects / p5sagit/p5-mst-13.2.git / commitdiff