diff options
author | Todd C. Miller <millert@cvs.openbsd.org> | 2004-04-07 21:33:13 +0000 |
---|---|---|
committer | Todd C. Miller <millert@cvs.openbsd.org> | 2004-04-07 21:33:13 +0000 |
commit | 0483bc835ac9d7a98c6221c31164adab28d45012 (patch) | |
tree | 4c0792a10e62acfdd0c306897722ecb5fd30821b /gnu | |
parent | 06b4a8c77def9992257264115d36deba7767935f (diff) |
merge local changes into perl-5.8.3
Diffstat (limited to 'gnu')
144 files changed, 7356 insertions, 4442 deletions
diff --git a/gnu/usr.bin/perl/Changes b/gnu/usr.bin/perl/Changes index 6b23574cf78..57f0664ea05 100644 --- a/gnu/usr.bin/perl/Changes +++ b/gnu/usr.bin/perl/Changes @@ -25,1273 +25,2151 @@ to the perl5-porters mailing list. You can retrieve the messages for example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ -------------- -Version v5.8.2 Maintenance release working toward v5.8.2 +Version v5.8.3 Maintenance release working toward v5.8.3 -------------- ____________________________________________________________________________ ____________________________________________________________________________ -[ 21668] By: nicholas on 2003/11/05 19:26:49 +[ 22151] By: nicholas on 2004/01/14 17:54:36 Log: Integrate: - [ 21667] - From: Craig Berry <craigberry@mac.com> - Subject: Opcode.xs/RC2 compile nit on VMS - Date: Wed, 05 Nov 2003 12:16:34 -0600 - Message-ID: <2097592.1068056194261.JavaMail.craigberry@mac.com> + [ 22149] + Subject: Doc patches for File::Find + From: Andy Lester <andy@petdance.com> + Date: Mon, 12 Jan 2004 00:10:50 -0600 + Message-Id: <20040112061050.GB7308@petdance.com> + + [ 22150] + Bump version number as file has changed since 5.8.2 + Branch: maint-5.8/perl + !> lib/File/Find.pm +____________________________________________________________________________ +[ 22148] By: nicholas on 2004/01/14 16:53:02 + Log: Update Changes Branch: maint-5.8/perl - !> ext/Opcode/Opcode.xs + ! Changes +____________________________________________________________________________ +[ 22147] By: nicholas on 2004/01/14 16:51:39 + Log: Update sample config to 5.8.3 + Branch: maint-5.8/perl + ! Porting/config.sh Porting/config_H ____________________________________________________________________________ -[ 21666] By: nicholas on 2003/11/05 19:01:16 - Log: Note planned release date. +[ 22146] By: nicholas on 2004/01/14 16:32:27 + Log: Subject: arm patches to rc1 + From: Redvers Davies <red@criticalintegration.com> + Message-Id: <1073949147.10300.143.camel@ragefire> + Date: Mon, 12 Jan 2004 18:12:27 -0500 + Branch: maint-5.8/perl + ! Cross/Makefile Cross/Makefile.SH.patch +____________________________________________________________________________ +[ 22145] By: nicholas on 2004/01/14 15:14:51 + Log: All pigs are fed, watered and ready to fly. + Branch: maint-5.8/perl + ! patchlevel.h +____________________________________________________________________________ +[ 22144] By: nicholas on 2004/01/14 14:48:32 + Log: Update Changes + Branch: maint-5.8/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 22143] By: nicholas on 2004/01/14 14:47:49 + Log: We're planning on making history today. Mind you, not that much - + only 1 line. Branch: maint-5.8/perl ! pod/perlhist.pod ____________________________________________________________________________ -[ 21665] By: nicholas on 2003/11/05 19:00:29 +[ 22142] By: nicholas on 2004/01/14 14:45:07 + Log: Mention that bug 24846 is fixed (utf8 join) + Branch: maint-5.8/perl + ! pod/perl583delta.pod +____________________________________________________________________________ +[ 22141] By: nicholas on 2004/01/14 14:40:59 + Log: Update changes + Branch: maint-5.8/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 22140] By: nicholas on 2004/01/14 14:37:50 + Log: rebuild pod/perltoc.pod + Branch: maint-5.8/perl + ! pod/perltoc.pod +____________________________________________________________________________ +[ 22139] By: nicholas on 2004/01/14 14:34:46 + Log: Note that I failed to integrate the suidperl patch. me-- + Branch: maint-5.8/perl + ! pod/perl583delta.pod +____________________________________________________________________________ +[ 22138] By: nicholas on 2004/01/14 13:51:23 + Log: Revert 21936 (which solves leaks with threads and weak references) + because it can introduce new SEGVs, and I'd prefer to ship with + the same bugs as 5.8.2, rather than different bugs. + Same bugs feels like the lesser of two evils. + Branch: maint-5.8/perl + ! mg.c sv.c +____________________________________________________________________________ +[ 22137] By: nicholas on 2004/01/14 13:20:47 + Log: Integrate CGI::Fast and CGI::Util from CGI 3.03 + (just version number changes) + I don't want to integratre CGI.pm 3.03 as it also has functionality + changes, and is less than 48 hours old. + Branch: maint-5.8/perl + !> lib/CGI/Fast.pm lib/CGI/Util.pm +____________________________________________________________________________ +[ 22135] By: nicholas on 2004/01/14 12:25:57 + Log: Some more updates + Branch: maint-5.8/perl + ! pod/perl583delta.pod +____________________________________________________________________________ +[ 22134] By: nicholas on 2004/01/13 23:07:41 Log: Integrate: - [ 21661] - Subject: [PATCH pod/perlhist.pod] Mention 5.8.2-RC2 - From: Abigail <abigail@abigail.nl> - Date: Tue, 4 Nov 2003 10:40:57 +0100 - Message-Id: <20031104094057.GA22508@abigail.nl> + [ 22133] + Add VMS to the list of "don't fork" OSes + [In the most simple way possible. Fix this properly post 5.8.3 + to use $Config{d_fork} or something more robust] Branch: maint-5.8/perl - !> pod/perlhist.pod + !> ext/threads/shared/t/wait.t ____________________________________________________________________________ -[ 21659] By: nicholas on 2003/11/05 08:18:49 +[ 22132] By: nicholas on 2004/01/13 21:55:59 Log: Integrate: - [ 21656] - Subject: Re: [gherteg@csc.com: your CPAN page on EBCDIC] - From: PPrymmer@factset.com - Date: Tue, 4 Nov 2003 10:00:07 -0500 - Message-ID: <OF9A22A404.A32A5C26-ON85256DD4.00522E92-85256DD4.005268A4@factset.com> + [ 21644] + Document the fact that keys() and values() are optimized + for void context (as suggested by Liz.) + + [ 22108] + documentation nit + + [ 22125] + Document usage of $_ and pos() inside /(?{...})/. + (see change #2367.) Branch: maint-5.8/perl - !> pod/perlebcdic.pod + !> pod/perlfunc.pod pod/perlop.pod pod/perlre.pod ____________________________________________________________________________ -[ 21658] By: nicholas on 2003/11/05 08:12:08 - Log: Subject: [PATCH 5.8.2] reentr.pl is not defining _srandom_struct - From: Jan Dubois <jand@ActiveState.com> - Date: Tue, 04 Nov 2003 17:16:00 -0800 - Message-ID: <0mjgqvk4f8idatljni3cfoeta3ljbm8a6c@4ax.com> +[ 22131] By: nicholas on 2004/01/13 21:16:27 + Log: Back out 22144. + (Craig Berry informs us that the official name is + "OpenVMS Industry Standard 64" + which may be shortened to "OpenVMS I64" + Bah. Marketrdroids) Branch: maint-5.8/perl - ! reentr.h reentr.pl + ! pod/perl583delta.pod ____________________________________________________________________________ -[ 21654] By: nicholas on 2003/11/04 22:10:35 - Log: Subject: Re: [PATCH 5.8.1] make reentr.[ch] compatible with 5.8.0 again - From: Jan Dubois <jand@ActiveState.com> - Date: Mon, 03 Nov 2003 00:58:21 -0800 - Message-ID: <ip5cqvcu5qk1mc2e38ne7iv81bpljjrfe6@4ax.com> +[ 22127] By: nicholas on 2004/01/13 08:55:10 + Log: Integrate: + [ 22122] + Subject: Re: 5.8.3-RC1, ext/threads/shared/t/wait still hanging + From: Mike Pomraning <mjp@pilcrow.madison.wi.us> + Message-ID: <Pine.LNX.4.58.0401121127210.15844@benevelle.wi.securepipe.com> + Date: Mon, 12 Jan 2004 12:41:52 -0600 (CST) Branch: maint-5.8/perl - ! reentr.inc reentr.pl + !> ext/threads/shared/t/wait.t ____________________________________________________________________________ -[ 21653] By: nicholas on 2003/11/04 21:54:48 +[ 22118] By: nicholas on 2004/01/12 12:43:13 Log: Integrate: - [ 21651] - Subject: Re: [PATCH 5.8.2 @21574] OS/2 build - From: Ilya Zakharevich <nospam-abuse@ilyaz.org> - Date: Mon, 3 Nov 2003 20:20:44 -0800 - Message-ID: <20031104042044.GA1682@math.berkeley.edu> + [ 22117] + Subject: Re: [perl #24846] [PATCH] Apparent utf8 bug in join() in 5.8.[012] + From: SADAHIRO Tomoyuki <bqw10602@nifty.com> + Date: Mon, 12 Jan 2004 11:19:37 +0900 + Message-Id: <20040112111007.EB69.BQW10602@nifty.com> Branch: maint-5.8/perl - !> os2/Makefile.SHs + !> doop.c t/op/join.t ____________________________________________________________________________ -[ 21649] By: nicholas on 2003/11/03 20:43:47 +[ 22116] By: nicholas on 2004/01/11 23:55:36 Log: Integrate: - [ 21646] - Subject: Cwd.xs: off-by-one buffer overflow in realpath() - From: Casey West <casey@geeknest.com> - Date: Mon, 3 Nov 2003 10:11:43 -0500 - Message-ID: <20031103151143.GB430@geeknest.com> + [ 22115] + Subject: Re: 5.8.3-RC1, ext/threads/shared/t/wait still hanging + From: Mike Pomraning <mjp@pilcrow.madison.wi.us> + Message-ID: <Pine.LNX.4.58.0401111548010.6679@localhost.localdomain> + Date: Sun, 11 Jan 2004 16:24:18 -0600 (CST) Branch: maint-5.8/perl - !> ext/Cwd/Cwd.xs + !> ext/threads/shared/t/wait.t ____________________________________________________________________________ -[ 21648] By: nicholas on 2003/11/03 20:26:54 - Log: Disarm RC2 +[ 22114] By: nicholas on 2004/01/11 23:27:27 + Log: Typo spotted by Jarkko Branch: maint-5.8/perl - ! patchlevel.h + ! pod/perl583delta.pod ____________________________________________________________________________ -[ 21643] By: nicholas on 2003/11/03 07:18:47 - Log: I bet yes +[ 22111] By: nicholas on 2004/01/11 19:57:50 + Log: Subject: Re: [PATCH win32/makefile.mk] (was Re: 5.8.3 RC1) + From: Abe Timmerman <abe@ztreet.demon.nl> + Message-Id: <200401111813.40829.abe@ztreet.demon.nl> + Date: Sun, 11 Jan 2004 18:13:40 +0100 + + plus revert 22092 and 22080 Branch: maint-5.8/perl - ! patchlevel.h + ! pod/buildtoc win32/Makefile win32/makefile.mk ____________________________________________________________________________ -[ 21642] By: nicholas on 2003/11/03 07:18:04 - Log: space should be tab for lib/I18N/LangTags/t/02decency.t +[ 22105] By: nicholas on 2004/01/09 22:10:43 + Log: Integrate: + [ 22104] + Bah. Makefile.PL still tests the sub-MANIFEST Branch: maint-5.8/perl - ! MANIFEST + !> ext/Storable/MANIFEST ____________________________________________________________________________ -[ 21641] By: nicholas on 2003/11/03 07:13:20 - Log: Update changes +[ 22099] By: nicholas on 2004/01/08 16:52:35 + Log: Update META.yml + ext/threads and ext/PerlIO now aren't in the list - is this correct? Branch: maint-5.8/perl - ! Changes patchlevel.h + ! META.yml ____________________________________________________________________________ -[ 21640] By: nicholas on 2003/11/03 07:11:34 +[ 22098] By: nicholas on 2004/01/08 15:24:15 Log: Integrate: - [ 21638] - s/new_hash/rehash/g (Stas suggested a better name) - - [ 21639] - Stas would prefer not to have MOD_PERL defines in perl. + [ 22096] + Subject: [PATCH pod/perlhist.pod] Mention 5.8.3-RC1 + From: Abigail <abigail@abigail.nl> + Message-ID: <20040107230027.GC393@abigail.nl> + Date: Thu, 8 Jan 2004 00:00:27 +0100 Branch: maint-5.8/perl - ! embedvar.h - !> hv.c hv.h intrpvar.h lib/Hash/Util.pm perl.c perlapi.h sv.c - !> universal.c util.c + !> pod/perlhist.pod ____________________________________________________________________________ -[ 21637] By: nicholas on 2003/11/02 23:07:41 - Log: Update our sample config with one generated for 5.8.2 +[ 22097] By: nicholas on 2004/01/08 14:44:17 + Log: That was RC1. With some bonus bits Branch: maint-5.8/perl - ! Porting/config.sh Porting/config_H + ! patchlevel.h ____________________________________________________________________________ -[ 21636] By: nicholas on 2003/11/02 22:47:37 - Log: Update changes +[ 22095] By: nicholas on 2004/01/08 13:13:10 + Log: Remove duplicated entries, spotted by Enache Adrian + Branch: maint-5.8/perl + ! Changes +____________________________________________________________________________ +[ 22094] By: nicholas on 2004/01/08 13:09:12 + Log: Fixes from Petras Kudaras and Gisle Aas, plus document the addition + to perldiag.pod + Branch: maint-5.8/perl + ! pod/perl583delta.pod +____________________________________________________________________________ +[ 22093] By: nicholas on 2004/01/08 12:46:09 + Log: Graham says that the search.cpan.org pod finder hashes on name + The 4 files all thinking they are perldelta.pod confuses it. + Branch: maint-5.8/perl + ! pod/perl581delta.pod pod/perl582delta.pod pod/perl58delta.pod +____________________________________________________________________________ +[ 22092] By: nicholas on 2004/01/08 12:33:11 + Log: Subject: Re: [PATCH win32/makefile.mk] (was Re: 5.8.3 RC1) + From: Abe Timmerman <abe@ztreet.demon.nl> + Message-Id: <200401080156.01280.abe@ztreet.demon.nl> + Date: Thu, 8 Jan 2004 01:56:01 +0100 + Branch: maint-5.8/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 22090] By: nicholas on 2004/01/07 13:30:14 + Log: Correct timestamp on ext/IO/IO.xs + Branch: maint-5.8/perl + ! ext/IO/IO.xs +____________________________________________________________________________ +[ 22089] By: nicholas on 2004/01/07 13:19:41 + Log: Seems to be an off-by-4-years in Perforce on MacOS. Fix it. Grr. + Branch: maint-5.8/perl + ! ext/Digest/MD5/hints/MacOS.pl ext/Filter/t/call.t + ! ext/POSIX/t/taint.t lib/AutoSplit.t lib/Devel/SelfStubber.pm + ! lib/Devel/SelfStubber.t lib/File/DosGlob.t lib/Pod/t/Usage.t + ! lib/blib.pm lib/charnames.t lib/diagnostics.t lib/subs.t + ! t/comp/cpp.t t/comp/use.t t/io/inplace.t t/io/iprefix.t + ! t/lib/compmod.pl t/lib/filter-util.pl t/lib/warnings/mg + ! t/op/glob.t t/op/method.t t/op/mkdir.t t/op/read.t + ! t/op/recurse.t t/op/srand.t t/op/study.t t/op/subst_wamp.t + ! t/pod/testp2pt.pl t/run/exit.t t/run/switchI.t + ! t/run/switchPx.t t/run/switchx.t t/x2p/s2p.t utils/splain.PL +____________________________________________________________________________ +[ 22088] By: nicholas on 2004/01/07 13:10:22 + Log: Attempt timestamp fixup + Branch: maint-5.8/perl + ! ext/IO/IO.xs +____________________________________________________________________________ +[ 22087] By: nicholas on 2004/01/07 12:10:19 + Log: This is RC1 + Branch: maint-5.8/perl + ! patchlevel.h +____________________________________________________________________________ +[ 22086] By: nicholas on 2004/01/07 12:09:16 + Log: Update Changes Branch: maint-5.8/perl ! Changes patchlevel.h ____________________________________________________________________________ -[ 21635] By: nicholas on 2003/11/02 22:45:22 - Log: Integrate: - [ 21634] - Provide Internals::new_hash_seed to return PL_new_hash_seed, and - make Hash::Util::hash_seed use this. +[ 22085] By: nicholas on 2004/01/07 12:08:00 + Log: Cargo cult upgrade to 5.8.3 + Branch: maint-5.8/perl + ! NetWare/Makefile cygwin/perlld.in epoc/createpkg.pl + ! patchlevel.h plan9/config.plan9 vos/build.cm + ! vos/config.alpha.def vos/config.alpha.h vos/config.ga.def + ! vos/config.ga.h vos/install_perl.cm win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_H.vc64 win32/makefile.mk wince/Makefile.ce +____________________________________________________________________________ +[ 22081] By: nicholas on 2004/01/06 14:33:15 + Log: Move pod/perldelta.pod to pod/perl583delta.pod, and arrange for + a copy to be made at build time. Branch: maint-5.8/perl - !> lib/Hash/Util.pm universal.c + +> pod/perl583delta.pod + - pod/perldelta.pod + ! MANIFEST Makefile.SH pod.lst pod/buildtoc pod/perltoc.pod + ! vms/descrip_mms.template win32/Makefile win32/makefile.mk + ! win32/pod.mak ____________________________________________________________________________ -[ 21633] By: nicholas on 2003/11/02 22:22:34 +[ 22080] By: nicholas on 2004/01/06 12:50:45 Log: Integrate: - [ 21588] - Subject: [PATCH] Devel::PPPort and scan_bin - From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> - Date: Wed, 29 Oct 2003 22:53:43 +0100 - Message-ID: <037201c39e67$1faa9940$0c2f1fac@R2D2> + [ 22079] + Jarkko didn't move the cd ..\pod correctly. Given that it's been + like this pre 5.8.1, I suspect that no-one has used it recently. + Branch: maint-5.8/perl + !> win32/makefile.mk +____________________________________________________________________________ +[ 22078] By: nicholas on 2004/01/06 12:13:08 + Log: Subject: [PATCH maintperl] copy reentr.inc to CORE on VMS + From: "Craig A. Berry" <craigberry@mac.com> + Message-ID: <3FFA4A86.6090607@mac.com> + Date: Mon, 05 Jan 2004 23:41:26 -0600 + Branch: maint-5.8/perl + ! vms/descrip_mms.template +____________________________________________________________________________ +[ 22077] By: nicholas on 2004/01/06 11:23:38 + Log: http://www.perforce.com/perforce/technotes/note014.html + I want a disintegrate command, and right now I know where I want to + aim it. + (Missing un-adds from reversing back to MM 6.17) Branch: maint-5.8/perl - !> ext/Devel/PPPort/PPPort.pm + - lib/ExtUtils/t/parse_version.t + - t/lib/MakeMaker/Test/Setup/BFD.pm + - t/lib/MakeMaker/Test/Setup/Problem.pm ____________________________________________________________________________ -[ 21632] By: nicholas on 2003/11/02 21:56:48 +[ 22073] By: nicholas on 2004/01/05 22:44:03 + Log: Update pod/perltoc.pod + Branch: maint-5.8/perl + ! pod/perltoc.pod +____________________________________________________________________________ +[ 22072] By: nicholas on 2004/01/05 22:39:35 + Log: Revert to MM 6.17 (same as 5.8.2) + Branch: maint-5.8/perl + + lib/ExtUtils/t/00setup_dummy.t + + lib/ExtUtils/t/zz_cleanup_dummy.t + ! MANIFEST lib/ExtUtils/Changes lib/ExtUtils/Command.pm + ! lib/ExtUtils/Command/MM.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist/Kid.pm lib/ExtUtils/MANIFEST.SKIP + ! lib/ExtUtils/META.yml lib/ExtUtils/MM.pm + ! lib/ExtUtils/MM_Any.pm lib/ExtUtils/MM_Cygwin.pm + ! lib/ExtUtils/MM_NW5.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm + ! lib/ExtUtils/MM_Win95.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/MakeMaker/Tutorial.pod + ! lib/ExtUtils/MakeMaker/bytes.pm + ! lib/ExtUtils/MakeMaker/vmsish.pm lib/ExtUtils/Manifest.pm + ! lib/ExtUtils/README lib/ExtUtils/TODO lib/ExtUtils/instmodsh + ! lib/ExtUtils/t/Command.t lib/ExtUtils/t/INST.t + ! lib/ExtUtils/t/INST_PREFIX.t lib/ExtUtils/t/Install.t + ! lib/ExtUtils/t/MM_Cygwin.t lib/ExtUtils/t/MM_Unix.t + ! lib/ExtUtils/t/MM_Win32.t lib/ExtUtils/t/Manifest.t + ! lib/ExtUtils/t/basic.t lib/ExtUtils/t/postamble.t + ! lib/ExtUtils/t/prefixify.t lib/ExtUtils/t/prereq_print.t + ! lib/ExtUtils/t/problems.t lib/ExtUtils/t/writemakefile_args.t + ! pod/perldelta.pod t/lib/MakeMaker/Test/Setup/Recurs.pm +____________________________________________________________________________ +[ 22070] By: nicholas on 2004/01/05 21:57:23 + Log: Resort MANIFEST (the way perltoc likes it) + Branch: maint-5.8/perl + ! MANIFEST +____________________________________________________________________________ +[ 22069] By: nicholas on 2004/01/05 21:56:17 Log: Integrate: - [ 21587] - Subject: [PATCH] change p4d2p to deal with new style diff2 output - From: Jan Dubois <jand@ActiveState.com> - Date: Thu, 30 Oct 2003 18:43:08 -0800 - Message-ID: <dpi3qvgf1uke7pj1gcpgmoh622lqcvl6uc@4ax.com> + [ 22064] + Fix bug with MANIFEST generation when we also regenerate perltoc.pod + + [ 22067] + Change the flag logic in buildtoc Branch: maint-5.8/perl - !> Porting/p4d2p + !> pod.lst pod/buildtoc ____________________________________________________________________________ -[ 21631] By: nicholas on 2003/11/02 21:55:32 +[ 22059] By: nicholas on 2004/01/05 09:29:29 Log: Integrate: - [ 21614] - Subject: Re: [PATCH bleadperl] (was Re: Is this brokenness in $< $( $> & $) ?) - From: Rick Delaney <rick@bort.ca> - Date: Mon, 27 Oct 2003 16:24:16 -0500 - Message-ID: <20031027162416.H2233@biff.bort.ca> + [ 22058] + Subject: [PATCH] skip num.t #47 on VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sun, 04 Jan 2004 23:16:26 -0600 + Message-ID: <3FF8F32A.5000108@mac.com> Branch: maint-5.8/perl - !> pp_hot.c + !> t/base/num.t ____________________________________________________________________________ -[ 21630] By: nicholas on 2003/11/02 21:28:01 - Log: - Fix for [perl #24347] segfault with Safe - The empty %INC created for safe compartements was freed - too early. +[ 22054] By: nicholas on 2004/01/03 20:56:11 + Log: Integrate: + [ 22052] + Upgrade to PerlIO::via::QuotedPrint 0.06 Branch: maint-5.8/perl - !> ext/Opcode/Opcode.xs + !> lib/PerlIO/via/QuotedPrint.pm ____________________________________________________________________________ -[ 21629] By: nicholas on 2003/11/02 21:13:40 +[ 22053] By: nicholas on 2004/01/03 20:16:23 Log: Integrate: - [ 21599] - whoops, typo + [ 22049] + Fix minor problems with the CPAN release + 1: Make Storable.xs to work on 5.8.2 and later (already in the core) + 2: Ship the linux hints file + 3: Ship Test::More for the benefit of Perls pre 5.6.2 + 4: Correct Makefile.PL to install in core for 5.8.0 and later - [ 21616] - Subject: DOCPATCH: does STORE need to return anything and if so what? - From: david nicol <whatever@davidnicol.com> - Date: 26 Oct 2003 22:34:04 -0600 - Message-Id: <1067229244.1071.51.camel@plaza.davidnicol.com> - - [ 21625] - Mention perl 5.8.2-RC1 in perlhist, as spotted by Abigail. - - [ 21627] - Subject: [PATCH pod/perlguts.pod] update embed.pl description - From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> - Date: Sun, 2 Nov 2003 22:24:28 +0100 - Message-ID: <007b01c3a187$b34c6110$0c2f1fac@R2D2> + [ 22050] + No matter how hard you proof read it, something always slips through. Branch: maint-5.8/perl - !> ext/threads/shared/shared.xs pod/perlguts.pod pod/perlhist.pod - !> pod/perltie.pod + !> ext/Storable/ChangeLog ext/Storable/MANIFEST + !> ext/Storable/Makefile.PL ext/Storable/README + !> ext/Storable/Storable.pm ____________________________________________________________________________ -[ 21626] By: nicholas on 2003/11/02 20:27:25 +[ 22048] By: nicholas on 2004/01/03 18:00:31 + Log: Changes suggested by Merijn (but his words mangled by me) + Branch: maint-5.8/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 22046] By: nicholas on 2004/01/02 16:57:17 Log: Integrate: - [ 21615] - Subject: [PATCH] DB_File 1.807 + [ 21981] + Subject: PATCH: *DB*_File From: "Paul Marquess" <Paul.Marquess@btinternet.com> - Date: Sat, 1 Nov 2003 13:50:12 -0000 - Message-ID: <AIEAJICLCBDNAAOLLOKLOENMPAAA.Paul.Marquess@btinternet.com> + Date: Sat, 27 Dec 2003 20:02:30 -0000 + Message-ID: <AIEAJICLCBDNAAOLLOKLIEAOPGAA.Paul.Marquess@btinternet.com> Branch: maint-5.8/perl - !> ext/DB_File/Changes ext/DB_File/DB_File.pm - !> ext/DB_File/DB_File.xs ext/DB_File/dbinfo + !> XSUB.h ext/DB_File/Changes ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs ext/DB_File/t/db-btree.t !> ext/DB_File/t/db-hash.t ext/DB_File/t/db-recno.t + !> ext/DB_File/typemap ext/GDBM_File/typemap + !> ext/NDBM_File/typemap ext/ODBM_File/typemap + !> ext/SDBM_File/typemap ____________________________________________________________________________ -[ 21624] By: nicholas on 2003/11/02 20:16:07 - Log: Tweaks (from Jan Dubois, Petras Kudaras and Slaven Rezic) +[ 22045] By: nicholas on 2004/01/02 16:36:54 + Log: Integrate: + [ 22030] + Document that detached threads aren't supported on Windows yet. + + [ 22031] + Document that /[\W]/ doesn't work, unicode-wise (see bug #18281) + + [ 22036] + Document the quirks of SUPER, especially the fact that it it + relative to the current package and not to the invoking object. + + [ 22037] + addition to 22036 (document SUPER better): superclass may be plural + + [ 22044] + Bump $threads::VERSION as the documentation has changed. Tweak the + documentaiton, update Arthur's e-mail address Branch: maint-5.8/perl - ! pod/perldelta.pod + !> ext/threads/threads.pm pod/perlboot.pod pod/perlbot.pod + !> pod/perlobj.pod pod/perltoot.pod pod/perlunicode.pod ____________________________________________________________________________ -[ 21623] By: nicholas on 2003/11/02 19:52:04 - Log: Integrate: - [ 21617] - Portability nit for MinGW 3. +[ 22042] By: nicholas on 2004/01/02 00:42:36 + Log: Waah. This is a mess. The debugger is forked, with maint's $VERSION + 2 higher than blead's. No idea how much code is forked. + + Integrate: + [ 21940] + Fix a side-effect of bug #24674 in the perl debugger. - Subject: MinGW-3.1.0-1 _CRTIMP definition preempting win32.h's - From: Greg Matheson <lang@ms.chinmin.edu.tw> - Date: Thu, 30 Oct 2003 14:11:58 +0800 - Message-ID: <20031030141158.A11772@ms> - (actual patch by Abe Timmerman) + Subject: [perl #24674] 5.x odd taint bug + From: Dominique Quatravaux (via RT) <perlbug-followup@perl.org> + Date: 16 Dec 2003 15:03:24 -0000 + Message-ID: <rt-3.0.7_01-24674-68456.11.3124667849085@perl.org> - [ 21619] - Quoted-printable is evil. + [ 22041] + Update debugger version number and Changes file Branch: maint-5.8/perl - !> win32/win32.h + ! lib/perl5db.pl ____________________________________________________________________________ -[ 21622] By: nicholas on 2003/11/02 18:50:41 +[ 22040] By: nicholas on 2004/01/02 00:21:57 Log: Integrate: - [ 21620] - Subject: [PATCH 5.8.2 @21574] OS/2 build - From: Ilya Zakharevich <nospam-abuse@ilyaz.org> - Date: Wed, 29 Oct 2003 14:00:18 -0800 - Message-ID: <20031029220017.GA26384@math.berkeley.edu> + [ 22033] + Subject: Perl 5.8.3 patches from the BS2000 port - part 2 + From: Dorner Thomas <tdorner@amadeus.net> + Message-ID: <6727B1DACFCDD311A757009027CA8D69044B6740@Ex02.inhouse.start.de> + Date: Fri, 19 Dec 2003 07:16:47 +0100 Branch: maint-5.8/perl - !> ext/DynaLoader/DynaLoader_pm.PL makedef.pl os2/Makefile.SHs - !> os2/OS2/REXX/REXX.xs os2/os2.c os2/os2_base.t os2/os2ish.h - !> os2/perl2cmd.pl perlio.c + !> t/io/utf8.t t/op/pat.t ____________________________________________________________________________ -[ 21621] By: nicholas on 2003/11/02 18:29:05 +[ 22039] By: nicholas on 2004/01/01 23:59:34 Log: Integrate: - [ 21618] - Stas spotted a missed s//new_/ for the hash seed renaming games + [ 22034] + Fix bug #24383, where hashes with the :unique attribute weren't + getting made readonly on interpreter clone. Also, remove the + :unique attribute from the hashes in warnings.pm, since they may + later be modified by warnings::register. Finally, adds tests for + the :unique attribute. Branch: maint-5.8/perl - !> perl.c + !> ext/threads/t/problems.t lib/warnings.pm sv.c warnings.pl ____________________________________________________________________________ -[ 21613] By: nicholas on 2003/11/01 16:52:03 - Log: @INC caching of failures was backed out +[ 22038] By: nicholas on 2004/01/01 23:35:15 + Log: + Subject: [PATCH 5.8.2 @21574] OS/2 update + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Thu, 18 Dec 2003 14:10:29 -0800 + Message-ID: <20031218221029.GA7898@math.berkeley.edu> Branch: maint-5.8/perl - ! pod/perldelta.pod + ! installperl + !> README.os2 hints/os2.sh lib/ExtUtils/MM_Unix.pm makedef.pl + !> os2/Changes os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm + !> os2/os2.c os2/os2ish.h os2/perl2cmd.pl ____________________________________________________________________________ -[ 21612] By: nicholas on 2003/11/01 16:32:46 - Log: Integrate: - [ 21611] - D'oh! t/op/hash.t wasn't in the MANIFEST. Rafael spotted this +[ 22035] By: nicholas on 2004/01/01 21:30:41 + Log: Corrections from Yitzchak Scott-Thoennes and Randy W. Sims + Message-ID: <20040101195205.GA3212@efn.org> + Message-ID: <20031230183815.GC8164@penkwe.pair.com> Branch: maint-5.8/perl - !> MANIFEST + ! pod/perldelta.pod ____________________________________________________________________________ -[ 21610] By: nicholas on 2003/11/01 16:30:14 +[ 22028] By: nicholas on 2003/12/31 18:19:46 Log: Integrate: - [ 21589] - Subject: [5.8.x segfault + patch] chicken&egg segfault in -Dm -Mthreads - From: Stas Bekman <stas@stason.org> - Date: Wed, 29 Oct 2003 15:15:15 -0800 - Message-ID: <3FA04A03.5010603@stason.org> - (enclosed in a #ifdef DEBUGGING) + [ 21951] + re-fix [perl #24508] without speed regression. + keep an eye on this. Branch: maint-5.8/perl - !> sv.c + !> op.c opcode.h opcode.pl ____________________________________________________________________________ -[ 21609] By: nicholas on 2003/11/01 16:14:51 +[ 22027] By: nicholas on 2003/12/31 15:41:04 Log: Integrate: - [ 21595] - Prevent the installation of makefiles that can be found - under lib/. + [ 22025] + Subject: [PATCH] "piconv -C 512" badly broken + From: Autrijus Tang <autrijus@autrijus.org> + Message-Id: <1072870210.769.5.camel@localhost> + Date: Wed, 31 Dec 2003 19:30:10 +0800 + + [ 22026] + Tweak 00compile.t to avoid splatting a DIAG over core perl's + beautiful clean run of OKs. You are all getting a clean run of OKs, + aren't you? Branch: maint-5.8/perl - !> installperl + !> ext/Encode/bin/piconv lib/Test/Harness/t/00compile.t ____________________________________________________________________________ -[ 21608] By: nicholas on 2003/11/01 15:35:16 +[ 22024] By: nicholas on 2003/12/31 15:05:22 Log: Integrate: - [ 21607] - mod_perl2 will require access to the Plan C hashing function. + [ 21798] + Implement C<use Exporter 'import'> : Branch: maint-5.8/perl - !> hv.h + !> lib/Exporter.pm lib/Exporter.t ____________________________________________________________________________ -[ 21606] By: nicholas on 2003/11/01 14:58:31 +[ 22023] By: nicholas on 2003/12/31 14:25:32 Log: Integrate: - [ 21591] - Subject: [PATCH] Off-by-one error in regcomp.c - From: Slaven Rezic <slaven@rezic.de> - Date: Fri, 31 Oct 2003 12:16:11 +0000 - Message-Id: <1067602571.12768@devpc01.iconmobile.de> - - [ 21593] - Test nit ; goes with change 21591 + [ 22020] + C++ comments, bad. Branch: maint-5.8/perl - !> regcomp.c t/lib/warnings/regcomp t/op/regmesg.t + !> ext/Cwd/Cwd.xs ____________________________________________________________________________ -[ 21605] By: nicholas on 2003/11/01 14:38:22 +[ 22022] By: nicholas on 2003/12/31 13:41:17 Log: Integrate: - [ 21604] - Add Internals::HvREHASH to expose the rehashing flag - t/op/hash.t tests that pathological data triggers rehashing + [ 22021] + Upgrade to Test::Harness 2.40. Branch: maint-5.8/perl - +> t/op/hash.t - !> universal.c + !> lib/Test/Harness.pm lib/Test/Harness/Changes + !> lib/Test/Harness/Iterator.pm lib/Test/Harness/Straps.pm + !> lib/Test/Harness/bin/prove lib/Test/Harness/t/00compile.t + !> lib/Test/Harness/t/assert.t lib/Test/Harness/t/callback.t + !> lib/Test/Harness/t/prove-switches.t + !> lib/Test/Harness/t/strap-analyze.t lib/Test/Harness/t/strap.t + !> lib/Test/Harness/t/test-harness.t ____________________________________________________________________________ -[ 21603] By: nicholas on 2003/11/01 13:03:55 +[ 22019] By: nicholas on 2003/12/31 00:19:24 Log: Integrate: - [ 21598] - [perl #24368] seg faults when deleting keys of shared hash refs - Ensure that the shared_sv get magic of the element being deleted - is called. Also, avoid posible memory leaks by wrapping all shared - context sections with ENTER/SAVETMPS + [ 22018] + Bump VERSION numbers Branch: maint-5.8/perl - !> ext/threads/shared/shared.xs + !> ext/POSIX/POSIX.pm lib/Benchmark.pm lib/File/CheckTree.pm + !> lib/Getopt/Std.pm lib/PerlIO.pm lib/Tie/Hash.pm + !> lib/diagnostics.pm ____________________________________________________________________________ -[ 21602] By: nicholas on 2003/11/01 12:45:20 - Log: Forgot to manually merge in the diffs rejected from 21601 - due to LF/CRLF differences. +[ 22017] By: nicholas on 2003/12/30 22:10:24 + Log: Integrate: + [ 22016] + A patch for Test::Harness on VMS by Craig Berry + (see RT CPAN bug #4745) Branch: maint-5.8/perl - ! win32/Makefile win32/makefile.mk + !> lib/Test/Harness/Straps.pm ____________________________________________________________________________ -[ 21601] By: nicholas on 2003/11/01 12:34:09 - Log: Subject: [PATCH 5.8.1] make reentr.[ch] compatible with 5.8.0 again - From: Jan Dubois <jand@ActiveState.com> - Date: Thu, 30 Oct 2003 16:58:05 -0800 - Message-ID: <mja3qv47kmrhiip1l8pfl7bij0reesjr6p@4ax.com> +[ 22015] By: nicholas on 2003/12/30 19:08:19 + Log: Integrate: + [ 21999] + Add Mike Pomraning + + [ 22009] + bug #24757 perlrun.pod's description of find -mtime was ambiguous + + [ 22013] + Subject: more uni doc tweakage + From: Jarkko Hietaniemi <jhi@iki.fi> + Message-ID: <20031230133755.GA23118@vipunen.hut.fi> + Date: Tue, 30 Dec 2003 15:37:55 +0200 + + Subject: one more pod fix + From: Jarkko Hietaniemi <jhi@iki.fi> + Message-ID: <20031230135641.GA24516@vipunen.hut.fi> + Date: Tue, 30 Dec 2003 15:56:41 +0200 Branch: maint-5.8/perl - + reentr.inc - ! MANIFEST installperl perl.h reentr.c reentr.h reentr.pl - ! win32/Makefile win32/makefile.mk + !> AUTHORS lib/PerlIO.pm pod/perlrun.pod pod/perlunicode.pod ____________________________________________________________________________ -[ 21600] By: nicholas on 2003/11/01 11:00:46 +[ 22014] By: nicholas on 2003/12/30 18:48:08 Log: Integrate: - [ 21590] - Subject: [patch pod/perlfunc.pod] separate two unrelated notes in require - From: Stas Bekman <stas@stason.org> - Date: Wed, 29 Oct 2003 16:47:24 -0800 - Message-ID: <3FA05F9C.2080304@stason.org> + [ 21937] + after back-references, restricted hashes. + see http://nntp.perl.org/group/perl.perl5.porters/86497 + this is hopefully only a temporary solution. - [ 21592] - Subject: [PATCH] Document PERL_DL_NONLAZY - From: Gisle Aas <gisle@ActiveState.com> - Date: 31 Oct 2003 03:13:03 -0800 - Message-ID: <lrn0bhbqyo.fsf@caliper.activestate.com> - - [ 21596] - Subject: Re: [perl #24367] [PATCH] configure flag -Dextras="HTML::Parser" doesn't seem to do anything - From: Andy Dougherty <doughera@lafayette.edu> - Date: Fri, 31 Oct 2003 15:32:35 -0500 (EST) - Message-ID: <Pine.SOL.4.53.0310311433440.8552@maxwell.phys.lafayette.edu> - (plus POD link fixes) + [ 22005] + Subject: Re: [perl #24774] eval + format - \n = pp_ctl.c assertion + heuristics for calculating buffer size needed to compile a format + didn't allow for \0 Branch: maint-5.8/perl - !> INSTALL pod/perlfunc.pod pod/perlrun.pod + !> perl.c pp_ctl.c t/op/write.t ____________________________________________________________________________ -[ 21597] By: nicholas on 2003/10/31 21:03:47 - Log: Back out 21449 (MakeMaker SIGN) - Schwern will integrate and make a CPAN release first +[ 22012] By: nicholas on 2003/12/30 17:53:35 + Log: Integrate: + [ 22007] + Upgrade to Math::BigInt 1.68. Branch: maint-5.8/perl - ! lib/ExtUtils/MM_Any.pm lib/ExtUtils/MM_Unix.pm - ! lib/ExtUtils/MakeMaker.pm pod/perldelta.pod + +> lib/Math/BigInt/t/bigroot.t + !> MANIFEST lib/Math/BigFloat.pm lib/Math/BigInt.pm + !> lib/Math/BigInt/Calc.pm lib/Math/BigInt/CalcEmu.pm + !> lib/Math/BigInt/t/alias.inc lib/Math/BigInt/t/bare_mbi.t + !> lib/Math/BigInt/t/bigfltpm.inc lib/Math/BigInt/t/bigintpm.inc + !> lib/Math/BigInt/t/bigintpm.t lib/Math/BigInt/t/sub_mbi.t ____________________________________________________________________________ -[ 21594] By: nicholas on 2003/10/31 20:28:11 - Log: Integrate (as TODO test): - [ 21565] - Subject: [PATCH t/comp/proto.t] Test (5.9.x) - From: Abigail <abigail@abigail.nl> - Date: Mon, 27 Oct 2003 14:50:24 +0100 - Message-ID: <20031027135024.GA12666@abigail.nl> +[ 22011] By: nicholas on 2003/12/30 17:37:54 + Log: $expletive perforce. Why can't you integrate an add with an edit? + + Integrate: + [ 21956] + Subject: BigInt v1.68 - pre-release + From: Tels <perl_dummy@bloodgate.com> + Date: Tue, 23 Dec 2003 01:09:23 +0100 + Message-Id: <200312230106.27661@bloodgate.com> Branch: maint-5.8/perl - ! t/comp/proto.t + +> lib/Math/BigInt/CalcEmu.pm lib/Math/BigInt/t/alias.inc + +> lib/Math/BigInt/t/mbf_ali.t lib/Math/BigInt/t/mbi_ali.t + +> lib/Math/BigInt/t/sub_ali.t + !> MANIFEST lib/Math/BigFloat.pm lib/Math/BigInt.pm + !> lib/Math/BigInt/Calc.pm lib/Math/BigInt/t/bigfltpm.inc + !> lib/Math/BigInt/t/bigintc.t lib/Math/BigInt/t/bigintpm.inc + !> lib/Math/BigInt/t/upgrade.inc ____________________________________________________________________________ -[ 21585] By: nicholas on 2003/10/30 22:54:30 - Log: Integrate: - [ 21583] - Rewrite to correctly use test.pl +[ 22010] By: nicholas on 2003/12/30 17:16:42 + Log: $expletive perforce - Date: Thu, 30 Oct 2003 15:51:03 -0800 - From: Michael G Schwern <schwern@pobox.com> - Subject: Re: Fix for the orange lion bug - aka empty sub bug - Message-ID: <20031030235103.GC27017@localhost.comcast.net> + Mop up, due to perforce's inexplicable inability to SILENTLY FAIL to + integrate two changes, where the first adds and the second edits a + file. + + Integrate: + [ 21882] + Subject: [PATCH] Math::BigInt v1.67 released + From: Tels <perl_dummy@bloodgate.com> + Date: Fri, 12 Dec 2003 18:47:43 +0100 + Message-Id: <200312121847.49039@bloodgate.com> Branch: maint-5.8/perl - !> t/op/sub.t + !> lib/Math/BigInt/t/fallback.t ____________________________________________________________________________ -[ 21584] By: nicholas on 2003/10/30 22:40:29 +[ 22008] By: nicholas on 2003/12/30 16:17:16 Log: Integrate: - [ 21582] - Date: Thu, 30 Oct 2003 22:01:35 +0000 - Subject: Fix for the orange lion bug - aka empty sub bug - From: Arthur Bergman <sky@nanisky.com> - Message-Id: <A10EEA90-0B24-11D8-93CD-000A95A2734C@nanisky.com> + [ 21970] + Allow overriding of the p4 settings via environment variables + Make regexp more robust to parse FreeBSD's patch output + + [ 22002] + Updates the notes about byacc in pumpkin.pod. Branch: maint-5.8/perl - +> t/op/sub.t - !> MANIFEST op.c + !> Porting/apply Porting/pumpkin.pod ____________________________________________________________________________ -[ 21581] By: nicholas on 2003/10/30 20:16:52 +[ 22006] By: nicholas on 2003/12/30 15:23:04 Log: Integrate: - [ 21580] - 14 is the chain length for attack. From + [ 21986] + Fix bug [perl #24762] : C<*foo{CODE} ? 1 : 0> was a syntax error - Message-ID: <20031030204117.16008.qmail@plover.com> - Subject: Re: 5.8.2-RC1 and mp2 - Date: Thu, 30 Oct 2003 15:41:17 -0500 - From: Mark Jason Dominus <mjd@plover.com> + [ 21988] + Regenerate the perly.c patch for byacc output painless fixing - and + [ 22003] + Add a regression test for bug #24762 - From: Scott A Crosby <scrosby@cs.rice.edu> - Subject: Re: 5.8.2-RC1 and mp2 - Date: 30 Oct 2003 14:08:06 -0600 - Message-ID: <oydd6cea3q1.fsf@bert.cs.rice.edu> + Plus tweaks for maint Branch: maint-5.8/perl - !> hv.c + ! perly.c perly_c.diff vms/perly_c.vms + !> perly.y t/comp/parser.t ____________________________________________________________________________ -[ 21579] By: nicholas on 2003/10/30 19:24:06 - Log: Revert part of 21497 (integration of 21418: - Subject: [PATCH] Fixing UNIVERSAL.pm's bit of unpleasantness) - and 21496 (caching of require failures in %INC) - Reconsider these for 5.8.3 +[ 22004] By: nicholas on 2003/12/30 12:59:19 + Log: Changes following feedback from p5p Branch: maint-5.8/perl - ! lib/UNIVERSAL.pm pp_ctl.c t/comp/require.t t/op/universal.t + ! pod/perldelta.pod ____________________________________________________________________________ -[ 21578] By: nicholas on 2003/10/29 21:44:55 - Log: Suggested changes from Chip +[ 22000] By: nicholas on 2003/12/30 00:17:01 + Log: First stab at a perldelta for 5.8.3 Branch: maint-5.8/perl ! pod/perldelta.pod ____________________________________________________________________________ -[ 21577] By: nicholas on 2003/10/29 18:42:35 - Log: Integrate: - [ 21575] - Move a fcntl() example in perlfunc at a more proper place, - as suggested by : - Subject: [perl #24334] ioctl/fcntl doc confusion - From: "perl-5.8.0@ton.iguana.be (via RT)" <perlbug-followup@perl.org> - Date: 28 Oct 2003 13:37:49 -0000 - Message-ID: <rt-24334-66603.12.4990768314782@rt.perl.org> +[ 21998] By: nicholas on 2003/12/29 21:28:25 + Log: Update changes Branch: maint-5.8/perl - !> pod/perlfunc.pod + ! Changes patchlevel.h ____________________________________________________________________________ -[ 21576] By: nicholas on 2003/10/29 18:02:31 - Log: Date: Wed, 29 Oct 2003 07:39:30 +0800 - From: Autrijus Tang <autrijus@autrijus.org> - Subject: Re: 5.8.2 perldelta - Message-ID: <20031028233930.GA31574@aut.dyndns.org> - - Date: Tue, 28 Oct 2003 21:35:23 -0800 - From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Subject: Re: 5.8.2 perldelta - Message-ID: <20031029053403.GA252@efn.org> +[ 21995] By: nicholas on 2003/12/29 18:25:43 + Log: Integrate: + [ 21991] + Upgrade to Encode 1.99. Branch: maint-5.8/perl - ! pod/perldelta.pod + !> ext/Encode/Changes ext/Encode/Encode.pm ext/Encode/META.yml + !> ext/Encode/Unicode/Unicode.xs ext/Encode/encoding.pm + !> ext/Encode/t/enc_eucjp.t ext/Encode/t/enc_utf8.t + !> ext/Encode/t/mime-header.t ext/Encode/ucm/gsm0338.ucm + !> ext/Encode/ucm/macArabic.ucm ext/Encode/ucm/macFarsi.ucm + !> ext/Encode/ucm/macHebrew.ucm ____________________________________________________________________________ -[ 21574] By: nicholas on 2003/10/28 22:19:10 - Log: Ronald J Kimball correctly spotted that I forgot the timezone. - GMT. What else? +[ 21994] By: nicholas on 2003/12/29 17:53:46 + Log: + Subject: [PATCH] win32_chsize buglet + From: "Kevin Chase" <kevincha99@hotmail.com> + Date: Sun, 28 Dec 2003 15:48:56 -0800 + Message-ID: <BAY2-F90usv0ccZRh8Z0005683d@hotmail.com> + + [ 21993] + Windows hasn't getuid/setuid and friends. + Therefore disable the code related to them in POSIX.xs. + + Subject: [PATCH: ext/POSIX/POSIX.xs] Re: Smoke [5.8.2] 21979 FAIL(Xt) MSWin32 5.1 Service Pack 1 (x86/1 cpu) + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Mon, 29 Dec 2003 04:51:19 +0100 + Message-ID: <03d401c3cdbf$05730ee0$d500a8c0@R2D2> Branch: maint-5.8/perl - ! pod/perldelta.pod + !> ext/POSIX/POSIX.xs win32/win32.c ____________________________________________________________________________ -[ 21573] By: nicholas on 2003/10/28 21:43:07 - Log: Improvements from Dave Mitchell, Tom Christiansen and - Rafael Garcia-Suarez +[ 21987] By: nicholas on 2003/12/27 23:17:19 + Log: Integrate: + [ 21985] + Subject: Cross compilation patches for arm. + From: Redvers Davies <red@criticalintegration.com> + Message-Id: <1072098653.4789.6.camel@ragefire> + Date: Mon, 22 Dec 2003 08:11:34 -0500 Branch: maint-5.8/perl - ! pod/perldelta.pod + ! Cross/README + !> Cross/Makefile Cross/Makefile.SH.patch + !> Cross/config.sh-arm-linux Cross/installperl.patch ____________________________________________________________________________ -[ 21572] By: nicholas on 2003/10/28 21:15:11 - Log: At last! A perldelta +[ 21984] By: nicholas on 2003/12/27 22:17:18 + Log: Integrate: + [ 21983] + Fix bug [perl #24735] : make sure that the range (..) operator + treats an undefined argument as 0 for numerical ranges and as "" + for magical string ranges. Branch: maint-5.8/perl - ! pod/perldelta.pod + !> pp_ctl.c t/op/range.t ____________________________________________________________________________ -[ 21571] By: nicholas on 2003/10/28 19:38:08 +[ 21982] By: nicholas on 2003/12/27 21:10:07 Log: Integrate: - [ 21567] - Upgrade to Time::HiRes 1.52. + [ 21962] + Subject: [PATCH: sv.c] Re: GCC bug breaking Perl_sv_catpvfn()? + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Fri, 26 Dec 2003 02:47:09 +0100 + Message-ID: <03ca01c3cb52$2d509b40$5700a8c0@R2D2> + + [ 21967] + Subject: [PATCH: sv.c] Turn Quad_t to Uquad_t in unsigned branch + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Sat, 27 Dec 2003 02:48:19 +0100 + Message-ID: <010001c3cc1b$813763a0$d500a8c0@R2D2> + + [ 21971] + Subject: [PATCH] Remove Win32 compiler warnings + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Sat, 27 Dec 2003 17:39:20 +0100 + Message-ID: <018901c3cc97$fa976660$d500a8c0@R2D2> Branch: maint-5.8/perl - !> ext/Time/HiRes/Changes ext/Time/HiRes/HiRes.pm - !> ext/Time/HiRes/Makefile.PL ext/Time/HiRes/t/HiRes.t + !> ext/XS/APItest/APItest.xs ext/threads/shared/shared.xs sv.c ____________________________________________________________________________ -[ 21570] By: nicholas on 2003/10/28 19:37:44 - Log: Changes was in a mess, with some entries in triplicate. - ("This is your receipt for your husband... - and this is my receipt for your receipt") +[ 21980] By: nicholas on 2003/12/27 19:55:01 + Log: Integrate: + [ 20734] + Subject: [PATCH] Taint problems in Cwd::abs_path + From: Michael G Schwern <schwern@pobox.com> + Date: Fri, 15 Aug 2003 18:43:45 -0700 + Message-ID: <20030816014345.GE4023@windhund.schwern.org> + + [ 21972] + Assimilate Cwd 2.12 from CPAN. Cwd wasn't in Maintainers, so change + 21646 was only applied to core (must punt this back and thereby unfork) + Need to fix test boilerplate properly for PERL_CORE + + [ 21974] + Assimilate File::Spec 0.87 + + [ 21978] + Straggler from Cwd Branch: maint-5.8/perl - ! Changes + +> ext/Cwd/Changes + ! ext/Cwd/t/taint.t + !> MANIFEST Porting/Maintainers.pl ext/Cwd/Cwd.xs ext/Cwd/t/cwd.t + !> lib/Cwd.pm lib/File/Spec.pm lib/File/Spec/t/Spec.t ____________________________________________________________________________ -[ 21569] By: nicholas on 2003/10/28 18:36:05 +[ 21979] By: nicholas on 2003/12/27 19:30:17 Log: Integrate: - [ 21564] - Fix more shared threads leaks: add SAVETMPS to the second branch - of sharedsv_scalar_store(). + [ 21548] + Sync with Pod::Perldoc 3.12 + + [ 21973] + Assimilate Digest 1.05 + + [ 21975] + Assimilate PodParser-1.26 + + [ 21976] + Assimilate Unicode::Collate 0.33 + + [ 21977] + Straggler from Unicode::Collate. + We need to automate this. + For some value of we. (tr/w/m/ I suspect) Branch: maint-5.8/perl - !> ext/threads/shared/shared.xs + +> lib/Unicode/Collate/t/altern.t + +> lib/Unicode/Collate/t/rearrang.t lib/Unicode/Collate/t/view.t + !> MANIFEST lib/Digest.pm lib/Digest/t/digest.t + !> lib/Pod/Checker.pm lib/Pod/Find.pm lib/Pod/InputObjects.pm + !> lib/Pod/ParseUtils.pm lib/Pod/Parser.pm lib/Pod/Perldoc.pm + !> lib/Pod/PlainText.pm lib/Pod/Select.pm lib/Pod/Usage.pm + !> lib/Unicode/Collate.pm lib/Unicode/Collate/Changes + !> lib/Unicode/Collate/README lib/Unicode/Collate/keys.txt + !> lib/Unicode/Collate/t/contract.t + !> lib/Unicode/Collate/t/illegal.t lib/Unicode/Collate/t/test.t + !> lib/Unicode/Collate/t/version.t pod/pod2usage.PL + !> pod/podselect.PL t/pod/pod2usage.xr t/pod/podselect.xr ____________________________________________________________________________ -[ 21568] By: nicholas on 2003/10/28 18:20:54 - Log: Drop the "RC1" +[ 21969] By: nicholas on 2003/12/27 16:37:27 + Log: Integrate: + [ 21958] + Fix bug [perl #24641] : when POSIX::set[ug]id() are called, + update the perl variables PL_uid and PL_euid (resp. PL_gid + and PL_egid) with the new values. + + [ 21968] + Subject: [PATCH] perl 5.8.0, FindBin::again + From: Slaven Rezic <slaven@rezic.de> + Date: 01 May 2003 21:28:10 +0200 + Message-ID: <873cjy31rp.fsf@vran.herceg.de> Branch: maint-5.8/perl - ! patchlevel.h + !> ext/POSIX/POSIX.xs lib/FindBin.pm lib/FindBin.t ____________________________________________________________________________ -[ 21562] By: nicholas on 2003/10/27 18:06:15 - Log: Watch the wheels fall off, the springs fly out and the cogs jam... +[ 21966] By: nicholas on 2003/12/26 21:30:11 + Log: Integrate: + [ 21957] + Subject: [PATCH 5.8.2 @21574] INSTALL_PREFIX from C + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Thu, 18 Dec 2003 12:30:06 -0800 + Message-ID: <20031218203006.GA7772@math.berkeley.edu> Branch: maint-5.8/perl - ! patchlevel.h + !> config_h.SH ____________________________________________________________________________ -[ 21561] By: nicholas on 2003/10/27 18:02:11 +[ 21965] By: nicholas on 2003/12/26 20:49:47 Log: Integrate: - [ 21560] - Record the escape^Wrelease of 5.9.0 + [ 21955] + Subject: [perl #24506] [PATCH] cannot weaken refs to read only values + From: Fergal Daly <fergal@esatclear.ie> + Date: Tue, 2 Dec 2003 23:18:18 +0000 + Message-Id: <200312022318.18353.fergal@esatclear.ie> + + (tweaked so the test is skipped on perls < 5.9.0) + + [ 21964] + Change minimum perl version where the test is run from 5.9.0 to 5.8.3 + as I'm going to integrate the core patch Branch: maint-5.8/perl - !> pod/perlhist.pod + !> ext/List/Util/t/weak.t sv.c ____________________________________________________________________________ -[ 21559] By: nicholas on 2003/10/27 17:35:53 - Log: Update Changes +[ 21963] By: nicholas on 2003/12/26 19:56:31 + Log: Integrate: + [ 21950] + sanitize some macros - based on Chip Salzenberg suggestions and + on the way GNU people use the gcc-ish 'blocks in parens' + + [ 21960] + Refactor the code that checks whether a range is numeric + or string-magical. Branch: maint-5.8/perl - ! Changes patchlevel.h + ! sv.h + !> XSUB.h pp_ctl.c ____________________________________________________________________________ -[ 21558] By: nicholas on 2003/10/27 17:29:16 - Log: Forgot to submit the updated table of contents +[ 21961] By: nicholas on 2003/12/26 17:54:21 + Log: Integrate: + [ 21959] + Restore ext/SDBM_File/sdbm/Makefile to its pre-21655 state. + This fixes building SDBM_File on AIX. Branch: maint-5.8/perl - ! pod/perltoc.pod + !> ext/SDBM_File/sdbm/Makefile.PL ____________________________________________________________________________ -[ 21557] By: nicholas on 2003/10/27 17:24:06 - Log: run pod/buildtoc +[ 21954] By: nicholas on 2003/12/24 15:32:55 + Log: Integrate: + [ 21952] + Subject: [patch t/test.pl] comment fix + From: Stas Bekman <stas@stason.org> + Message-ID: <3FE8C65A.4060708@stason.org> + Date: Tue, 23 Dec 2003 14:48:58 -0800 + + [ 21953] + Subject: [PATCH: perl@21949] document patch for VMS port on new file systems + From: PPrymmer@factset.com + Date: Tue, 23 Dec 2003 17:27:44 -0500 + Message-Id: <OF32243F10.A592C9A9-ON85256E05.007B1741-85256E05.007B63CB@factset.com> Branch: maint-5.8/perl - ! MANIFEST win32/Makefile win32/makefile.mk + !> README.vms t/test.pl ____________________________________________________________________________ -[ 21556] By: nicholas on 2003/10/27 17:16:57 - Log: Cargo cult change of 5.8.1 to 5.8.2 +[ 21949] By: nicholas on 2003/12/22 21:55:52 + Log: Integrate: + [ 21948] + Subject: Re: Smoke [5.8.2] 21930 FAIL(t) MSWin32 5.1 Service Pack 1 (x86/1 cpu) + Message-ID: <Pine.LNX.4.58.0312220116520.17374@localhost.localdomain> + Date: Mon, 22 Dec 2003 01:52:08 -0600 (CST) + From: Mike Pomraning <mjp@pilcrow.madison.wi.us> Branch: maint-5.8/perl - ! Cross/README NetWare/Makefile Porting/config.sh - ! Porting/config_H cygwin/perlld.in epoc/createpkg.pl - ! patchlevel.h plan9/config.plan9 vos/build.cm - ! vos/config.alpha.def vos/config.alpha.h vos/config.ga.def - ! vos/config.ga.h vos/install_perl.cm win32/Makefile - ! win32/config_H.bc win32/config_H.gc win32/config_H.vc - ! win32/config_H.vc64 win32/makefile.mk wince/Makefile.ce + !> ext/threads/shared/shared.xs ____________________________________________________________________________ -[ 21555] By: nicholas on 2003/10/27 16:28:54 +[ 21947] By: nicholas on 2003/12/22 20:35:11 Log: Integrate: - [ 21554] - Subject: Re: DBD::Sybase and Sybase::CTlib build problems w/ 5.8.1, Solaris, gcc - From: Alan Burlison <Alan.Burlison@sun.com> - Date: Tue, 21 Oct 2003 15:00:58 +0100 - Message-ID: <3F953C1A.3060800@sun.com> + [ 21942] + Subject: [perl #24651] Taint bug with multiple backticks in ref consturctors + From: Mike Guy <mjtg@cam.ac.uk> + Date: Fri, 19 Dec 2003 17:17:11 +0000 + Message-Id: <E1AXOFT-0007DE-7q@draco.cus.cam.ac.uk> + + [ 21946] + Subject: doc nits + From: Jarkko Hietaniemi <jhi@iki.fi> + Date: Mon, 22 Dec 2003 21:57:34 +0200 + Message-Id: <20031222195734.GA29441@vipunen.hut.fi> Branch: maint-5.8/perl - !> hints/solaris_2.sh + !> pod/perlsec.pod pod/perltodo.pod pod/perlunicode.pod ____________________________________________________________________________ -[ 21553] By: nicholas on 2003/10/27 14:09:05 - Log: Update Changes +[ 21945] By: nicholas on 2003/12/22 20:07:07 + Log: Integrate: + [ 21944] + Subject: [PATCH] configure.com archname tweak + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sun, 21 Dec 2003 23:07:13 -0600 + Message-ID: <3FE67C01.1000704@mac.com> Branch: maint-5.8/perl - ! Changes patchlevel.h + !> configure.com ____________________________________________________________________________ -[ 21552] By: nicholas on 2003/10/27 14:07:08 - Log: Changes file was in the wrong order (as noticed by Chip) +[ 21943] By: nicholas on 2003/12/21 22:41:21 + Log: Make reentrant functions work with C++ + Patch by Jan Dubois, bug report and testing by Chip Salzenberg Branch: maint-5.8/perl - ! Changes + ! reentr.inc reentr.pl ____________________________________________________________________________ -[ 21551] By: nicholas on 2003/10/27 14:05:44 +[ 21941] By: nicholas on 2003/12/21 20:42:53 Log: Integrate: - [ 21549] - Sync with Unicode::Collate 0.30 - - [ 21550] - Sync with Unicode::Normalize 0.25 + [ 21936] + fix [perl #24660], [perl #24663]. Branch: maint-5.8/perl - +> ext/Unicode/Normalize/t/fcdc.t ext/Unicode/Normalize/t/form.t - +> ext/Unicode/Normalize/t/proto.t - +> ext/Unicode/Normalize/t/split.t - +> lib/Unicode/Collate/t/hangtype.t - +> lib/Unicode/Collate/t/normal.t lib/Unicode/Collate/t/trailwt.t - +> lib/Unicode/Collate/t/variable.t - +> lib/Unicode/Collate/t/version.t - !> MANIFEST ext/Unicode/Normalize/Changes - !> ext/Unicode/Normalize/Makefile.PL - !> ext/Unicode/Normalize/Normalize.pm - !> ext/Unicode/Normalize/Normalize.xs - !> ext/Unicode/Normalize/README lib/Unicode/Collate.pm - !> lib/Unicode/Collate/Changes lib/Unicode/Collate/README - !> lib/Unicode/Collate/t/contract.t - !> lib/Unicode/Collate/t/hangul.t lib/Unicode/Collate/t/index.t - !> lib/Unicode/Collate/t/test.t + !> mg.c sv.c ____________________________________________________________________________ -[ 21547] By: nicholas on 2003/10/27 10:04:34 +[ 21939] By: nicholas on 2003/12/20 23:40:37 Log: Integrate: - [ 21544] - don't complain of podless .pm files that have a separate .pod file + [ 21933] + Subject: [PATCH] OpenVMS I64 support + From: "Craig A. Berry" <craigberry@mac.com> + Message-ID: <3FE2441F.2070603@mac.com> + Date: Thu, 18 Dec 2003 18:19:43 -0600 + + [ 21938] + Subject: Perl 5.8.3 patches from the BS2000 port + From: Dorner Thomas <tdorner@amadeus.net> + Date: Wed, 17 Dec 2003 15:41:17 +0100 + Message-ID: <6727B1DACFCDD311A757009027CA8D69044B673A@Ex02.inhouse.start.de> Branch: maint-5.8/perl - !> pod/buildtoc + !> configure.com hints/posix-bc.sh t/base/num.t t/comp/parser.t + !> vms/gen_shrfls.pl ____________________________________________________________________________ -[ 21541] By: nicholas on 2003/10/26 20:51:55 +[ 21934] By: nicholas on 2003/12/20 20:21:46 Log: Integrate: - [ 21535] - Return 21533 (with modifications) having found the problem + [ 21931] + Solaris gconvert() doesn't like ndigits == 0. Currently we have no + Configure test for troublesome gconvert(), so for now simply avoid + the optimisation that calls gconvert() in this case. - (where 21533 is - Plan C rough edge smoothing. Criteria for a hash split is now - the earlier of "more keys than buckets" (the old test) or - linked list too long. Rehash is triggered after a split if the - longest linked list is too long.) + [ 21932] + remove duplicate PERL_HASH (as spotted by Enache Adrian in + <20031220124854.GA1265@ratsnest.hole> ) Branch: maint-5.8/perl - ! hv.c - !> hv.h + !> hv.c sv.c ____________________________________________________________________________ -[ 21537] By: nicholas on 2003/10/25 23:05:21 +[ 21930] By: nicholas on 2003/12/19 19:46:46 Log: Integrate: - [ 21536] - show the rehash flags in dumps + [ 21921] + Subject: [PATCH] 2-arg cond_wait, cond_timedwait, tests + From: Mike Pomraning <mjp@pilcrow.madison.wi.us> + Date: Wed, 17 Dec 2003 00:05:58 -0600 (CST) + Message-ID: <Pine.LNX.4.58.0312092202040.13494@benevelle.wi.securepipe.com> + + [ 21922] + Subject: [PATCH: embed.fnc] arguments for perl_clone() + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Wed, 17 Dec 2003 13:26:52 +0100 + Message-ID: <055701c3c499$11144f90$8cecfe91@R2D2> Branch: maint-5.8/perl - !> dump.c + +> ext/threads/shared/t/wait.t + ! embed.h + !> MANIFEST embed.fnc ext/threads/shared/shared.pm + !> ext/threads/shared/shared.xs global.sym ____________________________________________________________________________ -[ 21531] By: nicholas on 2003/10/24 19:15:02 +[ 21929] By: nicholas on 2003/12/19 19:06:10 Log: Integrate: - [ 21530] + [ 21915] + Add the macros dAX and dITEMS to PPPort. + + [ 21927] + Subject: [DOCPATCH] base.pm + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Thu, 18 Dec 2003 22:30:52 +0100 + Message-Id: <p05111b12bc07cc596977@[192.168.56.3]> + + Plus, remove leftover mentions of pseudo-hashes - (The typo corrrection in blead) + [ 21928] + Upgrade to CGI.pm 3.01 Branch: maint-5.8/perl - !> ext/threads/shared/shared.xs + !> ext/Devel/PPPort/PPPort.pm lib/CGI.pm lib/CGI/Carp.pm + !> lib/CGI/Cookie.pm lib/CGI/Fast.pm lib/CGI/Pretty.pm + !> lib/CGI/Util.pm lib/CGI/t/carp.t lib/CGI/t/request.t + !> lib/base.pm ____________________________________________________________________________ -[ 21529] By: nicholas on 2003/10/23 19:39:41 +[ 21926] By: nicholas on 2003/12/18 20:49:11 Log: Integrate: - [ 21526] - From: Jan Dubois <jand@ActiveState.com> - Subject: [PATCH] Update Pod::Perldoc from 3.10 to 3.11 - Date: Wed, 22 Oct 2003 20:17:07 -0700 - Message-ID: <mjhepvgtnifdlgrvp20urtuu058e1jrav2@4ax.com> + [ 21883] + Modify the common guard for the signal.h header, because + C99 compilers don't like it.o + + see : + Subject: UNIX03 & C99 issue with 5.8.2 + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Fri, 12 Dec 2003 23:04:52 +0000 + Message-ID: <3FDA4994.6050209@sun.com> + + [ 21916] + Remove incorrect guards around inclusion of <signal.h> + Causes problems with UNIX03/SUSv3 - From: Jan Dubois <jand@ActiveState.com> - Subject: [PATCH] Update I18N::LangTags from 0.28 to 0.29 - Date: Wed, 22 Oct 2003 20:26:56 -0700 - Message-ID: <jgiepv0a8fp8ffq3lpc5ujl7j25hoo1rdt@4ax.com> + [ 21917] + Remove incorrect guards around inclusion of <signal.h> + Causes problems with UNIX03/SUSv3 + Part 2 of change 21916 - oops! - [ 21528] - When it says "add", then, like, you have to p4 add it. D'oh! - (missed the new file in "Update I18N::LangTags from 0.28 to 0.29") + See: + Message-Id: <3FDD06A5.8010004@sun.com> + Subject: Re: UNIX03 & C99 issue with 5.8.2 + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Mon, 15 Dec 2003 00:56:05 +0000 Branch: maint-5.8/perl - +> lib/I18N/LangTags/t/02decency.t - !> MANIFEST lib/I18N/LangTags.pm lib/I18N/LangTags/ChangeLog - !> lib/I18N/LangTags/List.pm lib/I18N/LangTags/README - !> lib/Pod/Perldoc.pm lib/Pod/Perldoc/ToMan.pm pod/perldoc.pod - !> utils/perldoc.PL + !> doio.c doop.c mg.c mpeix/mpeixish.h plan9/plan9ish.h unixish.h + !> util.c ____________________________________________________________________________ -[ 21525] By: nicholas on 2003/10/23 18:51:56 +[ 21925] By: nicholas on 2003/12/18 20:26:39 Log: Integrate: - [ 21523] - Subject: [PATCH] utime documentation - From: Gisle Aas <gisle@ActiveState.com> - Date: 23 Oct 2003 05:33:43 -0700 - Message-Id: <lrekx4jfq0.fsf@caliper.activestate.com> + [ 21912] + Subject: [DOCPATCH] perlfunc delete + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Sun, 14 Dec 2003 20:25:07 +0100 + Message-Id: <p05111b07bc0269065a99@[192.168.56.3]> + + [ 21914] + Subject: [patch Porting/pumpkin.pod] trying to ensure that PPPort is up-to-date on each new release + From: Stas Bekman <stas@stason.org> + Date: Sun, 14 Dec 2003 15:12:40 -0800 + Message-ID: <3FDCEE68.3080509@stason.org> + + [ 21923] + Perl 1.0.16 has been released. + + [ 21924] + "Richard" - who he? (Add "Richard Clamp" to the list of pumpkings) Branch: maint-5.8/perl - !> pod/perlfunc.pod + !> Porting/pumpkin.pod pod/perlfunc.pod pod/perlhist.pod ____________________________________________________________________________ -[ 21524] By: nicholas on 2003/10/23 18:38:02 +[ 21920] By: nicholas on 2003/12/16 23:32:48 Log: Integrate: - [ 21522] - Subject: [PATCH] dup2() not going through PerlLIO abstraction layer - From: Jan Dubois <jand@ActiveState.com> - Date: Wed, 22 Oct 2003 20:33:54 -0700 - Message-Id: <vniepv0n5mcrbbutm0qgvori6n6vr6arsh@4ax.com> + [ 21875] + fix bug #24605. + substr() wasn't working when used repeatedly on the same utf-8 + string. Branch: maint-5.8/perl - !> doio.c + ! sv.c + !> t/op/substr.t ____________________________________________________________________________ -[ 21521] By: nicholas on 2003/10/22 20:30:05 +[ 21919] By: nicholas on 2003/12/16 23:11:18 Log: Integrate: - [ 21520] - patch created by Casey West from: + [ 21866] + plumb a leak with pos(). + + #! perl + while (1) { + my $a = "\x{1ff}"; $a =~ /\x{1ff}/g; pos($a); + } + __END__ - Subject: CPAN module problems - From: Edward Moy <emoy@apple.com> - Date: Fri, 10 Oct 2003 17:42:06 -0700 - Message-Id: <BD2513C0-FB83-11D7-9065-000A956EFDEE@apple.com> + [ 21867] + yet another 2 leaks. example for the second: + #! perl + eval q{ open $p{q}, "foo" } while 1 + __END__ - (change ld value in hints file) + [ 21868] + yet another leak. bigger fish still swimming around. + #!perl + eval q{ $_ = "x"; s/x/"in subst"/e } while 1; + __END__ + + [ 21876] + #21866 was wrong. another try to plumb that damn leak. Branch: maint-5.8/perl - !> hints/darwin.sh + ! sv.c + !> mg.c op.c pp_ctl.c ____________________________________________________________________________ -[ 21519] By: nicholas on 2003/10/22 19:11:43 - Log: Integrate: - [ 21514] - Subject: [PATCH @20458] embedding perl - From: Radu Greab <rgreab@fx.ro> - Date: Tue, 05 Aug 2003 20:57:15 +0300 (EEST) - Message-Id: <20030805.205715.113441323.radu@yx.primIT.ro> +[ 21913] By: nicholas on 2003/12/14 22:50:47 + Log: Update Changes Branch: maint-5.8/perl - ! perl.c - !> hv.c intrpvar.h pod/perlembed.pod pod/perlintern.pod sv.c + ! Changes patchlevel.h ____________________________________________________________________________ -[ 21518] By: nicholas on 2003/10/22 18:32:17 +[ 21911] By: nicholas on 2003/12/14 20:25:18 Log: Integrate: - [ 21515] - Add a test.taintwarn makefile target, - to run the whole test suite with the -t switch. + [ 21898] + Add Perl_ceil + + [ 21910] + Forgot to remove a comment Branch: maint-5.8/perl - !> Makefile.SH pod/perlhack.pod t/TEST + !> perl.h pp.c ____________________________________________________________________________ -[ 21517] By: nicholas on 2003/10/22 17:53:48 +[ 21909] By: nicholas on 2003/12/14 19:53:35 Log: Integrate: - [ 21513] - Fix doc bug #23890, as suggested by Himanshu Garg : - in perltoot, $him->fullname should be $him->fullname->as_string - when passed to printf. + [ 21647] + Subject: [PATCH] Re: PERL_VERSION, SUBVERSION, PATCHLEVEL + From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> + Date: Mon, 3 Nov 2003 20:53:33 +0100 + Message-ID: <023a01c3a244$2a1dd5a0$0c2f1fac@R2D2> - [ 21516] - Small email update in AUTHORS. + [ 21902] + Subject: Re: 5.6.2-RC1 on Cygwin + From: Yitzchak Scott-Thoennes <sthoenna@efn.org> + Date: Sat, 6 Dec 2003 22:32:59 -0800 + Message-ID: <20031207063259.GA3004@efn.org> + (with tweaks to cleanup code) Branch: maint-5.8/perl - !> AUTHORS pod/perltoot.pod + !> ext/Devel/PPPort/PPPort.pm t/op/taint.t ____________________________________________________________________________ -[ 21512] By: nicholas on 2003/10/21 18:58:30 +[ 21908] By: nicholas on 2003/12/14 19:16:51 Log: Integrate: - [ 21372] - Sync with libnet 1.17 + [ 21872] + temporary fix to avoid t/op/tie.t failures on Win32 + + [ 21904] + Clean up a bug I introduced into caseless ENV hv_delete + (should be the proper fix for 21870 and 21872's band aid) + + [ 21905] + Subject: Re: Change 21862 + From: Enache Adrian <enache@rdslink.ro> + Date: Wed, 10 Dec 2003 06:05:58 +0200 + Message-ID: <20031210040558.GC1584@ratsnest.hole> + + (1st hunk), plus the equivalent for hv_delete_common + + [ 21906] + Some fool missed a letter n. + (and then "optimised" code based on its absense. D'oh) + Restore the correct behaviour - fetch with uppercase key, then if + still not found store with mixed/lowercase key. + + [ 21907] + S_save_hek_flags should honour the "free" flag. + Ought to mask the flag bits that shouldn't be stored. Branch: maint-5.8/perl - !> lib/Net/ChangeLog.libnet lib/Net/Domain.pm lib/Net/FTP.pm + !> hv.c ____________________________________________________________________________ -[ 21511] By: nicholas on 2003/10/21 18:31:19 - Log: - Two OS/2 portability patches from Ilya. +[ 21903] By: nicholas on 2003/12/13 23:02:59 + Log: Integrate: + [ 21834] + Subject: Re: [perl #24574] find2perl provides different results to find + From: Slaven Rezic <slaven@rezic.de> + Date: 30 Nov 2003 22:16:59 +0100 + Message-ID: <8765h1pnec.fsf@vran.herceg.de> - Subject: [PATCH 5.8.1 @21211] sockets broken on OS/2 - From: Ilya Zakharevich <nospam-abuse@ilyaz.org> - Date: Thu, 25 Sep 2003 12:09:11 -0700 - Message-ID: <20030925190911.GA27028@math.berkeley.edu> + (plus a note about find2perl now defaulting to -print in perldelta) - Subject: Re: [PATCH 5.8.1 @21379] tmpfile() broken on OS/2 - From: Ilya Zakharevich <nospam-abuse@ilyaz.org> - Date: Thu, 25 Sep 2003 19:50:45 -0700 - Message-ID: <20030926025045.GA27507@math.berkeley.edu> + [ 21891] + Make the XSRETURN macro evaluate its argument only once. Branch: maint-5.8/perl - !> doio.c os2/os2ish.h perl.h perlio.c pp_sys.c + !> XSUB.h pod/perldelta.pod x2p/find2perl.PL ____________________________________________________________________________ -[ 21508] By: nicholas on 2003/10/20 22:06:05 +[ 21901] By: nicholas on 2003/12/13 21:22:15 Log: Integrate: - [ 21506] - Subject: [PATCH] add some missing defines to Devel::PPPort - From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> - Date: Mon, 20 Oct 2003 20:14:19 +0200 - Message-ID: <03a301c39735$fb7cb220$0c2f1fac@R2D2> + [ 21892] + Subject: Patch for: [perl #24650] File::CheckTree should list Larry Wall as author, not unknown + From: David Dyck <david.dyck@fluke.com> + Date: Sat, 13 Dec 2003 00:01:34 -0800 (PST) + Message-ID: <Pine.LNX.4.51.0312122351450.8825@dd.tc.fluke.com> + + [ 21895] + alarm() is now implemented on Win32. + + [ 21897] + Reformat a long line in perlembed.pod (bug #24623). Branch: maint-5.8/perl - !> ext/Devel/PPPort/Changes ext/Devel/PPPort/PPPort.pm + !> lib/File/CheckTree.pm pod/perlembed.pod pod/perlport.pod ____________________________________________________________________________ -[ 21507] By: nicholas on 2003/10/20 20:14:57 +[ 21900] By: nicholas on 2003/12/13 21:08:12 Log: Integrate: - [ 21505] - Subject: Re: [perl #24225] [5.8.1] segfault in binmode STDOUT, ':stdio'; print 1 - From: Slaven Rezic <slaven@rezic.de> - Date: 19 Oct 2003 17:54:59 +0200 - Message-ID: <871xt9te7g.fsf@vran.herceg.de> + [ 21855] + Subject: [PATCH] SCALAR/FIRSTKEY for tied hashes in scalar context + From: Tassilo von Parseval <tassilo.parseval@post.rwth-aachen.de> + Date: Sat, 06 Dec 2003 11:50:59 +0100 + Message-id: <20031206105059.GA13989@ethan> + + [ 21856] + Clarify the description of SCALAR in perltie + + [ 21857] + Remove the "Can't provide tied hash usage" error from perldiag. + Mention the new tied hash SCALAR method in perldelta. + + [ 21863] + Missing thingies. + + [ 21865] + Subject: [PATCH] documenting SCALAR gotcha + From: Tassilo von Parseval <tassilo.parseval@post.rwth-aachen.de> + Date: Sun, 07 Dec 2003 16:41:16 +0100 + Message-id: <20031207154116.GA825@ethan> + + [ 21869] + Subject: [PATCH] iterator reset moved to hv.c (was: [PATCH] SCALAR/FIRSTKEY for tied hashes in scalar context) + From: Tassilo von Parseval <tassilo.parseval@post.rwth-aachen.de> + Date: Mon, 08 Dec 2003 08:17:46 +0100 + Message-id: <20031208071746.GA594@ethan> + + [ 21896] + The binary compatibility notes say that new global functions should + go at the end. Not that I'm anything more than "trainee" when it + comes to this bincompat stuff. Branch: maint-5.8/perl - !> perlio.c + ! pp.c pp_hot.c + !> embed.fnc embed.h global.sym hv.c lib/Tie/Hash.pm mg.c + !> pod/perlapi.pod pod/perldiag.pod pod/perlfunc.pod + !> pod/perltie.pod proto.h t/op/tie.t ____________________________________________________________________________ -[ 21504] By: nicholas on 2003/10/20 17:31:11 - Log: Integrate: - [ 21503] - Skip the chflags tests in filetest.t on Darwin. +[ 21899] By: nicholas on 2003/12/13 20:26:39 + Log: Refactor to use t/test.pl Branch: maint-5.8/perl - !> lib/filetest.t + ! t/op/avhv.t ____________________________________________________________________________ -[ 21502] By: nicholas on 2003/10/19 19:49:25 - Log: Forgot to run regen.pl when I merged Plan C (already fixed in - the snapshot) +[ 21894] By: nicholas on 2003/12/13 17:59:41 + Log: regenerate perltoc.pod and Integrate: + [ 21884] + Subject: RE: [perl #24610] Pod::Html infinite recursion + From: Anders Johnson <ajohnson@nvidia.com> + Date: Fri, 12 Dec 2003 14:07:40 -0800 + Message-ID: <33171CC36240D94EAF1FE584B1D14E0A06EC6F51@mail-sc-11.nvidia.com> + (with tweaks) + + [ 21885] + Fix some of the pods to produce more standard manpages, + as reported by Eric S. Raymond. + + [ 21886] + More POD fixes ; regenerate perltoc and perlmodlib. + + [ 21893] + foreach qw() { # not valid syntax for 5.005. So fix it. Branch: maint-5.8/perl - ! embedvar.h + ! pod/perltoc.pod + !> README.ce README.netware ext/DynaLoader/DynaLoader_pm.PL + !> lib/Getopt/Std.pm lib/Pod/Html.pm lib/diagnostics.pm + !> pod/buildtoc pod/perlmodlib.pod +____________________________________________________________________________ +[ 21890] By: nicholas on 2003/12/13 16:19:29 + Log: Integrate: + [ 21826] + Upgrade to Test::Harness 2.38. + Introduce the prove(1) utility. + (The prove-switches test is disabled for now.) + + [ 21836] + The prove utility should also be installed on VMS and on Windows. + Haven't we regression tests for installations yet ? + + [ 21871] + Upgrade to Digest-MD5 2.33. + + [ 21874] + Suppress a C< $DB::single = 1 > from Switch.pm, as noticed + by Jan Dubois. + Branch: maint-5.8/perl + +> lib/Test/Harness/bin/prove lib/Test/Harness/t/inc_taint.t + +> lib/Test/Harness/t/prove-switches.t t/lib/Dev/Null.pm + +> t/lib/sample-tests/inc_taint t/lib/sample-tests/taint_warn + +> utils/prove.PL + ! installperl + !> MANIFEST ext/Digest/MD5/Changes ext/Digest/MD5/MD5.pm + !> ext/Digest/MD5/MD5.xs ext/Digest/MD5/Makefile.PL + !> ext/Digest/MD5/t/files.t ext/Digest/MD5/typemap lib/Switch.pm + !> lib/Test/Harness.pm lib/Test/Harness/Assert.pm + !> lib/Test/Harness/Changes lib/Test/Harness/Iterator.pm + !> lib/Test/Harness/Straps.pm lib/Test/Harness/t/00compile.t + !> lib/Test/Harness/t/assert.t lib/Test/Harness/t/callback.t + !> lib/Test/Harness/t/pod.t lib/Test/Harness/t/strap-analyze.t + !> lib/Test/Harness/t/strap.t lib/Test/Harness/t/test-harness.t + !> utils.lst utils/Makefile vms/descrip_mms.template + !> win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 21889] By: nicholas on 2003/12/13 15:55:57 + Log: Integrate: + [ 21859] + Math::BigInt::Scalar is only for tests. + Move it under t/lib. + + [ 21860] + Forgot to update the MANIFEST. + + [ 21861] + Subject: [PATCH] Math::BigInt v1.67 (pre-release) + From: Tels <perl_dummy@bloodgate.com> + Date: Sat, 6 Dec 2003 20:19:44 +0100 + Message-Id: <200312062016.50484@bloodgate.com> + + [ 21882] + Subject: [PATCH] Math::BigInt v1.67 released + From: Tels <perl_dummy@bloodgate.com> + Date: Fri, 12 Dec 2003 18:47:43 +0100 + Message-Id: <200312121847.49039@bloodgate.com> + Branch: maint-5.8/perl + +> lib/Math/BigInt/t/const_mbf.t lib/Math/BigInt/t/fallback.t + +> t/lib/Math/BigInt/Scalar.pm + - lib/Math/BigInt/Scalar.pm + !> 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/bigintc.t + !> lib/Math/BigInt/t/bigintpm.inc lib/Math/BigInt/t/bigintpm.t + !> lib/Math/BigInt/t/bigints.t lib/Math/BigInt/t/biglog.t + !> lib/Math/BigInt/t/constant.t lib/Math/BigInt/t/downgrade.t + !> lib/Math/BigInt/t/sub_mbf.t lib/Math/BigInt/t/sub_mbi.t + !> lib/Math/BigInt/t/with_sub.t +____________________________________________________________________________ +[ 21888] By: nicholas on 2003/12/13 14:42:15 + Log: Integrate: + [ 21858] + Subject: [PATCH] casting bug in VMS part of Perl_start_glob + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sat, 06 Dec 2003 12:44:40 -0600 + Message-ID: <3FD22398.1060506@mac.com> + + [ 21864] + Subject: [PATCH] setenv tweak for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sat, 06 Dec 2003 18:13:32 -0600 + Message-ID: <3FD270AC.3000106@mac.com> + + [ 21879] + Subject: [PATCH] environ array fix for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Thu, 11 Dec 2003 14:35:29 -0600 + Message-ID: <3FD8D511.2030805@mac.com> + + [ 21881] + Subject: [PATCH] d_u32align for win32 + From: Gisle Aas <gisle@ActiveState.com> + Date: 11 Dec 2003 01:33:39 -0800 + Message-ID: <lrzndzr958.fsf@caliper.activestate.com> + Branch: maint-5.8/perl + !> doio.c vms/vms.c win32/config.bc win32/config.gc + !> win32/config.vc ____________________________________________________________________________ -[ 21501] By: nicholas on 2003/10/19 19:37:27 - Log: update MAINT level +[ 21887] By: nicholas on 2003/12/13 14:12:49 + Log: Integrate: + [ 21873] + Subject: [PATCH perlunicode.pod, encoding.pm] Implicit upgrading docs + From: Autrijus Tang <autrijus@autrijus.org> + Date: Tue, 9 Dec 2003 20:39:16 +0800 + Message-ID: <20031209123915.GA1454@not.autrijus.org> + + [ 21877] + Add a mention of the error "DESTROY created new reference + to dead object" in perldiag. + + [ 21878] + Subject: [PATCH] Perl 5.9.0 AUTHORS + From: Mark Leighton Fisher <mark-fisher@mindspring.com> + Message-ID: <3FD8E74F.7000202@mindspring.com> + Date: Thu, 11 Dec 2003 16:53:19 -0500 Branch: maint-5.8/perl - ! patchlevel.h + !> AUTHORS ext/Encode/encoding.pm pod/perldiag.pod + !> pod/perlunicode.pod ____________________________________________________________________________ -[ 21500] By: nicholas on 2003/10/19 19:35:55 - Log: Update Changes (submit by hand) - not sure if they're quite in the - tidiest order yet +[ 21862] By: nick on 2003/12/06 21:16:01 + Log: Win32/MinGW tweaks + A. ENV_IS_CASELESS has trys to free(keysave) when + keysave isn't in scope yet. + B. For default makefile.mk which build with perlhost.h + stuff "live" need to link with g++ to find new/delete etc. Branch: maint-5.8/perl - ! Changes + ! hv.c win32/makefile.mk ____________________________________________________________________________ -[ 21499] By: nicholas on 2003/10/19 19:14:43 - Log: If you add files you must add them to the MANIFEST +[ 21852] By: nicholas on 2003/12/05 21:09:27 + Log: Integrate: + [ 21851] + Back out the Makefile.PL part of 21808 as requested by Gisle Aas Branch: maint-5.8/perl - ! MANIFEST + !> ext/Digest/MD5/Makefile.PL ____________________________________________________________________________ -[ 21498] By: nicholas on 2003/10/19 19:08:39 - Log: Place the changes for 5.8.1 into their own file; start Changes afresh - for 5.8.2. For reference, 5.8.1 release was change 21377 +[ 21850] By: nicholas on 2003/12/05 19:44:34 + Log: Integrate: + [ 21843] + Subject: [PATCH] another ext/SDBM_File/sdbm build fix + From: "Craig A. Berry" <craigberry@mac.com> + Date: Thu, 04 Dec 2003 16:00:03 -0600 + Message-ID: <3FCFAE63.1080106@mac.com> + + [ 21844] + Subject: [REPATCH lib/AutoLoader.t] Test can() with AutoLoader + From: chromatic <chromatic@wgz.org> + Date: Mon, 01 Dec 2003 09:20:21 -0800 + Message-Id: <1070299221.1275.19.camel@localhost> Branch: maint-5.8/perl - + Changes5.8.1 - ! Changes + !> ext/SDBM_File/sdbm/Makefile.PL lib/AutoLoader.t ____________________________________________________________________________ -[ 21497] By: nicholas on 2003/10/19 18:50:07 +[ 21849] By: nicholas on 2003/12/05 19:26:44 Log: Integrate: - [ 21418] - Subject: [PATCH] Fixing UNIVERSAL.pm's bit of unpleasantness - From: schwern@pobox.com - Date: Mon, 6 Oct 2003 13:14:36 -0700 - Message-Id: <20031006131436.G20960@ttul.org> + [ 21837] + Subject: Re: XS modules having problems with CLONE and ithreads unless PERL_NO_GET_CONTEXT is defined + From: Stas Bekman <stas@stason.org> + Date: Wed, 03 Dec 2003 01:41:42 -0800 + Message-ID: <3FCDAFD6.9050106@stason.org> - [ 21449] - Subject: [PATCH] SIGN => 1 support for MakeMaker - From: Autrijus Tang <autrijus@autrijus.org> - Date: Tue, 14 Oct 2003 18:32:28 +0800 - Message-Id: <1066127547.65845.35.camel@localhost> + [ 21842] + Subject: [PATCH] $^P, eval and caller + From: Paul Johnson <paul@pjcj.net> + Date: Fri, 5 Dec 2003 00:57:21 +0100 + Message-ID: <20031204235721.GJ26355@pjcj.net> Branch: maint-5.8/perl - !> lib/ExtUtils/MM_Any.pm lib/ExtUtils/MM_Unix.pm - !> lib/ExtUtils/MakeMaker.pm lib/UNIVERSAL.pm t/op/universal.t + ! mg.c + !> sv.c ____________________________________________________________________________ -[ 21496] By: nicholas on 2003/10/19 18:31:14 +[ 21848] By: nicholas on 2003/12/05 18:43:44 Log: Integrate: - [ 21415] - Subject: [PATCH bleadperl] (was Re: require() does not behave aas documented) - From: Rick Delaney <rick@bort.ca> - Date: Tue, 23 Sep 2003 12:14:52 -0400 - Message-ID: <20030923121452.G18845@biff.bort.ca> + [ 21840] + Subject: Re: a2p.pod not being installed in 5.8.2? + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Thu, 04 Dec 2003 12:14:30 +0000 + Message-ID: <3FCF2526.3030905@sun.com> - [ 21427] - Subject: Re: require patch breaks locale - From: Rick Delaney <rick@bort.ca> - Date: Wed, 8 Oct 2003 22:41:55 -0400 - Message-Id: <20031008224155.A14638@biff.bort.ca> + [ 21846] + Subject: [PATCH] Configure gets d_u32align wrong + From: Gisle Aas <gisle@ActiveState.com> + Date: 05 Dec 2003 03:47:01 -0800 + Message-ID: <lr4qwfbi6i.fsf_-_@caliper.activestate.com> Branch: maint-5.8/perl - !> pp_ctl.c t/comp/require.t + !> Configure installperl ____________________________________________________________________________ -[ 21495] By: nicholas on 2003/10/19 18:13:23 +[ 21847] By: nicholas on 2003/12/05 18:25:53 Log: Integrate: - [ 21407] - Subject: [PATCH]Re: The META.yml file in bleadperl - From: Fergal Daly <fergal@esatclear.ie> - Date: Mon, 6 Oct 2003 00:25:29 +0100 - Message-Id: <200310060025.29122.fergal@esatclear.ie> + [ 21841] + Fix File::Copy with hard links on Windows. - Plus regeneration of META.yml + Subject: [PATCH] Re: perl @ 21830 + From: Steve Hay <steve.hay@uk.radan.com> + Date: Wed, 03 Dec 2003 10:53:02 +0000 + Message-ID: <3FCDC08E.7080800@uk.radan.com> + + and + Date: Thu, 04 Dec 2003 11:02:22 +0000 + Message-ID: <3FCF143E.1040905@uk.radan.com> Branch: maint-5.8/perl - + META.yml - !> Porting/makemeta + !> lib/File/Copy.pm lib/File/Copy.t ____________________________________________________________________________ -[ 21494] By: nicholas on 2003/10/19 17:55:17 +[ 21839] By: nicholas on 2003/12/03 21:51:48 Log: Integrate: - [ 21438] - Subject: Re: [perl #24122] setreuid and friends borked on darwin/osx - From: Slaven Rezic <slaven@rezic.de> - Date: 07 Oct 2003 00:04:34 +0200 - Message-ID: <87ekxq6n0t.fsf@vran.herceg.de> + [ 21832] + Better docs for the special code blocks, based on : + Subject: [DOCPATCH] BEGIN, CHECK, INIT, END explained more + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Sat, 29 Nov 2003 23:15:56 +0100 + Message-Id: <p05111b01bbeec2e8bf30@[192.168.56.3]> - [ 21440] - Subject: [perl #24122] setreuid and friends borked on darwin/osx - From: "pxm@nubz.org (via RT)" <perlbug-followup@perl.org> - Date: 5 Oct 2003 20:55:56 -0000 - Message-ID: <rt-24122-65678.14.2411168523081@rt.perl.org> + [ 21835] + FAQ sync. Branch: maint-5.8/perl - !> hints/darwin.sh mg.c + !> pod/perlfaq1.pod pod/perlfaq2.pod pod/perlfaq3.pod + !> pod/perlfaq4.pod pod/perlfaq5.pod pod/perlmod.pod + !> pod/perlsub.pod +____________________________________________________________________________ +[ 21838] By: nicholas on 2003/12/03 19:13:35 + Log: Remove duplicate call to PERL_HASH in delete + Transpires that in maint there just aren't enough shared hash SVs + to make the check in hv.c worth it. + Branch: maint-5.8/perl + ! hv.c ____________________________________________________________________________ -[ 21493] By: nicholas on 2003/10/19 17:35:10 +[ 21831] By: nicholas on 2003/12/02 20:35:22 Log: Integrate: - [ 21424] - Subject: Re: Simple @INC hook core dump [PATCH] - From: Gisle Aas <gisle@ActiveState.com> - Date: 08 Oct 2003 04:47:33 -0700 - Message-ID: <lrllrweysq.fsf_-_@caliper.activestate.com> + (The hv.c changes of 17740) + [ 17740] + Clean up copy-on-write macros and debug facilities (new flag 'C'). + Handle CoW in hashes: + Subject: Re: why would tr/// be performing hash copies? + From: Nicholas Clark <nick@unfortu.net> + Date: Sun, 18 Aug 2002 23:17:01 +0100 + Message-id: <20020818221700.GD294@Bagpuss.unfortu.net> - [ 21426] - Subject: Re: Simple @INC hook core dump [PATCH] - From: Gisle Aas <gisle@ActiveState.com> - Date: 08 Oct 2003 13:35:28 -0700 - Message-Id: <lrr81ncvsf.fsf@caliper.activestate.com> + [ 21747] + merge hv_exists and hv_exists_ent into S_hv_exists_common + + [ 21750] + integrate hv_delete and hv_delete_ent into hv_delete_common + + [ 21753] + merge hv_fetch and hv_fetch_ent into hv_fetch_common + remove S_hv_fetch_flags + hv.c now 13% smaller than when I started. hv_store TODO + + [ 21758] + Merge sv_store_flags and sv_store_ent into sv_store_common + + [ 21760] + Shift negative klen/flags games from hv_fetch_common out to hv_fetch + + [ 21765] + Tweaks to S_hv_delete_common: + make the magic call hv_fetch_common rather than ent-or-not + grab the hash from a shared hash key scalar if possible + use masked flags rather than flags for the comparison - [ 21452] - Fix bug [perl #24212] : improper error recovery in the - tokenizer after an unknown filetest operator. + [ 21766] + Move the negative key -> utf8 flag conversion out to hv_delete + + [ 21768] + Shift negative klen/flags games from hv_exists_common out to hv_exists + + [ 21769] + Shift negative klen/flags games from hv_store_common out to hv_store + + [ 21770] + Farewell hv_exists_common - exists is now a call to fetch + (with the exists magic handling moved into fetch) + + [ 21771] + "Space Is a Province of Brazil" + Farewell, hv_store_common. Store is now part of Fetch. + All tests pass. hv.c 15% smaller than when I started all this + + [ 21772] + Reorder functions in hv.c so that callers of hv_fetch_common are all + close to it. + + [ 21779] + D'oh. Mistake in the DYNAMIC_ENV_FETCH conditional code + reported by Craig Berry + + [ 21781] + Tweak the order of initialisation of oentry in hv_fetch_common - + C source now cleaner, but optimised object file still the same size. + + [ 21782] + Should fix the infinite loop on a dynamic %ENV fetch Branch: maint-5.8/perl - !> pp_ctl.c t/comp/parser.t t/op/inccode.t toke.c + ! hv.c + !> embed.fnc embed.h proto.h ____________________________________________________________________________ -[ 21492] By: nicholas on 2003/10/19 17:17:40 +[ 21830] By: nicholas on 2003/11/30 21:36:13 + Log: Update Changes + Branch: maint-5.8/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 21829] By: nicholas on 2003/11/30 21:35:03 Log: Integrate: - [ 21436] - Subject: [PATCH] threads::async + some cleanup - From: Elizabeth Mattijsen <liz@dijkmat.nl> - Date: Fri, 10 Oct 2003 16:37:55 +0200 - Message-Id: <p05111b07bbac713a0aaf@[192.168.56.2]> - - [ 21470] - Ensure PL_comppad/curpad point to PL_main_cv's padlist when - PL_main_root is freed; this may not have been be the case if a - thread other than the main one is the last to be destroyed - Branch: maint-5.8/perl - ! ext/threads/threads.pm - !> ext/threads/t/thread.t pad.h perl.c -____________________________________________________________________________ -[ 21491] By: nicholas on 2003/10/19 16:54:46 - Log: Integrate: - [ 21451] - Update MIME::Base64 and Digest::MD5 from the CPAN version. - Branch: maint-5.8/perl - !> ext/Digest/MD5/Changes ext/Digest/MD5/MD5.pm - !> ext/Digest/MD5/Makefile.PL ext/Digest/MD5/t/align.t - !> ext/Digest/MD5/t/files.t ext/Digest/MD5/t/utf8.t - !> ext/MIME/Base64/Base64.pm ext/MIME/Base64/Base64.xs - !> ext/MIME/Base64/Changes ext/MIME/Base64/Makefile.PL - !> ext/MIME/Base64/QuotedPrint.pm ext/MIME/Base64/t/unicode.t -____________________________________________________________________________ -[ 21490] By: nicholas on 2003/10/19 16:19:58 - Log: Integrate: - [ 21402] - Subject: [PATCH] pp_sys.c: pp_waitpid and EINTR - From: Steve Grazzini <grazz@pobox.com> - Date: Sat, 4 Oct 2003 18:15:23 -0400 - Message-Id: <20031004221523.GA29324@grazzini.net> - - [ 21425] - Fix bug #24108: Goto +foo broken - the fix having been suggested by xmath via Juerd. - - [ 21428] - Subject: [PATCH] Devel::PPPort is missing an aTHX when calling - grok_numeric_radix() - From: Jan Dubois <jand@ActiveState.com> - Date: Wed, 08 Oct 2003 20:37:42 -0700 - Message-Id: <8kl9ov0932qo08o24uafuc9v77clrgnoe4@4ax.com> - - [ 21429] - Patch based on: - - Subject: [perl #24157] -MModule=} is broken - From: "Lukas Mai" (via RT) <perlbug-followup@perl.org> - Date: 7 Oct 2003 21:47:43 -0000 - Message-Id: <rt-24157-65809.10.9980909617566@rt.perl.org> - - (Includes a fix for a similar problem in -A, but not -d.) - - [ 21430] - Subject: [PATCH 5.8.1 CORE] Internal fixes to source-code coordinate - calculations in regcomp.c - From: Eric Promislow <ericp@ActiveState.com> - Date: Wed, 8 Oct 2003 17:42:42 -0700 - Message-Id: <20031008174242.A17544@ActiveState.com> - - [ 21441] - Subject: [PATCH] Internals::hash_seed() returns wrong value - From: Jan Dubois <jand@ActiveState.com> - Date: Sun, 12 Oct 2003 22:09:39 -0700 - Message-ID: <07ckovck8mp5e8tthmtbbcrpi2tj6q9eak@4ax.com> - - [ 21445] - Subject: [PATCH ext/Devel/PPPort/PPPort.pm] Changes #20819 and #20996 break compatibility with perl 5.6.0 - From: "Marcus Holland-Moritz" <mhx-perl@gmx.net> - Date: Tue, 30 Sep 2003 19:23:34 +0200 - Message-ID: <021e01c38777$93ea4e10$0c2f1fac@R2D2> + [ 21827] + Keep installing xsubpp in lib/ExtUtils, + so MakeMaker can find it. Branch: maint-5.8/perl - ! perl.c - !> ext/Devel/PPPort/PPPort.pm op.c pp_sys.c regcomp.c t/op/goto.t - !> universal.c + ! installperl ____________________________________________________________________________ -[ 21489] By: nicholas on 2003/10/19 11:14:32 +[ 21825] By: nicholas on 2003/11/30 20:19:43 + Log: Update Changes + Branch: maint-5.8/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 21824] By: nicholas on 2003/11/30 19:00:33 Log: Integrate: - [ 21397] - Subject: Re: 5.8.1 and srand - From: Brendan O'Dea <bod@debian.org> - Date: Thu, 2 Oct 2003 10:30:36 +1000 - Message-Id: <20031002003036.GA9198@londo.c47.org> + [ 21802] + POSIX::isXXX(undef) segfaulted. (bug #24554.) - [ 21401] - Subject: Re: 5.8.1 and srand - From: Slaven Rezic <slaven@rezic.de> - Date: Thu, 2 Oct 2003 15:51:11 +0000 - Message-Id: <1065109871.3115@devpc01.iconmobile.de> + [ 21823] + Subject: Re: [perl #24554] Segfault in POSIX module + From: SADAHIRO Tomoyuki <bqw10602@nifty.com> + Date: Sat, 29 Nov 2003 23:32:38 +0900 + Message-Id: <20031129233010.8E2F.BQW10602@nifty.com> + + (plus a test for the stringification of references + passed to POSIX::isXXX()) Branch: maint-5.8/perl - !> t/op/fork.t util.c + !> ext/POSIX/POSIX.xs ext/POSIX/t/is.t ext/POSIX/t/posix.t ____________________________________________________________________________ -[ 21488] By: nicholas on 2003/10/19 10:47:57 +[ 21822] By: nicholas on 2003/11/30 10:35:31 Log: Integrate: - [ 21419] - Why should -3**$x be more precisely determined than 3**$x? + [ 21810] + Update Unicode::Collate to 0.31 (Only the .pm version for now) + + [ 21812] + Update Unicode::Normalize to 0.28 + Branch: maint-5.8/perl + +> ext/Unicode/Normalize/t/illegal.t + +> ext/Unicode/Normalize/t/null.t ext/Unicode/Normalize/t/short.t + +> lib/Unicode/Collate/t/illegal.t + +> lib/Unicode/Collate/t/illegalp.t + !> MANIFEST ext/Unicode/Normalize/Changes + !> ext/Unicode/Normalize/Normalize.pm + !> ext/Unicode/Normalize/Normalize.xs + !> ext/Unicode/Normalize/README lib/Unicode/Collate.pm + !> lib/Unicode/Collate/Changes lib/Unicode/Collate/README + !> lib/Unicode/Collate/t/version.t +____________________________________________________________________________ +[ 21821] By: nicholas on 2003/11/30 10:24:55 + Log: Integrate: + [ 21807] + Update Digest to 1.03 + + [ 21808] + Update to Digest::MD5 2.31 + + [ 21809] + D'oh! Forgot to lib/Digest/base.pm + + [ 21811] + D'oh! This has been moved to lib/Digest/t/digest.t but not deleted. + Branch: maint-5.8/perl + +> ext/Digest/MD5/t/bits.t lib/Digest/base.pm lib/Digest/t/base.t + +> lib/Digest/t/digest.t + - lib/Digest.t + !> MANIFEST Porting/Maintainers.pl ext/Digest/MD5/Changes + !> ext/Digest/MD5/MD5.pm ext/Digest/MD5/Makefile.PL + !> ext/Digest/MD5/t/badfile.t ext/Digest/MD5/t/files.t + !> lib/Digest.pm +____________________________________________________________________________ +[ 21820] By: nicholas on 2003/11/30 10:11:14 + Log: Integrate all the t/op/readline.t changes: + [ 19069] + Subject: [PATCH] Re: [perl #21614] 5.8.0 Unbalanced string table refcount + From: Nicholas Clark <nick@unfortu.net> + Date: Tue, 25 Mar 2003 22:59:17 +0000 + Message-ID: <20030325225917.GE284@Bagpuss.unfortu.net> + + [ 19069] + Subject: [PATCH] Re: [perl #21614] 5.8.0 Unbalanced string table refcount + From: Nicholas Clark <nick@unfortu.net> + Date: Tue, 25 Mar 2003 22:59:17 +0000 + Message-ID: <20030325225917.GE284@Bagpuss.unfortu.net> + + [ 19071] + Better version of change #19069 + Subject: [PATCH] Re: [PATCH] Re: [perl #21614] 5.8.0 Unbalanced string table refcount + From: Nicholas Clark <nick@unfortu.net> + Date: Wed, 26 Mar 2003 23:01:46 +0000 + Message-ID: <20030326230145.GC279@Bagpuss.unfortu.net> + + [ 19267] + Subject: [PATCH] readline.t tweak for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Thu, 17 Apr 2003 17:18:19 -0500 + Message-ID: <3E9F282B.6090603@mac.com> + + [ 20431] + More runperl(switches => ...) finds (bleadperl only). + + [ 21787] + Subject: [PATCH] Re: bug or a feature? + From: Torsten Foertsch <torsten.foertsch@gmx.net> + Date: Sat, 22 Nov 2003 13:15:53 +0100 + Message-Id: <200311221315.58539.torsten.foertsch@gmx.net> + + and + Date: Sat, 22 Nov 2003 14:21:45 +0100 + Message-Id: <200311221421.48940.torsten.foertsch@gmx.net> + (test moved to t/op/readline.t) - [ 21420] - Minor tweaks to t/op/pow.t (John P. Linderman). + [ 21794] + Arguments to skip were the wrong way round, hence why all the *BSDs + were failing Branch: maint-5.8/perl - !> t/op/pow.t + ! sv.c t/op/readline.t + !> pp_hot.c ____________________________________________________________________________ -[ 21487] By: nicholas on 2003/10/18 22:33:08 +[ 21819] By: nicholas on 2003/11/30 09:57:11 Log: Integrate: - [ 21433] - Put all pre-processor #s on the first column (some compilers are picky) - [perl #24167] `#' comment signs not at the very beginning of a line - - [ 21468] - Subject: Re: assert.h breaks perl.h - From: Alexey Tourbin <at@altlinux.ru> - Date: Thu, 16 Oct 2003 22:24:35 +0400 - Message-Id: <20031016182434.GH1724@julia.office.altlinux.ru> + [ 21805] + Silence gcc 2.95 warning + (Its trace flow isn't good enough to realise that there is no problem) Branch: maint-5.8/perl - !> cop.h dosish.h ext/SDBM_File/sdbm/sdbm.h iperlsys.h op.c - !> perl.h regcomp.c sv.h + !> pp_hot.c ____________________________________________________________________________ -[ 21486] By: nicholas on 2003/10/18 22:12:47 +[ 21818] By: nicholas on 2003/11/30 09:43:55 Log: Integrate: - [ 21404] - Subject: [perl #24120] Tie::Hash documentation has broken code - From: "Benjamin J. Tilly" (via RT) <perlbug-followup@perl.org> - Date: 5 Oct 2003 18:40:36 -0000 - Message-Id: <rt-24120-65664.15.9776865968429@rt.perl.org> - (Applied without $VERSION update.) - - [ 21439] - Subject: [PATCH] Tie::Hash documentation - From: Slaven Rezic <slaven@rezic.de> - Date: Sun, 12 Oct 2003 18:55:54 +0200 (CEST) - Message-Id: <200310121655.h9CGtsrY003613@vran.herceg.de> + [ 21800] + Fix a regression introduced by change #21694 on sprintf() + with long doubles, by disabling the specific optimisation + path in this case ; remove a unnecessary cast ; add a new + test file for miscellaneous sprintf() test that don't fit + in the t/op/sprintf.t framework. - [ 21442] - Subject: [perl #24189] Incorrect comment in perldoc strict - From: "Iain 'Spoon' Truskett (via RT)" <perlbug-followup@perl.org> - Date: 12 Oct 2003 09:01:25 -0000 - Message-Id: <rt-24189-65954.9.50514379869631@rt.perl.org> + [ 21804] + Gconvert actually takes type NV, while nv may be either double + or long double (depending on some conditional code) + Rafael and I think that this cast should work. - [ 21467] - Subject: [PATCH] Tie::Hash documentation - From: Slaven Rezic <slaven@rezic.de> - Date: Thu, 16 Oct 2003 17:57:35 +0000 - Message-Id: <1066327055.1428@devpc01.iconmobile.de> + [ 21806] + When Gconvert is a macro around sprintf with a .* format we need + to cast to int (in case STRLEN isn't the same size as int) + gcc issues a warning even when it is the same size + Branch: maint-5.8/perl + +> t/op/sprintf2.t + !> MANIFEST sv.c +____________________________________________________________________________ +[ 21817] By: nicholas on 2003/11/30 09:25:20 + Log: Copy SvIsCOW(sv) and SvIsCOW_shared_hash(sv) from blead + (Each is part of separate much larger changes, so can't integrate) Branch: maint-5.8/perl - !> lib/Tie/Hash.pm lib/strict.pm + ! sv.h ____________________________________________________________________________ -[ 21485] By: nicholas on 2003/10/18 21:44:41 +[ 21816] By: nicholas on 2003/11/29 21:15:29 Log: Integrate: - [ 21416] - Subject: [patch sv.c] improve "...free unref scalar" warning + [ 21799] + Subject: [patch pod/perlsec.pod] (was Re: why PERL5LIB is ignored when -T is in effect) From: Stas Bekman <stas@stason.org> - Date: Mon, 06 Oct 2003 21:19:53 -0700 - Message-Id: <3F823EE9.4030103@stason.org> + Date: Fri, 28 Nov 2003 14:42:25 -0800 + Message-ID: <3FC7CF51.7060804@stason.org> - [ 21420] - Minor tweaks to sv.c (Tim Bunce) + [ 21813] + Remove whitespace from ends of lines (simply because it irritates me) Branch: maint-5.8/perl - !> sv.c + !> pod/perlsec.pod utils/h2xs.PL ____________________________________________________________________________ -[ 21484] By: nicholas on 2003/10/18 21:25:13 +[ 21815] By: nicholas on 2003/11/29 21:15:05 Log: Integrate: - [ 21453] - Typos. + [ 21797] + Subject: Re: [perl #24245] File::Copy::copy damages hard linked files + From: Slaven Rezic <slaven@rezic.de> + Date: 19 Oct 2003 19:11:31 +0200 + Message-ID: <87smlprw3g.fsf@vran.herceg.de> + (with further tweaks) + Branch: maint-5.8/perl + !> lib/File/Copy.pm lib/File/Copy.t +____________________________________________________________________________ +[ 21803] By: nicholas on 2003/11/29 13:09:40 + Log: Integrate: + It's back! + [ 21449] + Subject: [PATCH] SIGN => 1 support for MakeMaker + From: Autrijus Tang <autrijus@autrijus.org> + Date: Tue, 14 Oct 2003 18:32:28 +0800 + Message-Id: <1066127547.65845.35.camel@localhost> + + [ 21652] + Upgrade to ExtUtils::MakeMaker 6.19 - [ 21472] - The compilation of PerlIO::via may hang on AIX when - compiling with vac at -O3 optimization level. Disable - optimization for this module. + [ 21675] + Upgrade to MakeMaker 6.20. + + [ 21702] + Upgrade to MakeMaker 6.21. Branch: maint-5.8/perl - +> ext/PerlIO/via/hints/aix.pl - !> MANIFEST hints/aix.sh + +> lib/ExtUtils/t/parse_version.t + +> t/lib/MakeMaker/Test/Setup/BFD.pm + +> t/lib/MakeMaker/Test/Setup/Problem.pm + - lib/ExtUtils/t/00setup_dummy.t + - lib/ExtUtils/t/zz_cleanup_dummy.t + ! lib/ExtUtils/MM_Any.pm lib/ExtUtils/MM_Unix.pm + !> (integrate 37 files) ____________________________________________________________________________ -[ 21483] By: nicholas on 2003/10/18 20:50:49 +[ 21801] By: nicholas on 2003/11/29 11:05:18 Log: Integrate: - [ 21390] - Subject: Re: NCR MP-RAS perl problems [perl #23791] - From: grommel@sears.com - Date: Mon, 29 Sep 2003 14:45:16 -0500 - Message-ID: <OF9B00605E.3CC90F32-ON86256DB0.006B13F0-86256DB0.006C8E85@LocalDomain> + [ 21655] + Temporary kludge to allow SDBM_File being built + with MakeMaker 6.19. + + [ 21657] + Subject: Re: [ANNOUNCE] ExtUtils::MakeMaker 6.19 + From: Michael G Schwern <schwern@pobox.com> + Date: Tue, 4 Nov 2003 17:59:13 -0800 + Message-ID: <20031105015913.GL15406@localhost.comcast.net> - [ 21410] - Subject: Re: [doc-PATCH] for unpack_str() and question - From: LAUN Wolfgang <wolfgang.laun@alcatel.at> - Date: Mon, 6 Oct 2003 08:45:29 +0200 - Message-ID: <75A46BF1A9D8D311863A00508B6259A405F180C1@ATTMSX4> + Replaces the temporary kludge (#21655). + + [ 21710] + Subject: [PATCH] Last stab at sdbm/Makefile.PL + From: Michael G Schwern <schwern@pobox.com> + Date: Tue, 11 Nov 2003 21:02:30 -0800 + Message-ID: <20031112050230.GO6874@localhost.comcast.net> Branch: maint-5.8/perl - !> hints/svr4.sh pod/perlapi.pod pp_pack.c t/op/pack.t + !> ext/SDBM_File/sdbm/Makefile.PL ____________________________________________________________________________ -[ 21482] By: nicholas on 2003/10/18 18:26:46 +[ 21796] By: nicholas on 2003/11/28 20:05:30 Log: Integrate: - [ 21464] - Subject: perl -h tweak [PATCH] - From: Gisle Aas <gisle@ActiveState.com> - Date: 16 Oct 2003 02:49:39 -0700 - Message-Id: <lrn0c11pho.fsf@caliper.activestate.com> + [ 21788] + Add Torsten Foertsch to AUTHORS (patches plus tests are what we like) - [ 21466] - Further tweak on change #21464. + [ 21789] + Marcus Holland-Moritz is now the maintainer of Devel::PPPort. + PerlIO and threads are not on CPAN. - [ 21473] - -u is deprecated. - Subject: Re: why PERL5LIB is ignored when -T is in effect - From: Slaven Rezic <slaven@rezic.de> - Date: Fri, 17 Oct 2003 10:02:31 +0000 - Message-Id: <1066384951.4964@devpc01.iconmobile.de> + [ 21795] + Subject: [PATCH] Fix perl 5.8 and 5.9 to build on latest VOS + From: "Green, Paul" <Paul.Green@stratus.com> + Date: Thu, 27 Nov 2003 21:51:26 -0500 + Message-ID: <A2A34F15EE916148BC4C4748223E67A4069FB815@exna4.stratus.com> + Branch: maint-5.8/perl + !> AUTHORS Porting/Maintainers.pl hints/vos.sh +____________________________________________________________________________ +[ 21786] By: nicholas on 2003/11/25 19:48:30 + Log: re-run pod/buildtoc Branch: maint-5.8/perl - !> perl.c + ! pod.lst pod/perl.pod pod/perltoc.pod vms/descrip_mms.template + ! win32/pod.mak ____________________________________________________________________________ -[ 21481] By: nicholas on 2003/10/18 17:40:32 +[ 21785] By: nicholas on 2003/11/25 19:42:14 + Log: Re-order entries + Branch: maint-5.8/perl + ! MANIFEST +____________________________________________________________________________ +[ 21784] By: nicholas on 2003/11/25 19:25:25 Log: Integrate: - [ 21394] - Subject: misapplied patch 19452 + [ 21780] + Subject: Re: [perl #24439] 64 bit build failure on Solaris 9 + From: Andy Dougherty <doughera@lafayette.edu> + Date: Thu, 20 Nov 2003 09:38:05 -0500 (EST) + Message-ID: <Pine.SOL.4.53.0311200926550.25274@maxwell.phys.lafayette.edu> + + and : + Date: Fri, 21 Nov 2003 09:36:24 -0500 (EST) + Message-ID: <Pine.SOL.4.53.0311210927460.1876@maxwell.phys.lafayette.edu> + + [ 21783] + Subject: remove hardcoded version number from cygwin/perlld.in From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Tue, 30 Sep 2003 06:01:50 -0700 - Message-Id: <20030930130150.GA1436@efn.org> + Date: Mon, 24 Nov 2003 08:11:36 -0800 + Message-ID: <20031124161136.GC2656@efn.org> Branch: maint-5.8/perl - ! pp_hot.c + !> cygwin/Makefile.SHs cygwin/perlld.in hints/solaris_2.sh ____________________________________________________________________________ -[ 21480] By: nicholas on 2003/10/18 16:42:12 +[ 21778] By: nicholas on 2003/11/22 23:21:32 Log: Integrate: - [ 21383] - Missing +x bits. + [ 21706] + Subject: Re: [perl #24460] [DOC PATCH] the begincheck program + From: Tom Phoenix <rootbeer@redcat.com> + Date: Tue, 11 Nov 2003 15:50:35 -0800 (PST) + Message-Id: <Pine.BSO.4.53.0311111547500.9242@blue.stonehenge.com> + + [ 21751] + Update the runops stuff in perlguts + + [ 21754] + Subject: [docpatch] PerlIO layers in perlrun.pod and PerlIO.pm + From: Iain Truskett <spoon@cpan.org> + Date: Thu, 20 Nov 2003 00:41:33 +1100 + Message-ID: <20031119134132.GG21314@gytha.anu.edu.au> Branch: maint-5.8/perl - !> Porting/makerel + !> lib/PerlIO.pm pod/perlguts.pod pod/perlmod.pod pod/perlrun.pod ____________________________________________________________________________ -[ 21479] By: nicholas on 2003/10/18 16:37:49 +[ 21777] By: nicholas on 2003/11/22 23:17:43 Log: Integrate: - [ 21385] - Subject: [PATCH 5.8.1] pod/perlrun.pod: no space after -i allowed - From: Brendan O'Dea <bod@debian.org> - Date: Sun, 28 Sep 2003 23:23:34 +1000 - Message-ID: <20030928132334.GA29499@londo.c47.org> + [ 21697] + Subject: [PATCH 5.8.2 @21574] make install: line noise + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Tue, 4 Nov 2003 20:10:16 -0800 + Message-ID: <20031105041016.GA2639@math.berkeley.edu> - [ 21386] - Subject: [PATCH 5.8.1] Fix broken splitpod program - From: Steve Hay <steve.hay@uk.radan.com> - Date: Mon, 29 Sep 2003 11:50:23 +0100 - Message-ID: <3F780E6F.3020704@uk.radan.com> + and part of + Subject: [PATCH 5.8.2 @21574] make install: PREFIX and DESTDIR + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Tue, 4 Nov 2003 20:18:37 -0800 + Message-ID: <20031105041836.GA2649@math.berkeley.edu> - [ 21388] - Subject: [PATCH] Re: [perl #24071] Typo in description of binmode - From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Tue, 30 Sep 2003 04:53:02 -0700 - Message-ID: <20030930115302.GA3200@efn.org> - - [ 21392] - Revamp the section on local() in perlsub. - - avoid using the word "declare" in conjunction with local() - - less archaelogical references - - more about localization of lvalues - - removes examples of localization of tied hashes that don't work - - give titles to subsections - - explain localization of magic values - - explain localization of globs - - fix link to perldelta - - [ 21398] - build perlapi.pod in deterministic order even when functions differ - only in case; regen perlapi.pod - - [ 21403] - Subject: Re: [PATCH] [perl #24113] mistake in perlretut - From: Robert Spier <rspier@pobox.com> - Date: Sun, 05 Oct 2003 21:34:30 -0700 - Message-Id: <m3vfr39e7d.wl_rspier@pobox.com> - - [ 21405] - Subject: Re: [PATCH] perlsyn.pod Revision - Resend - From: Shlomi Fish <shlomif@vipe.technion.ac.il> - Date: Fri, 3 Oct 2003 12:34:46 +0200 (IST) - Message-Id: <Pine.LNX.4.56.0310031233580.28640@vipe.technion.ac.il> - (Applied with minor tweaks.) - - [ 21409] - Subject: [PATCH pod/perlfunc.pod] ref can return false on references - From: Abigail <abigail@abigail.nl> - Date: Mon, 6 Oct 2003 05:55:21 -0700 - Message-ID: <20031006125521.GA26446@ucan.foad.org> + (I've left out the PREFIX part for now) - [ 21412] - Fix broken link in perltodo.pod. + [ 21708] + Subject: [PATCH 5.8.2 @21574] make install not installing fully + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Tue, 4 Nov 2003 20:07:25 -0800 + Message-ID: <20031105040725.GA2629@math.berkeley.edu> - [ 21417] - Update perlfunc/require to describe NXDOMAIN caching... er, you - know what I mean. + [ 21723] + Include "SCCS" in the list of directory names that should + be ignored by installperl. - [ 21431] - Document the behaviour of filetest operators regarding parentheses. - This fixes bug #24127 (by documenting it as a feature.) + [ 21739] + Subject: Re: [perl #24493] install.html not working + From: Slaven Rezic <slaven@rezic.de> + Date: 16 Nov 2003 20:52:29 +0100 + Message-ID: <87d6bsw0oy.fsf@vran.herceg.de> - [ 21435] - Make everyone stop posting to p5p about 0e0. + [ 21740] + Install instmodsh and xsubpp in bin/ along the other utilities. - [ 21437] - Minor nit in perlrun, spotted by Art Haas. + [ 21741] + Complement of change #21740 for Windows. + (I have the feeling that it's already subtly broken on VMS) + Branch: maint-5.8/perl + +> utils/instmodsh.PL utils/xsubpp.PL + !> MANIFEST Makefile.SH installhtml installperl os2/Makefile.SHs + !> utils.lst utils/Makefile win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 21776] By: nicholas on 2003/11/22 22:48:49 + Log: Integrate: + [ 21663] + Subject: Re: Smoke [5.9.0] 21474 FAIL(F) darwin 6.8 (darwin/1 cpu) + From: Slaven Rezic <slaven@rezic.de> + Date: 20 Oct 2003 22:39:28 +0200 + Message-Id: <87oewbiqyn.fsf@vran.herceg.de> Branch: maint-5.8/perl - ! pod/perlrun.pod pod/perlsyn.pod - !> autodoc.pl pod/perlapi.pod pod/perlfunc.pod pod/perlop.pod - !> pod/perlretut.pod pod/perlsub.pod pod/perltodo.pod - !> pod/splitpod + !> lib/filetest.t ____________________________________________________________________________ -[ 21478] By: nicholas on 2003/10/18 13:40:08 +[ 21775] By: nicholas on 2003/11/22 22:35:25 Log: Integrate: - [ 21420] - Minor tweaks to pod/perlsyn.pod (as suggested by Yves Orton) + [ 21732] + Subject: [PATCH] configpm, our $summary : unique + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Sat, 15 Nov 2003 22:18:32 +0100 + Message-Id: <p05111b03bbdc478d10cb@[192.168.56.3]> + (plus comments) - [ 21421] - Subject: Re: [PATCH] perlop.pod Revamp - revision 4 - From: schwern@pobox.com - Date: Tue, 7 Oct 2003 20:39:36 -0700 - Message-Id: <20031007203936.X4301@ttul.org> + [ 21733] + Subject: [PATCH] Re:ext/threads/t/problem.t (was: Problems with mod_perl 1.12 (?) and ActivePerl 5.8.1) + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Sat, 15 Nov 2003 23:22:16 +0100 + Message-Id: <p05111b04bbdc49076950@[192.168.56.3]> - (Originally from Shlomi Fish. Applied with tweaks.) + [ 21752] + Fix bug [perl #24508] Wrong assignment in nested assignment + together with subroutine call + Apparently concat still doesn't deal correctly with lexicals + in all cases. Disable the whole TARGET_MY optimisation for it. + (and remove the corresponding code from the peephole optimiser.) + Branch: maint-5.8/perl + ! opcode.h + !> configpm ext/threads/t/problems.t op.c opcode.pl t/op/concat.t +____________________________________________________________________________ +[ 21763] By: nicholas on 2003/11/21 21:38:15 + Log: Test all permuations of utf8 flags on hashes and keys + Branch: maint-5.8/perl + ! ext/XS/APItest/t/hash.t +____________________________________________________________________________ +[ 21762] By: nicholas on 2003/11/21 20:41:03 + Log: Refactor hash API tests (prior to some additions) + Branch: maint-5.8/perl + ! ext/XS/APItest/t/hash.t +____________________________________________________________________________ +[ 21761] By: nicholas on 2003/11/21 20:20:04 + Log: Integrate: + [ 21742] + Whoops. We weren't actually testing hv_store_ent + We are now. Plus test hv_store for an initially empty hash. + Branch: maint-5.8/perl + !> ext/XS/APItest/APItest.xs ext/XS/APItest/t/hash.t +____________________________________________________________________________ +[ 21759] By: nicholas on 2003/11/20 22:17:24 + Log: perforce-- # Can't integrate a brange and an edit in one shot - [ 21422] - "Are implicit undefs true?" asks Gisle. + mop up the file it failed on. - [ 21423] - Subject: [PATCH pod/perlrun.pod] Layout & POD nit. - From: Abigail <abigail@abigail.nl> - Date: Wed, 8 Oct 2003 03:50:49 -0700 - Message-Id: <20031008105049.GA15770@ucan.foad.org> + Integrate: + [ 21735] + utf8 keys now work for tied hashes via hv_fetch, hv_store, hv_delete + (pp functions use the _ent variants, and as the implementation is + duplicated, these bugs aren't tested, and aren't noticed) Branch: maint-5.8/perl - ! pod/perlop.pod pod/perlsyn.pod - !> pod/perliol.pod + !> ext/XS/APItest/t/hash.t ____________________________________________________________________________ -[ 21477] By: nicholas on 2003/10/18 13:22:15 +[ 21757] By: nicholas on 2003/11/20 19:23:15 Log: Integrate: - [ 21384] - Nit to the maintainers list by SADAHIRO Tomoyuki + [ 21756] + Subject: [PATCH] promote hv_clear_placeholders to perl API + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Thu, 20 Nov 2003 10:34:30 +0000 + Message-ID: <3FBC98B6.6090909@sun.com> + Branch: maint-5.8/perl + !> embed.fnc embed.h global.sym hv.c pod/perlapi.pod proto.h + !> universal.c +____________________________________________________________________________ +[ 21749] By: nicholas on 2003/11/19 20:08:42 + Log: Integrate: + [ 21748] + Subject: [PATCH] clear of empty locked hash SEGVs + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Wed, 19 Nov 2003 14:39:03 +0000 + Message-ID: <3FBB8087.20206@sun.com> + Branch: maint-5.8/perl + !> hv.c lib/Hash/Util.t +____________________________________________________________________________ +[ 21745] By: nicholas on 2003/11/19 18:42:14 + Log: Integrate: + [ 21743] + Restore errno after having read $^E (like for $!) + to preserve errno from unfortunate side-effects. + Branch: maint-5.8/perl + !> mg.c +____________________________________________________________________________ +[ 21738] By: nicholas on 2003/11/16 21:49:45 + Log: Integrate: + [ 21737] + Ooops. left an XXX comment in, and worse still it's a // comment + Branch: maint-5.8/perl + !> hv.c +____________________________________________________________________________ +[ 21736] By: nicholas on 2003/11/16 21:27:24 + Log: Integrate: + [ 21734] + Accessing unicode keys in tie hashes via hv_exists was broken. + (pp_exists uses hv_exists_ent, which isn't broken) + I expect an equivalent bug in hv_delete - [ 21408] - Add a new option --check to Porting/Maintainers, - to check for files who are listed for several maintainers. + [ 21735] + utf8 keys now work for tied hashes via hv_fetch, hv_store, hv_delete + (pp functions use the _ent variants, and as the implementation is + duplicated, these bugs aren't tested, and aren't noticed) + Branch: maint-5.8/perl + +> ext/XS/APItest/t/hash.t + !> MANIFEST ext/XS/APItest/APItest.pm ext/XS/APItest/APItest.xs + !> ext/XS/APItest/MANIFEST hv.c +____________________________________________________________________________ +[ 21731] By: nicholas on 2003/11/15 22:25:53 + Log: Integrate: + [ 21712] + Enable hints to create call-back units that can act when + a specific variable is *not* set (like -Uuselargefiles) - [ 21413] - Fixes in the modules maintainers list. + [ 21713] + Simplified the reading Branch: maint-5.8/perl - !> Porting/Maintainers.pl Porting/Maintainers.pm + !> Configure hints/README.hints hints/solaris_2.sh ____________________________________________________________________________ -[ 21476] By: nicholas on 2003/10/18 13:14:40 +[ 21730] By: nicholas on 2003/11/15 14:42:58 Log: Integrate: - [ 21391] - Useless "local $_" in a perlfaq3 example + [ 21728] + Update perlhist with 5.6.2. + Branch: maint-5.8/perl + !> pod/perlhist.pod +____________________________________________________________________________ +[ 21721] By: nicholas on 2003/11/13 21:25:56 + Log: Integrate: + [ 21673] + Subject: [PATCH] Be sure to use -fPIC not -fpic on Linux/SPARC + From: Andy Dougherty <doughera@lafayette.edu> + Date: Wed, 5 Nov 2003 17:19:03 -0500 (EST) + Message-ID: <Pine.SOL.4.53.0311051715140.24878@maxwell.phys.lafayette.edu> + Branch: maint-5.8/perl + !> hints/linux.sh +____________________________________________________________________________ +[ 21720] By: nicholas on 2003/11/13 21:07:58 + Log: Integrate: + [ 21677] + Subject: [PATCH 5.8.2 @21574] OS/2 docu + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Thu, 6 Nov 2003 23:26:18 -0800 + Message-ID: <20031107072618.GA4370@math.berkeley.edu> - [ 21454] - PerlFAQ sync. (only actual changes) + [ 21687] + Subject: [PATCH 5.6.2-RC1 pod/perlhist.pod] Updated. + From: Abigail <abigail@abigail.nl> + Date: Sat, 8 Nov 2003 18:51:30 +0100 + Message-Id: <20031108175130.GA22273@abigail.nl> - [ 21456] - Perlfaq1 : take notice that 5.8.1 is now released. + [ 21691] + Update the list of pumpkings in perlhist.pod. Branch: maint-5.8/perl - !> pod/perlfaq1.pod pod/perlfaq3.pod pod/perlfaq4.pod + !> os2/Changes pod/perlhist.pod ____________________________________________________________________________ -[ 21475] By: nicholas on 2003/10/17 21:09:13 +[ 21719] By: nicholas on 2003/11/13 20:59:26 Log: Integrate: - [ 21446] - Duplicate 19423 (pathological hashes too easy) into hv_store_ent - (the routine used by perl level HV operations) + [ 21718] + Subject: Re: Empty subroutine as object method segfaults in 5.8.2 (sometimes) + From: Enache Adrian <enache@rdslink.ro> + Date: Tue, 11 Nov 2003 15:25:29 +0200 + Message-ID: <20031111132529.GB1271@ratsnest.hole> + Branch: maint-5.8/perl + ! op.c +____________________________________________________________________________ +[ 21717] By: nicholas on 2003/11/13 20:29:04 + Log: Integrate: + [ 21674] + Subject: [PATCH blead] Re: [perl #24248] taint propagation regression, + tests fail to spot this + From: Rick Delaney <rick@bort.ca> + Date: Wed, 5 Nov 2003 23:02:41 -0500 + Message-Id: <20031105230241.D13585@biff.bort.ca> + + [ 21676] + bugid #24407: numeric key for shared hash got stringified using + wrong interpreter, and thus got malloced into the wrong thread + memory pool + + [ 21694] + Subject: [PATCH 5.8.2 @21574] sprintf() painfully slow + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Mon, 3 Nov 2003 20:27:39 -0800 + Message-ID: <20031104042739.GA1697@math.berkeley.edu> - [ 21469] - Duplicate 19423 (pathological hashes too easy) into share_hek_flags - (as suggested by Jan Dubois) + Subject: Re: [PATCH 5.8.2 @21574] sprintf() painfully slow + From: Ilya Zakharevich <nospam-abuse@ilyaz.org> + Date: Mon, 3 Nov 2003 20:57:48 -0800 + Message-ID: <20031104045748.GA1826@math.berkeley.edu> - [ 21471] - Plan C for foiling the algorithmic complexity attack - (based on Chip's plan A (binary compatibility with 5.8.0 and 5.8.1), - Chip's plan B (do something new inside the hv functions) - and introspective sort) - Provides infrastructure for hashes to change their hash function - if necessary, and code in hsplit to detect pathalogical data and - instigate a random rehashing. - Needs refinement. Let's see how much smoke it creates. + [ 21714] + Fix bug [perl #24380] : assigning to a hash in list + or scalar context yielded a wrong value if the list + contained duplicated keys for the hash. This is fixed + by counting the number of duplicate keys and trimming + the stack by the corresponding number of items. + Branch: maint-5.8/perl + ! t/op/taint.t + !> ext/threads/shared/shared.xs ext/threads/shared/t/hv_simple.t + !> pp_ctl.c pp_hot.c sv.c t/op/hashassign.t +____________________________________________________________________________ +[ 21715] By: nicholas on 2003/11/13 19:57:33 + Log: Integrate: + [ 21662] + Subject: Re: 'make minitest' fails for op/cproto and op/pat + From: Michael G Schwern <schwern@pobox.com> + Date: Wed, 5 Nov 2003 06:26:36 -0800 + Message-Id: <20031105142635.GA22761@localhost.comcast.net> + + [ 21671] + Subject: Re: [perl #24398] Benchmark.pm cmpthese segfault + From: Stas Bekman <stas@stason.org> + Date: Wed, 05 Nov 2003 00:50:25 -0800 + Message-ID: <3FA8B9D1.2020806@stason.org> - [ 21474] - Plan C rough edge smoothing - forgot to turn on the "has key flags" - flag on the hash when rehashing. Can turn off the "rehasing" flag - if the hash is cleared + [ 21672] + Subject: [patch t/op/hash.t] extending the hash attack test + From: Stas Bekman <stas@stason.org> + Date: Tue, 04 Nov 2003 14:33:09 -0800 + Message-ID: <3FA82925.7020703@stason.org> Branch: maint-5.8/perl - ! hv.c - !> embedvar.h hv.h intrpvar.h perl.c perlapi.h sv.c sv.h util.c + !> lib/Benchmark.pm t/op/cproto.t t/op/hash.t ____________________________________________________________________________ -[ 21395] By: nicholas on 2003/10/01 21:09:11 +[ 21704] By: nicholas on 2003/11/11 20:48:54 Log: Integrate: - [ 21387] - Subject: [PATCH] perl-5.8.1 hints/powerux.sh, ext/Sys/Syslog/t/syslog.t - From: Tom Horsley <Tom.Horsley@ccur.com> - Date: Mon, 29 Sep 2003 13:00:09 GMT - Message-Id: <200309291300.NAA23856@amber2.ccur.com> + [ 21693] + Subject: [PATCH-5.8.2 for WinCE] must copy changes from win32/makeifle.mk to wince/makefile.ce + From: Vadim Konovalov <konovalo@mail.wplus.net> + Date: Sun, 9 Nov 2003 13:31:59 +0300 + Message-ID: <93187393948.20031109133159@mail.wplus.net> Branch: maint-5.8/perl - !> ext/Sys/Syslog/t/syslog.t hints/powerux.sh + !> wince/Makefile.ce ____________________________________________________________________________ -[ 21393] By: nicholas on 2003/09/30 20:52:55 - Log: Disarm the maint branch. - (Put the MAINTfoo local patch back in patchlevel.h following the - successful escape, er release, of 5.8.1) +[ 21703] By: nicholas on 2003/11/11 20:21:13 + Log: Update changes Branch: maint-5.8/perl - ! Changes patchlevel.h + ! Changes Changes5.8.2 ____________________________________________________________________________ -[ 21379] By: chip on 2003/09/25 18:10:01 - Log: Relocate the mention of safe signals with POSIX::SigAction. +[ 21701] By: nicholas on 2003/11/11 20:08:50 + Log: Remove carriage returns (which had slipped in) Branch: maint-5.8/perl - ! pod/perl581delta.pod + ! win32/Makefile win32/makefile.mk wince/compile-all.bat + ! wince/registry.bat +____________________________________________________________________________ +[ 21700] By: nicholas on 2003/11/11 19:28:07 + Log: perldelta changeover + Branch: maint-5.8/perl + ! pod/perldelta.pod ____________________________________________________________________________ -[ 21378] By: jhi on 2003/09/25 12:42:00 - Log: perldelta turnover. +[ 21699] By: nicholas on 2003/11/11 19:21:20 + Log: Disarm the maint branch Branch: maint-5.8/perl - + pod/perl581delta.pod - ! MANIFEST pod.lst pod/perl.pod pod/perldelta.pod - ! pod/perltoc.pod vms/descrip_mms.template win32/pod.mak + +> Changes5.8.2 pod/perl582delta.pod + ! Changes MANIFEST patchlevel.h diff --git a/gnu/usr.bin/perl/Configure b/gnu/usr.bin/perl/Configure index 50d8f2340f7..e703785a1a6 100644 --- a/gnu/usr.bin/perl/Configure +++ b/gnu/usr.bin/perl/Configure @@ -18,9 +18,9 @@ # you may fetch it yourself from your nearest archive site.) # -# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ +# $Id: Configure,v 1.12 2003/12/03 03:02:18 millert Exp $ # -# Generated on Thu Sep 18 09:10:02 EEST 2003 [metaconfig 3.0 PL70] +# Generated on Fri Dec 5 12:57:38 MET 2003 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <<EOF @@ -1209,6 +1209,17 @@ elif test -d c:/. -o -n "$is_os2" ; then fi i_whoami='' +ccname='' +ccversion='' +perllibs='' +: set useposix=false in your hint file to disable the POSIX extension. +useposix=true +: set useopcode=false in your hint file to disable the Opcode extension. +useopcode=true +: Trailing extension. Override this in a hint file, if needed. +: Extra object files, if any, needed on this platform. +archobjs='' +archname='' : Possible local include directories to search. : Set locincpth to "" in a hint file to defeat local include searches. locincpth="/usr/local/include /opt/local/include /usr/gnu/include" @@ -1217,12 +1228,6 @@ locincpth="$locincpth /opt/gnu/include /usr/GNU/include /opt/GNU/include" : no include file wanted by default inclwanted='' -siteman1dir='' -siteman3dir='' -sitescript='' -: Trailing extension. Override this in a hint file, if needed. -: Extra object files, if any, needed on this platform. -archobjs='' groupstype='' libnames='' : change the next line if compiling for Xenix/286 on Xenix/386 @@ -1246,25 +1251,20 @@ plibpth='' libswanted='' : some systems want to use only the non-versioned libso:s ignore_versioned_solibs='' -: full support for void wanted by default -defvoidused=15 - -ccname='' -ccversion='' -perllibs='' -: set useposix=false in your hint file to disable the POSIX extension. -useposix=true -: set useopcode=false in your hint file to disable the Opcode extension. -useopcode=true +siteman1dir='' +siteman3dir='' +sitescript='' archname64='' ccflags_uselargefiles='' ldflags_uselargefiles='' libswanted_uselargefiles='' : set usemultiplicity on the Configure command line to enable multiplicity. : set usesocks on the Configure command line to enable socks. -archname='' : set usethreads on the Configure command line to enable threads. usereentrant='undef' +: full support for void wanted by default +defvoidused=15 + : List of libraries we want. : If anyone needs extra -lxxx, put those in a hint file. libswanted="sfio socket bind inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun" @@ -3673,22 +3673,22 @@ set d_oldpthreads eval $setvar -case "$usethreads" in -"$define"|true|[yY]*) : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a threading perl is to be built, : we may need to set or change some other defaults. - if $test -f usethreads.cbu; then - echo "Your platform has some specific hints for threaded builds, using them..." - . ./usethreads.cbu - else +if $test -f usethreads.cbu; then + echo "Your platform has some specific hints regarding threaded builds, using them..." + . ./usethreads.cbu +else + case "$usethreads" in + "$define"|true|[yY]*) $cat <<EOM -(Your platform doesn't have any specific hints for threaded builds. +(Your platform does not have any specific hints for threaded builds. Assuming POSIX threads, then.) EOM - fi ;; -esac + esac +fi cat <<EOM @@ -4546,21 +4546,21 @@ case "$uselongdouble" in true|[yY]*) uselongdouble="$define" ;; esac -case "$uselongdouble" in -$define) : Look for a hint-file generated 'call-back-unit'. If the : user has specified that long doubles should be used, : we may need to set or change some other defaults. - if $test -f uselongdouble.cbu; then - echo "Your platform has some specific hints for long doubles, using them..." - . ./uselongdouble.cbu - else +if $test -f uselongdouble.cbu; then + echo "Your platform has some specific hints regarding long doubles, using them..." + . ./uselongdouble.cbu +else + case "$uselongdouble" in + $define) $cat <<EOM -(Your platform doesn't have any specific hints for long doubles.) +(Your platform does not have any specific hints for long doubles.) EOM - fi ;; -esac + esac +fi : Looking for optional libraries echo " " @@ -5447,15 +5447,15 @@ EOM ;; esac -case "$use64bitint" in -"$define"|true|[yY]*) : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a 64-bit perl is to be built, : we may need to set or change some other defaults. if $test -f use64bitint.cbu; then - echo "Your platform has some specific hints for 64-bit integers, using them..." + echo "Your platform has some specific hints regarding 64-bit integers, using them..." . ./use64bitint.cbu fi +case "$use64bitint" in +"$define"|true|[yY]*) case "$longsize" in 4) case "$archname64" in '') archname64=64int ;; @@ -5465,15 +5465,15 @@ case "$use64bitint" in ;; esac -case "$use64bitall" in -"$define"|true|[yY]*) : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a maximally 64-bit perl is to be built, : we may need to set or change some other defaults. if $test -f use64bitall.cbu; then - echo "Your platform has some specific hints for 64-bit builds, using them..." + echo "Your platform has some specific hints regarding 64-bit builds, using them..." . ./use64bitall.cbu fi +case "$use64bitall" in +"$define"|true|[yY]*) case "$longsize" in 4) case "$archname64" in ''|64int) archname64=64all ;; @@ -8852,14 +8852,16 @@ EOM esac set uselargefiles eval $setvar -case "$uselargefiles" in -"$define") : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a large files perl is to be built, : we may need to set or change some other defaults. +if $test -f uselargefiles.cbu; then + echo "Your platform has some specific hints regarding large file builds, using them..." + . ./uselargefiles.cbu +fi +case "$uselargefiles" in +"$define") if $test -f uselargefiles.cbu; then - echo "Your platform has some specific hints for large file builds, using them..." - . ./uselargefiles.cbu echo " " echo "Rechecking to see how big your file offsets are..." >&4 $cat >try.c <<EOCP @@ -16953,10 +16955,10 @@ int main() { buf[1] = 0; buf[2] = 0; buf[3] = 1; + buf[4] = 0; buf[5] = 0; buf[6] = 0; - buf[7] = 0; - buf[8] = 1; + buf[7] = 1; for (i = 0; i < 4; i++) { up = (U32*)(buf + i); diff --git a/gnu/usr.bin/perl/Cross/Makefile b/gnu/usr.bin/perl/Cross/Makefile index 4e93f98644b..bef9f385b6e 100644 --- a/gnu/usr.bin/perl/Cross/Makefile +++ b/gnu/usr.bin/perl/Cross/Makefile @@ -1,8 +1,8 @@ ## Toplevel Makefile for cross-compilation of perl # -## $Id: Makefile,v 1.4 2003/09/05 00:48:19 red Exp red $ +## $Id: Makefile,v 1.2 2003/12/03 03:02:24 millert Exp $ -export TOPDIR?=${shell pwd} +export TOPDIR=${shell pwd} include $(TOPDIR)/config export CFLAGS export SYS=$(ARCH)-$(OS) @@ -39,9 +39,15 @@ gen_patch: diff -Bbur ../installperl installperl > installperl.patch patch: - cd .. ; patch -p1 < Cross/Makefile.SH.patch - cd .. ; patch -p1 < Cross/installperl.patch ; mv installperl installperl-patched - cd .. ; sed -e 's/XXSTRIPXX/$(SYS)/' installperl-patched > installperl + cd .. ; if [ ! -e ./CROSS_PATCHED ] ; then \ + patch -p1 < Cross/Makefile.SH.patch; \ + patch -p1 < Cross/installperl.patch ; mv installperl installperl-patched; \ + sed -e 's/XXSTRIPXX/$(SYS)/' installperl-patched > installperl; \ + touch CROSS_PATCHED ; fi + +dry_patch: + cd .. ; patch --dry-run -p1 < Cross/Makefile.SH.patch; \ + patch --dry-run -p1 < Cross/installperl.patch; \ perl: @echo Perl cross-build directory is $(TOPDIR) diff --git a/gnu/usr.bin/perl/Cross/README b/gnu/usr.bin/perl/Cross/README index 79d2b7d1756..51da64964ee 100644 --- a/gnu/usr.bin/perl/Cross/README +++ b/gnu/usr.bin/perl/Cross/README @@ -19,7 +19,7 @@ You need a working and tested cross-compiler for your build and target combination. The binary directory must be in your path. -1) You should be reading me (README) in perl-5.8.2/Cross +1) You should be reading me (README) in perl-5.8.3/Cross 2) Make sure you are in the Cross directory. @@ -68,6 +68,7 @@ Should you wish to produce optimised binaries for different architectures you can add the appropriate compiler flags to the Makefile in a new ifeq ($(ARCH),...) ... endif block. + Please refer to your cross-compiler documentation for details. @@ -83,4 +84,4 @@ References ---------- Redvers Davies <red@criticalintegration.com> Open Zaurus http://www.openzaurus.org/ -Perl OZ Packages http://www.openzaurus.org/official/testing/feed/ +Perl OZ Packages http://www.criticalintegration.com/perl-oz/ diff --git a/gnu/usr.bin/perl/MANIFEST b/gnu/usr.bin/perl/MANIFEST index 5229b73756d..bba2f042a4d 100644 --- a/gnu/usr.bin/perl/MANIFEST +++ b/gnu/usr.bin/perl/MANIFEST @@ -20,6 +20,7 @@ Changes5.005 Differences between 5.004 and 5.005 Changes5.6 Differences between 5.005 and 5.6 Changes5.8 Differences between 5.6.0 and 5.8.0 (and maint-5.6) Changes5.8.1 Differences between 5.8.0 and 5.8.1 +Changes5.8.2 Differences between 5.8.1 and 5.8.2 config_h.SH Produces config.h configpm Produces lib/Config.pm Configure Portability tool @@ -130,6 +131,7 @@ ext/ByteLoader/byterun.c Runtime support for bytecode loader ext/ByteLoader/byterun.h Header for byterun.c ext/ByteLoader/hints/sunos.pl Hints for named architecture ext/ByteLoader/Makefile.PL Bytecode loader makefile writer +ext/Cwd/Changes Cwd extension Changelog ext/Cwd/Cwd.xs Cwd extension external subroutines ext/Cwd/Makefile.PL Cwd extension makefile maker ext/Cwd/t/cwd.t See if Cwd works @@ -188,6 +190,7 @@ ext/Digest/MD5/MD5.xs Digest::MD5 extension ext/Digest/MD5/README Digest::MD5 extension Readme ext/Digest/MD5/t/align.t See if Digest::MD5 extension works ext/Digest/MD5/t/badfile.t See if Digest::MD5 extension works +ext/Digest/MD5/t/bits.t See if Digest::MD5 extension works ext/Digest/MD5/t/clone.t See if Digest::MD5 extension works ext/Digest/MD5/t/files.t See if Digest::MD5 extension works ext/Digest/MD5/t/md5-aaa.t See if Digest::MD5 extension works @@ -714,6 +717,7 @@ ext/threads/shared/t/no_share.t Tests for disabled share on variables. ext/threads/shared/t/shared_attr.t Test :shared attribute ext/threads/shared/t/sv_refs.t thread shared variables ext/threads/shared/t/sv_simple.t thread shared variables +ext/threads/shared/t/wait.t Test cond_wait and cond_timedwait ext/threads/shared/typemap thread::shared types ext/threads/t/basic.t ithreads ext/threads/t/end.t Test end functions @@ -761,8 +765,11 @@ ext/Unicode/Normalize/README Unicode::Normalize ext/Unicode/Normalize/t/fcdc.t Unicode::Normalize ext/Unicode/Normalize/t/form.t Unicode::Normalize ext/Unicode/Normalize/t/func.t Unicode::Normalize +ext/Unicode/Normalize/t/illegal.t Unicode::Normalize ext/Unicode/Normalize/t/norm.t Unicode::Normalize +ext/Unicode/Normalize/t/null.t Unicode::Normalize ext/Unicode/Normalize/t/proto.t Unicode::Normalize +ext/Unicode/Normalize/t/short.t Unicode::Normalize ext/Unicode/Normalize/t/split.t Unicode::Normalize ext/Unicode/Normalize/t/test.t Unicode::Normalize ext/util/make_ext Used by Makefile to execute extension Makefiles @@ -771,6 +778,7 @@ ext/XS/APItest/APItest.xs XS::APItest extension ext/XS/APItest/Makefile.PL XS::APItest extension ext/XS/APItest/MANIFEST XS::APItest extension ext/XS/APItest/README XS::APItest extension +ext/XS/APItest/t/hash.t XS::APItest extension ext/XS/APItest/t/printf.t XS::APItest extension ext/XS/Typemap/Makefile.PL XS::Typemap extension ext/XS/Typemap/README XS::Typemap extension @@ -1077,8 +1085,10 @@ lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm lib/Devel/SelfStubber.t See if Devel::SelfStubber works lib/diagnostics.pm Print verbose diagnostics lib/diagnostics.t See if diagnostics.pm works +lib/Digest/base.pm Digest extensions lib/Digest.pm Digest extensions -lib/Digest.t See if Digest extensions work +lib/Digest/t/base.t See if Digest extensions work +lib/Digest/t/digest.t See if Digest extensions work lib/DirHandle.pm like FileHandle only for directories lib/DirHandle.t See if DirHandle works lib/dotsh.pl Code to "dot" in a shell script @@ -1315,9 +1325,10 @@ lib/locale.t See if locale support works lib/look.pl A "look" equivalent lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigFloat/Trace.pm bignum tracing +lib/Math/BigInt/CalcEmu.pm Pure Perl module to support Math::BigInt lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt lib/Math/BigInt.pm An arbitrary precision integer arithmetic package -lib/Math/BigInt/Scalar.pm Pure Perl module to support Math::BigInt +lib/Math/BigInt/t/alias.inc Support for BigInt tests 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 @@ -1328,12 +1339,17 @@ lib/Math/BigInt/t/bigintpm.inc Shared tests for bigintpm.t and sub_mbi.t lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works lib/Math/BigInt/t/bigints.t See if BigInt.pm works lib/Math/BigInt/t/biglog.t Test the log function +lib/Math/BigInt/t/bigroot.t Test the broot function lib/Math/BigInt/t/calling.t Test calling conventions lib/Math/BigInt/t/config.t Test Math::BigInt->config() lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant +lib/Math/BigInt/t/const_mbf.t Test Math::BigInt lib/Math/BigInt/t/downgrade.t Test if use Math::BigInt(); under downgrade works +lib/Math/BigInt/t/fallback.t Test Math::BigInt lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling lib/Math/BigInt/t/isa.t Test for Math::BigInt inheritance +lib/Math/BigInt/t/mbf_ali.t Tests for BigFloat +lib/Math/BigInt/t/mbi_ali.t Tests for BigInt lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fallback, round_mode tests lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precision and fallback, round_mode lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly @@ -1345,6 +1361,7 @@ lib/Math/BigInt/t/req_mbfi.t test: require Math::BigFloat; ->binf(); lib/Math/BigInt/t/req_mbfn.t test: require Math::BigFloat; ->new(); lib/Math/BigInt/t/req_mbfw.t require Math::BigFloat; import ( with => ); lib/Math/BigInt/t/require.t Test if require Math::BigInt works +lib/Math/BigInt/t/sub_ali.t Tests for aliases in BigInt subclasses lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc @@ -1579,6 +1596,7 @@ lib/Term/ReadLine.pm Stub readline library lib/Term/ReadLine.t See if Term::ReadLine works lib/Test/Builder.pm For writing new test libraries lib/Test/Harness/Assert.pm Test::Harness::Assert (internal use only) +lib/Test/Harness/bin/prove The prove harness utility lib/Test/Harness/Changes Test::Harness lib/Test/Harness/Iterator.pm Test::Harness::Iterator (internal use only) lib/Test/Harness.pm A test harness @@ -1587,9 +1605,11 @@ lib/Test/Harness/t/00compile.t Test::Harness test lib/Test/Harness/t/assert.t Test::Harness::Assert test lib/Test/Harness/t/base.t Test::Harness test lib/Test/Harness/t/callback.t Test::Harness test +lib/Test/Harness/t/inc_taint.t Test::Harness test lib/Test/Harness/t/nonumbers.t Test::Harness test lib/Test/Harness/t/ok.t Test::Harness test lib/Test/Harness/t/pod.t Test::Harness test +lib/Test/Harness/t/prove-switches.t Test::Harness::Straps test lib/Test/Harness/t/strap-analyze.t Test::Harness::Straps test lib/Test/Harness/t/strap.t Test::Harness::Straps test lib/Test/Harness/t/test-harness.t Test::Harness test @@ -1739,15 +1759,20 @@ lib/Unicode/Collate/Changes Unicode::Collate lib/Unicode/Collate/keys.txt Unicode::Collate lib/Unicode/Collate.pm Unicode::Collate lib/Unicode/Collate/README Unicode::Collate +lib/Unicode/Collate/t/altern.t Unicode::Collate lib/Unicode/Collate/t/contract.t Unicode::Collate lib/Unicode/Collate/t/hangtype.t Unicode::Collate lib/Unicode/Collate/t/hangul.t Unicode::Collate +lib/Unicode/Collate/t/illegalp.t Unicode::Collate +lib/Unicode/Collate/t/illegal.t Unicode::Collate lib/Unicode/Collate/t/index.t Unicode::Collate lib/Unicode/Collate/t/normal.t Unicode::Collate +lib/Unicode/Collate/t/rearrang.t Unicode::Collate lib/Unicode/Collate/t/test.t Unicode::Collate lib/Unicode/Collate/t/trailwt.t Unicode::Collate lib/Unicode/Collate/t/variable.t Unicode::Collate lib/Unicode/Collate/t/version.t Unicode::Collate +lib/Unicode/Collate/t/view.t Unicode::Collate lib/Unicode/README Explanation what happened to lib/unicode. lib/Unicode/UCD.pm Unicode character database lib/Unicode/UCD.t See if Unicode character database works @@ -2317,6 +2342,8 @@ pod/perl571delta.pod Perl changes in version 5.7.1 pod/perl572delta.pod Perl changes in version 5.7.2 pod/perl573delta.pod Perl changes in version 5.7.3 pod/perl581delta.pod Perl changes in version 5.8.1 +pod/perl582delta.pod Perl changes in version 5.8.2 +pod/perl583delta.pod Perl changes in version 5.8.3 pod/perl58delta.pod Perl changes in version 5.8.0 pod/perlapio.pod Perl internal IO abstraction interface pod/perlapi.pod Perl API listing (autogenerated) @@ -2333,7 +2360,6 @@ pod/perldbmfilter.pod Perl DBM filters pod/perldebguts.pod Perl debugging guts and tips pod/perldebtut.pod Perl debugging tutorial pod/perldebug.pod Perl debugging -pod/perldelta.pod Perl changes since previous version pod/perldiag.pod Perl diagnostic messages pod/perldoc.pod Look up Perl documentation in Pod format pod/perldsc.pod Perl data structures intro @@ -2572,6 +2598,7 @@ t/lib/1_compile.t See if the various libraries and extensions compile t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t t/lib/Devel/switchd.pm Module for t/run/switchd.t +t/lib/Dev/Null.pm Module for testing Test::Harness t/lib/dprof/test1_t Perl code profiler tests t/lib/dprof/test1_v Perl code profiler tests t/lib/dprof/test2_t Perl code profiler tests @@ -2602,6 +2629,7 @@ t/lib/MakeMaker/Test/Setup/Recurs.pm MakeMaker test utilities t/lib/MakeMaker/Test/Utils.pm MakeMaker test utilities t/lib/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test t/lib/Math/BigInt/BareCalc.pm Bigint's simulation of Calc +t/lib/Math/BigInt/Scalar.pm Pure Perl module to support Math::BigInt t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test t/lib/Math/BigRat/Test.pm Math::BigRat test helper t/lib/sample-tests/bailout Test data for Test::Harness @@ -2614,6 +2642,7 @@ t/lib/sample-tests/die_last_minute Test data for Test::Harness t/lib/sample-tests/duplicates Test data for Test::Harness t/lib/sample-tests/head_end Test data for Test::Harness t/lib/sample-tests/head_fail Test data for Test::Harness +t/lib/sample-tests/inc_taint Test data for Test::Harness t/lib/sample-tests/lone_not_bug Test data for Test::Harness t/lib/sample-tests/no_nums Test data for Test::Harness t/lib/sample-tests/no_output Test data for Test::Harness @@ -2628,6 +2657,7 @@ t/lib/sample-tests/skipall_nomsg Test data for Test::Harness t/lib/sample-tests/skip_nomsg Test data for Test::Harness t/lib/sample-tests/switches Test data for Test::Harness t/lib/sample-tests/taint Test data for Test::Harness +t/lib/sample-tests/taint_warn Test data for Test::Harness t/lib/sample-tests/todo Test data for Test::Harness t/lib/sample-tests/todo_inline Test data for Test::Harness t/lib/sample-tests/too_many Test data for Test::Harness @@ -2734,8 +2764,8 @@ t/op/grent.t See if getgr*() functions work t/op/grep.t See if grep() and map() work t/op/groups.t See if $( works t/op/gv.t See if typeglobs work -t/op/hash.t See if the complexity attackers are repelled t/op/hashassign.t See if hash assignments work +t/op/hash.t See if the complexity attackers are repelled t/op/hashwarn.t See if warnings for bad hash assignments work t/op/inccode.t See if coderefs work in @INC t/op/inc.t See if inc/dec of integers near 32 bit limit work @@ -2789,17 +2819,18 @@ t/op/sleep.t See if sleep works t/op/sort.t See if sort works t/op/splice.t See if splice works t/op/split.t See if split works +t/op/sprintf2.t See if sprintf works t/op/sprintf.t See if sprintf works t/op/srand.t See if srand works t/op/stash.t See if %:: stashes work t/op/stat.t See if stat works t/op/study.t See if study works -t/op/sub.t See if subroutines work t/op/sub_lval.t See if lvalue subroutines work t/op/subst_amp.t See if $&-related substitution works t/op/substr.t See if substr works t/op/subst.t See if substitution works t/op/subst_wamp.t See if substitution works with $& present +t/op/sub.t See if subroutines work t/op/sysio.t See if sysread and syswrite work t/op/taint.t See if tainting works t/op/tiearray.t See if tie for arrays works @@ -2902,6 +2933,7 @@ utils/dprofpp.PL Perl code profile post-processor utils/enc2xs.PL Encode module generator utils/h2ph.PL A thing to turn C .h files into perl .ph files utils/h2xs.PL Program to make .xs files from C header files +utils/instmodsh.PL Give information about installed extensions utils/libnetcfg.PL libnet utils.lst Lists utilities bundled with Perl utils/Makefile Extract the utility scripts @@ -2911,7 +2943,9 @@ utils/perldoc.PL A simple tool to find & display perl's documentation utils/perlivp.PL installation verification procedure utils/piconv.PL iconv(1), reinvented in perl utils/pl2pm.PL A pl to pm translator +utils/prove.PL The prove harness utility utils/splain.PL Stand-alone version of diagnostics.pm +utils/xsubpp.PL External subroutine preprocessor uts/sprintf_wrap.c sprintf wrapper for UTS uts/strtol_wrap.c strtol wrapper for UTS vmesa/Makefile VM/ESA Makefile diff --git a/gnu/usr.bin/perl/Makefile.SH b/gnu/usr.bin/perl/Makefile.SH index 713b2a38395..e1a78d678b4 100644 --- a/gnu/usr.bin/perl/Makefile.SH +++ b/gnu/usr.bin/perl/Makefile.SH @@ -761,15 +761,17 @@ extra.pods: miniperl$(EXE_EXT) done -@rm -f pod/perlvms.pod -@test -f vms/perlvms.pod && cd pod && $(LNS) ../vms/perlvms.pod perlvms.pod && cd .. && echo "pod/perlvms.pod" >> extra.pods + -@rm -f pod/perldelta.pod + -@test -f pod/perl583delta.pod && cd pod && $(LNS) perl583delta.pod perldelta.pod && cd .. && echo "pod/perldelta.pod" >> extra.pods extras.make: perl$(EXE_EXT) - -@test -s extras.lst && PATH=`pwd`:${PATH} PERL5LIB=`pwd`/lib $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&make(@ARGV)' `cat extras.lst` + -@test -s extras.lst && PATH="`pwd`:${PATH}" PERL5LIB="`pwd`/lib" $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&make(@ARGV)' `cat extras.lst` extras.test: perl$(EXE_EXT) - -@test -s extras.lst && PATH=`pwd`:${PATH} PERL5LIB=`pwd`/lib $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&test(@ARGV)' `cat extras.lst` + -@test -s extras.lst && PATH="`pwd`:${PATH}" PERL5LIB="`pwd`/lib" $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&test(@ARGV)' `cat extras.lst` extras.install: perl$(EXE_EXT) - -@test -s extras.lst && PATH=`pwd`:${PATH} PERL5LIB=`pwd`/lib $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&install(@ARGV)' `cat extras.lst` + -@test -s extras.lst && PATH="`pwd`:${PATH}" PERL5LIB="`pwd`/lib" $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&install(@ARGV)' `cat extras.lst` .PHONY: install install-strip install-all install-verbose install-silent \ no-install install.perl install.man install.html @@ -778,21 +780,24 @@ META.yml: Porting/makemeta Porting/Maintainers.pl Porting/Maintainers.pm $(LDLIBPTH) ./miniperl -Ilib Porting/makemeta install-strip: - $(MAKE) STRIPFLAGS=-s install + $(MAKE) STRIPFLAGS=-s install DESTDIR="$(DESTDIR)" install install-all: - $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) DESTDIR="$(DESTDIR)" install-verbose: - $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-V + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-V DESTDIR="$(DESTDIR)" install-silent: - $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-S + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-S DESTDIR="$(DESTDIR)" no-install: - $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-n + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-n DESTDIR="$(DESTDIR)" -install.perl: all installperl +# Set this to an empty string to avoid an attempt of rebuild before install +INSTALL_DEPENDENCE = all + +install.perl: $(INSTALL_DEPENDENCE) installperl if [ -n "$(COMPILE)" ]; \ then \ cd utils; $(MAKE) compile; \ diff --git a/gnu/usr.bin/perl/Makefile.bsd-wrapper b/gnu/usr.bin/perl/Makefile.bsd-wrapper index 699da6931a1..bb0c7413373 100644 --- a/gnu/usr.bin/perl/Makefile.bsd-wrapper +++ b/gnu/usr.bin/perl/Makefile.bsd-wrapper @@ -1,6 +1,6 @@ -# $OpenBSD: Makefile.bsd-wrapper,v 1.61 2004/02/08 00:15:18 espie Exp $ +# $OpenBSD: Makefile.bsd-wrapper,v 1.62 2004/04/07 21:32:58 millert Exp $ # -# Build wrapper for Perl 5.8.2 +# Build wrapper for Perl 5.8.3 # # To build a threaded perl, uncomment this. Not stable on all platforms... @@ -68,6 +68,8 @@ MANSRCALL= perl573delta 1 pod/perl573delta.pod \ perl58delta 1 pod/perl58delta.pod \ perl581delta 1 pod/perl581delta.pod \ + perl582delta 1 pod/perl582delta.pod \ + perl583delta 1 pod/perl583delta.pod \ perlapi 1 pod/perlapi.pod \ perlapio 1 pod/perlapio.pod \ perlartistic 1 pod/perlartistic.pod \ @@ -86,7 +88,6 @@ MANSRCALL= perldebguts 1 pod/perldebguts.pod \ perldebtut 1 pod/perldebtut.pod \ perldebug 1 pod/perldebug.pod \ - perldelta 1 pod/perldelta.pod \ perldiag 1 pod/perldiag.pod \ perldoc 1 pod/perldoc.pod \ perldsc 1 pod/perldsc.pod \ @@ -137,6 +138,7 @@ MANSRCALL= perlref 1 pod/perlref.pod \ perlreftut 1 pod/perlreftut.pod \ perlrequick 1 pod/perlrequick.pod \ + perlreref 1 pod/perlreref.pod \ perlretut 1 pod/perlretut.pod \ perlrun 1 pod/perlrun.pod \ perlsec 1 pod/perlsec.pod \ @@ -166,6 +168,7 @@ MANSRCALL= pod2usage 1 pod/pod2usage \ podchecker 1 pod/podchecker \ podselect 1 pod/podselect \ + prove 1 lib/Test/Harness/bin/prove \ s2p 1 x2p/s2p \ splain 1 utils/splain \ xsubpp 1 lib/ExtUtils/xsubpp \ @@ -217,6 +220,7 @@ MANSRCALL= Devel::Peek 3p ext/Devel/Peek/Peek.pm \ Devel::SelfStubber 3p lib/Devel/SelfStubber.pm \ Digest 3p lib/Digest.pm \ + Digest::base 3p lib/Digest/base.pm \ Digest::MD5 3p ext/Digest/MD5/MD5.pm \ DirHandle 3p lib/DirHandle.pm \ Dumpvalue 3p lib/Dumpvalue.pm \ @@ -343,7 +347,7 @@ MANSRCALL= Math::BigFloat 3p lib/Math/BigFloat.pm \ Math::BigInt 3p lib/Math/BigInt.pm \ Math::BigInt::Calc 3p lib/Math/BigInt/Calc.pm \ - Math::BigInt::Scalar 3p lib/Math/BigInt/Scalar.pm \ + Math::BigInt::CalcEmu 3p lib/Math/BigInt/CalcEmu.pm \ Math::BigRat 3p lib/Math/BigRat.pm \ Math::Complex 3p lib/Math/Complex.pm \ Math::Trig 3p lib/Math/Trig.pm \ diff --git a/gnu/usr.bin/perl/Porting/config_H b/gnu/usr.bin/perl/Porting/config_H index 50d456e5514..7ba126dc8aa 100644 --- a/gnu/usr.bin/perl/Porting/config_H +++ b/gnu/usr.bin/perl/Porting/config_H @@ -7,13 +7,13 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config_h.SH. * - * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + * $Id: config_H,v 1.6 2003/12/03 03:02:25 millert Exp $ */ /* * Package name : perl5 * Source directory : . - * Configuration time: Sun Nov 2 23:55:28 GMT 2003 + * Configuration time: Wed Jan 14 15:58:57 GMT 2004 * Configured by : nick * Target system : linux bagpuss.unfortu.net 2.4.19-rmk4 #3 fri oct 25 21:57:55 bst 2002 armv4l unknown */ @@ -1338,8 +1338,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.8.2/armv4l-linux" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.8.2/armv4l-linux" /**/ +#define ARCHLIB "/usr/local/lib/perl5/5.8.3/armv4l-linux" /**/ +#define ARCHLIB_EXP "/usr/local/lib/perl5/5.8.3/armv4l-linux" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -1349,8 +1349,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "/opt/perl/bin" /**/ -#define BIN_EXP "/opt/perl/bin" /**/ +#define BIN "/usr/local/bin" /**/ +#define BIN_EXP "/usr/local/bin" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1359,7 +1359,7 @@ * for a C initialization string. See the inc_version_list entry * in Porting/Glossary for more details. */ -#define PERL_INC_VERSION_LIST 0 /**/ +#define PERL_INC_VERSION_LIST "5.8.0/armv4l-linux","5.8.0","5.7.3","5.7.2","5.7.1","5.7.0","5.6.0","5.005",0 /**/ /* INSTALL_USR_BIN_PERL: * This symbol, if defined, indicates that Perl is to be installed @@ -1377,6 +1377,18 @@ */ /*#define PERL_OTHERLIBDIRS " " / **/ +/* INSTALL_PREFIX: + * This symbol contains the "root" of installation tree for this package. + * The program should be prepared to do ~ expansion. + */ +/* INSTALL_PREFIX_EXP: + * This symbol contains the "root" of installation tree for this package + * to be used in programs that are not prepared to deal with ~ expansion + * at run-time. + */ +#define INSTALL_PREFIX "/usr/local" /**/ +#define INSTALL_PREFIX_EXP "/usr/local" /**/ + /* PRIVLIB: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's @@ -1387,8 +1399,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.8.2" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.8.2" /**/ +#define PRIVLIB "/usr/local/lib/perl5/5.8.3" /**/ +#define PRIVLIB_EXP "/usr/local/lib/perl5/5.8.3" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1405,8 +1417,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.8.2/armv4l-linux" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.8.2/armv4l-linux" /**/ +#define SITEARCH "/usr/local/lib/perl5/site_perl/5.8.3/armv4l-linux" /**/ +#define SITEARCH_EXP "/usr/local/lib/perl5/site_perl/5.8.3/armv4l-linux" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1428,9 +1440,9 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/opt/perl/lib/site_perl/5.8.2" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.8.2" /**/ -#define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ +#define SITELIB "/usr/local/lib/perl5/site_perl/5.8.3" /**/ +#define SITELIB_EXP "/usr/local/lib/perl5/site_perl/5.8.3" /**/ +#define SITELIB_STEM "/usr/local/lib/perl5/site_perl" /**/ /* PERL_VENDORARCH: * If defined, this symbol contains the name of a private library. @@ -1677,7 +1689,7 @@ #define HAS_UNAME /**/ /*#define HAS_PHOSTNAME / **/ #ifdef HAS_PHOSTNAME -#define PHOSTNAME "" /* How to get the host name */ +#define PHOSTNAME "/bin/hostname" /* How to get the host name */ #endif /* HAS_GETNETBYADDR: @@ -3273,7 +3285,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/opt/perl/bin/perl" /**/ +#define STARTPERL "#!/usr/local/bin/perl" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array @@ -3373,7 +3385,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.8.2/armv4l-linux for older + * lib/lib.pm will automatically search in /usr/local/lib/perl5/site_perl/5.8.3/armv4l-linux for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3392,7 +3404,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /opt/perl/lib/site_perl/5.8.2 for older directories across major versions + * search in /usr/local/lib/perl5/site_perl/5.8.3 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's @@ -3402,7 +3414,7 @@ * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION "5.8.2" +#define PERL_XS_APIVERSION "5.8.3" #define PERL_PM_APIVERSION "5.005" /* HAS_DRAND48_PROTO: diff --git a/gnu/usr.bin/perl/Porting/pumpkin.pod b/gnu/usr.bin/perl/Porting/pumpkin.pod index ce479bbd7d9..1d935fac632 100644 --- a/gnu/usr.bin/perl/Porting/pumpkin.pod +++ b/gnu/usr.bin/perl/Porting/pumpkin.pod @@ -488,16 +488,13 @@ some patches so that byacc dynamically allocates space, rather than having fixed limits. This patch is handled by the F<perly.fixer> script. Depending on the nature of the changes to F<perly.y>, you may or may not have to hand-edit the patch to apply correctly. If you do, -you should include the edited patch in the new distribution. If you -have byacc-1.9, the patch won't apply cleanly. Changes to the printf -output statements mean the patch won't apply cleanly. Long ago I -started to fix F<perly.fixer> to detect this, but I never completed the -task. +you should include the edited patch in the new distribution. (If you +have byacc-1.9, the patch won't apply cleanly, notably changes to the printf +output statements. F<perly.fixer> could be fixed to detect this.) If C<perly.c> or C<perly.h> changes, make sure you run C<perl vms/vms_yfix.pl> -to update the corresponding VMS files. This could be taken care of by -the regen_all target in the Unix Makefile. See also -L<VMS-specific updates>. +to update the corresponding VMS files. The run_byacc target in the Unix +Makefile takes care of this. See also L<VMS-specific updates>. Some additional notes from Larry on this: @@ -507,7 +504,7 @@ Don't forget to regenerate perly_c.diff. mv y.tab.c perly.c patch perly.c <perly_c.diff # manually apply any failed hunks - diff -c perly.c.orig perly.c >perly_c.diff + diff -u perly.c.orig perly.c >perly_c.diff One chunk of lines that often fails begins with @@ -575,6 +572,19 @@ about them first. If possible, we should provide backwards-compatibility stubs. There's a lot of XS code out there. Let's not force people to keep changing it. +=head2 PPPort + +F<ext/Devel/PPPort/PPPort.pm> needs to be synchronized to include all +new macros added to .h files (normally perl.h and XSUB.h, but others +as well). Since chances are that when a new macro is added the +committer will forget to update F<PPPort.pm>, it's the best to diff for +changes in .h files when making a new release and making sure that +F<PPPort.pm> contains them all. + +The pumpking can delegate the synchronization responsibility to anybody +else, but the release process is the only place where we can make sure +that no new macros fell through the cracks. + =head2 Changes Be sure to update the F<Changes> file. Try to include both an overall @@ -1640,4 +1650,4 @@ All opinions expressed herein are those of the authorZ<>(s). =head1 LAST MODIFIED -$Id: pumpkin.pod,v 1.23 2000/01/13 19:45:13 doughera Released $ +$Id: pumpkin.pod,v 1.6 2003/12/03 03:02:26 millert Exp $ diff --git a/gnu/usr.bin/perl/README.os2 b/gnu/usr.bin/perl/README.os2 index bb1adb12488..05c088ad0e5 100644 --- a/gnu/usr.bin/perl/README.os2 +++ b/gnu/usr.bin/perl/README.os2 @@ -869,7 +869,10 @@ compatibility with XFree86-OS/2). Get a corrected one from If you have I<exactly the same version of Perl> installed already, make sure that no copies or perl are currently running. Later steps of the build may fail since an older version of F<perl.dll> loaded into -memory may be found. +memory may be found. Running C<make test> becomes meaningless, since +the test are checking a previous build of perl (this situation is detected +and reported by F<lib/os2_base.t> test). Do not forget to unset +C<PERL_EMXLOAD_SEC> in environment. Also make sure that you have F</tmp> directory on the current drive, and F<.> directory in your C<LIBPATH>. One may try to correct the @@ -1089,6 +1092,433 @@ say, by doing first. +=head1 Building a binary distribution + +[This section provides a short overview only...] + +Building should proceed differently depending on whether the version of perl +you install is already present and used on your system, or is a new version +not yet used. The description below assumes that the version is new, so +installing its DLLs and F<.pm> files will not disrupt the operation of your +system even if some intermediate steps are not yet fully working. + +The other cases require a little bit more convoluted procedures. Below I +suppose that the current version of Perl is C<5.8.2>, so the executables are +named accordingly. + +=over + +=item 1. + +Fully build and test the Perl distribution. Make sure that no tests are +failing with C<test> and C<aout_test> targets; fix the bugs in Perl and +the Perl test suite detected by these tests. Make sure that C<all_test> +make target runs as clean as possible. Check that C<os2/perlrexx.cmd> +runs fine. + +=item 2. + +Fully install Perl, including C<installcmd> target. Copy the generated DLLs +to C<LIBPATH>; copy the numbered Perl executables (as in F<perl5.8.2.exe>) +to C<PATH>; copy C<perl_.exe> to C<PATH> as C<perl_5.8.2.exe>. Think whether +you need backward-compatibility DLLs. In most cases you do not need to install +them yet; but sometime this may simplify the following steps. + +=item 3. + +Make sure that C<CPAN.pm> can download files from CPAN. If not, you may need +to manually install C<Net::FTP>. + +=item 4. + +Install the bundle C<Bundle::OS2_default> + + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_1 + +This may take a couple of hours on 1GHz processor (when run the first time). +And this should not be necessarily a smooth procedure. Some modules may not +specify required dependencies, so one may need to repeat this procedure several +times until the results stabilize. + + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_2 + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_3 + +Even after they stabilize, some tests may fail. + +Fix as many discovered bugs as possible. Document all the bugs which are not +fixed, and all the failures with unknown reasons. Inspect the produced logs +F<00cpan_i_1> to find suspiciously skipped tests, and other fishy events. + +Keep in mind that I<installation> of some modules may fail too: for example, +the DLLs to update may be already loaded by F<CPAN.pm>. Inspect the C<install> +logs (in the example above F<00cpan_i_1> etc) for errors, and install things +manually, as in + + cd $CPANHOME/.cpan/build/Digest-MD5-2.31 + make install + +Some distributions may fail some tests, but you may want to install them +anyway (as above, or via C<force install> command of C<CPAN.pm> shell-mode). + +Since this procedure may take quite a long time to complete, it makes sense +to "freeze" your CPAN configuration by disabling periodic updates of the +local copy of CPAN index: set C<index_expire> to some big value (I use 365), +then save the settings + + CPAN> o conf index_expire 365 + CPAN> o conf commit + +Reset back to the default value C<1> when you are finished. + +=item 5. + +When satisfied with the results, rerun the C<installcmd> target. Now you +can copy C<perl5.8.2.exe> to C<perl.exe>, and install the other OMF-build +executables: C<perl__.exe> etc. They are ready to be used. + +=item 6. + +Change to the C<./pod> directory of the build tree, download the Perl logo +F<CamelGrayBig.BMP>, and run + + ( perl2ipf > perl.ipf ) |& tee 00ipf + ipfc /INF perl.ipf |& tee 00inf + +This produces the Perl docs online book C<perl.INF>. Install in on +C<BOOKSHELF> path. + +=item 7. + +Now is the time to build statically linked executable F<perl_.exe> which +includes newly-installed via C<Bundle::OS2_default> modules. Doing testing +via C<CPAN.pm> is going to be painfully slow, since it statically links +a new executable per XS extension. + +Here is a possible workaround: create a toplevel F<Makefile.PL> in +F<$CPANHOME/.cpan/build/> with contents being (compare with L<Making +executables with a custom collection of statically loaded extensions>) + + use ExtUtils::MakeMaker; + WriteMakefile NAME => 'dummy'; + +execute this as + + perl_5.8.2.exe Makefile.PL <nul |& tee 00aout_c1 + make -k all test <nul |& 00aout_t1 + +Again, this procedure should not be absolutely smooth. Some C<Makefile.PL>'s +in subdirectories may be buggy, and would not run as "child" scripts. The +interdependency of modules can strike you; however, since non-XS modules +are already installed, the prerequisites of most modules have a very good +chance to be present. + +If you discover some glitches, move directories of problematic modules to a +different location; if these modules are non-XS modules, you may just ignore +them - they are already installed; the remaining, XS, modules you need to +install manually one by one. + +After each such removal you need to rerun the C<Makefile.PL>/C<make> process; +usually this procedure converges soon. (But be sure to convert all the +necessary external C libraries from F<.lib> format to F<.a> format: run one of + + emxaout foo.lib + emximp -o foo.a foo.lib + +whichever is appropriate.) Also, make sure that the DLLs for external +libraries are usable with with executables compiled without C<-Zmtd> options. + +When you are sure that only a few subdirectories +lead to failures, you may want to add C<-j4> option to C<make> to speed up +skipping subdirectories with already finished build. + +When you are satisfied with the results of tests, install the build C libraries +for extensions: + + make install |& tee 00aout_i + +Now you can rename the file F<./perl.exe> generated during the last phase +to F<perl_5.8.2.exe>; place it on C<PATH>; if there is an inter-dependency +between some XS modules, you may need to repeat the C<test>/C<install> loop +with this new executable and some excluded modules - until the procedure +converges. + +Now you have all the necessary F<.a> libraries for these Perl modules in the +places where Perl builder can find it. Use the perl builder: change to an +empty directory, create a "dummy" F<Makefile.PL> again, and run + + perl_5.8.2.exe Makefile.PL |& tee 00c + make perl |& tee 00p + +This should create an executable F<./perl.exe> with all the statically loaded +extensions built in. Compare the generated F<perlmain.c> files to make sure +that during the iterations the number of loaded extensions only increases. +Rename F<./perl.exe> to F<perl_5.8.2.exe> on C<PATH>. + +When it converges, you got a functional variant of F<perl_5.8.2.exe>; copy it +to C<perl_.exe>. You are done with generation of the local Perl installation. + +=item 8. + +Make sure that the installed modules are actually installed in the location +of the new Perl, and are not inherited from entries of @INC given for +inheritance from the older versions of Perl: set C<PERLLIB_582_PREFIX> to +redirect the new version of Perl to a new location, and copy the installed +files to this new location. Redo the tests to make sure that the versions of +modules inherited from older versions of Perl are not needed. + +Actually, the log output of L<pod2ipf> during the step 6 gives a very detailed +info about which modules are loaded from which place; so you may use it as +an additional verification tool. + +Check that some temporary files did not make into the perl install tree. +Run something like this + + pfind . -f "!(/\.(pm|pl|ix|al|h|a|lib|txt|pod|imp|bs|dll|ld|bs|inc|xbm|yml|cgi|uu|e2x|skip|packlist|eg|cfg|html|pub|enc|all|ini|po|pot)$/i or /^\w+$/") | less + +in the install tree (both top one and F<sitelib> one). + +Compress all the DLLs with F<lxlite>. The tiny F<.exe> can be compressed with +C</c:max> (the bug only appears when there is a fixup in the last 6 bytes of a +page (?); since the tiny executables are much smaller than a page, the bug +will not hit). Do not compress C<perl_.exe> - it would not work under DOS. + +=item 9. + +Now you can generate the binary distribution. This is done by running the +test of the CPAN distribution C<OS2::SoftInstaller>. Tune up the file +F<test.pl> to suit the layout of current version of Perl first. Do not +forget to pack the necessary external DLLs accordingly. Include the +description of the bugs and test suite failures you could not fix. Include +the small-stack versions of Perl executables from Perl build directory. + +Include F<perl5.def> so that people can relink the perl DLL preserving +the binary compatibility, or can create compatibility DLLs. Include the diff +files (C<diff -pu old new>) of fixes you did so that people can rebuild your +version. Include F<perl5.map> so that one can use remote debugging. + +=item 10. + +Share what you did with the other people. Relax. Enjoy fruits of your work. + +=item 11. + +Brace yourself for thanks, bug reports, hate mail and spam coming as result +of the previous step. No good deed should remain unpunished! + +=back + +=head1 Building custom F<.EXE> files + +The Perl executables can be easily rebuilt at any moment. Moreover, one can +use the I<embedding> interface (see L<perlembed>) to make very customized +executables. + +=head2 Making executables with a custom collection of statically loaded extensions + +It is a little bit easier to do so while I<decreasing> the list of statically +loaded extensions. We discuss this case only here. + +=over + +=item 1. + +Change to an empty directory, and create a placeholder <Makefile.PL>: + + use ExtUtils::MakeMaker; + WriteMakefile NAME => 'dummy'; + +=item 2. + +Run it with the flavor of Perl (F<perl.exe> or F<perl_.exe>) you want to +rebuild. + + perl_ Makefile.PL + +=item 3. + +Ask it to create new Perl executable: + + make perl + +(you may need to manually add C<PERLTYPE=-DPERL_CORE> to this commandline on +some versions of Perl; the symptom is that the command-line globbing does not +work from OS/2 shells with the newly-compiled executable; check with + + .\perl.exe -wle "print for @ARGV" * + +). + +=item 4. + +The previous step created F<perlmain.c> which contains a list of newXS() calls +near the end. Removing unnecessary calls, and rerunning + + make perl + +will produce a customized executable. + +=back + +=head2 Making executables with a custom search-paths + +The default perl executable is flexible enough to support most usages. +However, one may want something yet more flexible; for example, one may want +to find Perl DLL relatively to the location of the EXE file; or one may want +to ignore the environment when setting the Perl-library search patch, etc. + +If you fill comfortable with I<embedding> interface (see L<perlembed>), such +things are easy to do repeating the steps outlined in L<Making +executables with a custom collection of statically loaded extensions>, and +doing more comprehensive edits to main() of F<perlmain.c>. The people with +little desire to understand Perl can just rename main(), and do necessary +modification in a custom main() which calls the renamed function in appropriate +time. + +However, there is a third way: perl DLL exports the main() function and several +callbacks to customize the search path. Below is a complete example of a +"Perl loader" which + +=over + +=item 1. + +Looks for Perl DLL in the directory C<$exedir/../dll>; + +=item 2. + +Prepends the above directory to C<BEGINLIBPATH>; + +=item 3. + +Fails if the Perl DLL found via C<BEGINLIBPATH> is different from what was +loaded on step 1; e.g., another process could have loaded it from C<LIBPATH> +or from a different value of C<BEGINLIBPATH>. In these cases one needs to +modify the setting of the system so that this other process either does not +run, or loads the DLL from C<BEGINLIBPATH> with C<LIBPATHSTRICT=T> (available +with kernels after September 2000). + +=item 4. + +Loads Perl library from C<$exedir/../dll/lib/>. + +=item 5. + +Uses Bourne shell from C<$exedir/../dll/sh/ksh.exe>. + +=back + +For best results compile the C file below with the same options as the Perl +DLL. However, a lot of functionality will work even if the executable is not +an EMX applications, e.g., if compiled with + + gcc -Wall -DDOSISH -DOS2=1 -O2 -s -Zomf -Zsys perl-starter.c -DPERL_DLL_BASENAME=\"perl312F\" -Zstack 8192 -Zlinker /PM:VIO + +Here is the sample C file: + + #define INCL_DOS + #define INCL_NOPM + /* These are needed for compile if os2.h includes os2tk.h, not os2emx.h */ + #define INCL_DOSPROCESS + #include <os2.h> + + #include "EXTERN.h" + #define PERL_IN_MINIPERLMAIN_C + #include "perl.h" + + static char *me; + HMODULE handle; + + static void + die_with(char *msg1, char *msg2, char *msg3, char *msg4) + { + ULONG c; + char *s = " error: "; + + DosWrite(2, me, strlen(me), &c); + DosWrite(2, s, strlen(s), &c); + DosWrite(2, msg1, strlen(msg1), &c); + DosWrite(2, msg2, strlen(msg2), &c); + DosWrite(2, msg3, strlen(msg3), &c); + DosWrite(2, msg4, strlen(msg4), &c); + DosWrite(2, "\r\n", 2, &c); + exit(255); + } + + typedef ULONG (*fill_extLibpath_t)(int type, char *pre, char *post, int replace, char *msg); + typedef int (*main_t)(int type, char *argv[], char *env[]); + typedef int (*handler_t)(void* data, int which); + + #ifndef PERL_DLL_BASENAME + # define PERL_DLL_BASENAME "perl" + #endif + + static HMODULE + load_perl_dll(char *basename) + { + char buf[300], fail[260]; + STRLEN l, dirl; + fill_extLibpath_t f; + ULONG rc_fullname; + HMODULE handle, handle1; + + if (_execname(buf, sizeof(buf) - 13) != 0) + die_with("Can't find full path: ", strerror(errno), "", ""); + /* XXXX Fill `me' with new value */ + l = strlen(buf); + while (l && buf[l-1] != '/' && buf[l-1] != '\\') + l--; + dirl = l - 1; + strcpy(buf + l, basename); + l += strlen(basename); + strcpy(buf + l, ".dll"); + if ( (rc_fullname = DosLoadModule(fail, sizeof fail, buf, &handle)) != 0 + && DosLoadModule(fail, sizeof fail, basename, &handle) != 0 ) + die_with("Can't load DLL ", buf, "", ""); + if (rc_fullname) + return handle; /* was loaded with short name; all is fine */ + if (DosQueryProcAddr(handle, 0, "fill_extLibpath", (PFN*)&f)) + die_with(buf, ": DLL exports no symbol ", "fill_extLibpath", ""); + buf[dirl] = 0; + if (f(0 /*BEGINLIBPATH*/, buf /* prepend */, NULL /* append */, + 0 /* keep old value */, me)) + die_with(me, ": prepending BEGINLIBPATH", "", ""); + if (DosLoadModule(fail, sizeof fail, basename, &handle1) != 0) + die_with(me, ": finding perl DLL again via BEGINLIBPATH", "", ""); + buf[dirl] = '\\'; + if (handle1 != handle) { + if (DosQueryModuleName(handle1, sizeof(fail), fail)) + strcpy(fail, "???"); + die_with(buf, ":\n\tperl DLL via BEGINLIBPATH is different: \n\t", + fail, + "\n\tYou may need to manipulate global BEGINLIBPATH and LIBPATHSTRICT" + "\n\tso that the other copy is loaded via BEGINLIBPATH."); + } + return handle; + } + + int + main(int argc, char **argv, char **env) + { + main_t f; + handler_t h; + + me = argv[0]; + /**/ + handle = load_perl_dll(PERL_DLL_BASENAME); + + if (DosQueryProcAddr(handle, 0, "Perl_OS2_handler_install", (PFN*)&h)) + die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "Perl_OS2_handler_install", ""); + if ( !h((void *)"~installprefix", Perlos2_handler_perllib_from) + || !h((void *)"~dll", Perlos2_handler_perllib_to) + || !h((void *)"~dll/sh/ksh.exe", Perlos2_handler_perl_sh) ) + die_with(PERL_DLL_BASENAME, ": Can't install @INC manglers", "", ""); + + if (DosQueryProcAddr(handle, 0, "dll_perlmain", (PFN*)&f)) + die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "dll_perlmain", ""); + return f(argc, argv, env); + } + + =head1 Build FAQ =head2 Some C</> became C<\> in pdksh. @@ -2270,8 +2700,8 @@ have a low probability of affecting small programs. =head1 BUGS -This description was not updated since 5.6.1, see F<os2/Changes> for -more info. +This description is not updated often (since 5.6.1?), see F<./os2/Changes> +(L<perlos2delta>) for more info. =cut diff --git a/gnu/usr.bin/perl/README.vms b/gnu/usr.bin/perl/README.vms index 5ead1370694..b62dbd4ba06 100644 --- a/gnu/usr.bin/perl/README.vms +++ b/gnu/usr.bin/perl/README.vms @@ -107,6 +107,9 @@ Freeware CD-ROM from Compaq. ftp://ftp.lp.se/vms/ http://www.openvms.compaq.com/freeware/ +Recent versions of VMS tar on ODS-5 volumes may extract tape archive +files with ^. escaped periods in them. See below for further workarounds. + =item 3 UNZIP.EXE for VMS A combination decompressor and archive reader/writer for *.zip files. @@ -151,6 +154,33 @@ If you want to include socket support, you'll need a TCP/IP stack and either DEC C, or socket libraries. See the "Socket Support (optional)" topic for more details. +=head1 Unpacking the Perl source code + +You may need to set up a foreign symbol for the unpacking utility of choice. + +If you unpack a perl source kit with a name containing multiple periods on +an ODS-5 volume using recent versions of vmstar (e.g. V3.4 or later) you may +need to be especially careful in unpacking the tape archive file. Try to use +the ODS-2 compatability qualifiers such as: + + vmstar /extract/verbose/ods2 perl-V^.VIII^.III.tar + +or: + + vmstar -xvof perl-5^.8^.3.tar + +If you neglected to use the /ODS2 qualifier or the -o switch then you +could rename the source directory: + + set security/protection=(o:rwed) perl-5^.8^.3.dir + rename perl-5^.8^.3.dir perl-5_8_3.dir + +Perl on VMS as of 5.8.3 does not completely handle extended file +parse styles such as are encountered on ODS-5. While it can be built, +installed, and run on ODS-5 filesystems; it may encounter +trouble with characters that are otherwise illegal on ODS-2 +volumes (notably the ^. escaped period sequence). + =head1 Configuring the Perl build To configure perl (a necessary first step), issue the command @@ -532,6 +562,12 @@ configuration script will warn if it thinks you are too deep (at least on a VAX or on Alpha versions of VMS prior to 7.2). But MakeMaker will not warn you if you start out building a module too deep in a directory. +As noted above ODS-5 escape sequences such as ^. can break the perl +build. Solutions include renaming files and directories as needed or +being careful to use the -o switch or /ODS2 qualifier with latter +versions of the vmstar utility when unpacking perl or CPAN modules +on ODS-5 volumes. + Be sure that the process that you use to build perl has a PGFLQ greater than 100000. Be sure to have a correct local time zone to UTC offset defined (in seconds) in the logical name SYS$TIMEZONE_DIFFERENTIAL before diff --git a/gnu/usr.bin/perl/XSUB.h b/gnu/usr.bin/perl/XSUB.h index ce76a7b132b..b4c241aa3e1 100644 --- a/gnu/usr.bin/perl/XSUB.h +++ b/gnu/usr.bin/perl/XSUB.h @@ -193,7 +193,8 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">. #define XSRETURN(off) \ STMT_START { \ - PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ + IV tmpXSoff = (off); \ + PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); \ return; \ } STMT_END @@ -212,23 +213,23 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">. #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ - SV *tmpsv; STRLEN n_a; \ + SV *_sv; STRLEN n_a; \ char *vn = Nullch, *module = SvPV(ST(0),n_a); \ if (items >= 2) /* version supplied as bootstrap arg */ \ - tmpsv = ST(1); \ + _sv = ST(1); \ else { \ /* XXX GV_ADDWARN */ \ - tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ + _sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ vn = "XS_VERSION"), FALSE); \ - if (!tmpsv || !SvOK(tmpsv)) \ - tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ + if (!_sv || !SvOK(_sv)) \ + _sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ vn = "VERSION"), FALSE); \ } \ - if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \ + if (_sv && (!SvOK(_sv) || strNE(XS_VERSION, SvPV(_sv, n_a)))) \ Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,\ module, XS_VERSION, \ vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ - vn ? vn : "bootstrap parameter", tmpsv); \ + vn ? vn : "bootstrap parameter", _sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK @@ -266,6 +267,8 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">. SAVEINT(db->filtering) ; \ db->filtering = TRUE ; \ SAVESPTR(DEFSV) ; \ + if (name[7] == 's') \ + arg = newSVsv(arg); \ DEFSV = arg ; \ SvTEMP_off(arg) ; \ PUSHMARK(SP) ; \ @@ -275,6 +278,10 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">. PUTBACK ; \ FREETMPS ; \ LEAVE ; \ + if (name[7] == 's'){ \ + arg = sv_2mortal(arg); \ + } \ + SvOKp(arg); \ } #if 1 /* for compatibility */ diff --git a/gnu/usr.bin/perl/config_h.SH b/gnu/usr.bin/perl/config_h.SH index a40ec44d34f..6efec9a40b1 100644 --- a/gnu/usr.bin/perl/config_h.SH +++ b/gnu/usr.bin/perl/config_h.SH @@ -31,7 +31,7 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit $CONFIG_SH and rerun config_h.SH. * - * \$Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + * \$Id: config_h.SH,v 1.7 2003/12/03 03:02:19 millert Exp $ */ /* @@ -1401,6 +1401,18 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un */ #$d_perl_otherlibdirs PERL_OTHERLIBDIRS "$otherlibdirs" /**/ +/* INSTALL_PREFIX: + * This symbol contains the "root" of installation tree for this package. + * The program should be prepared to do ~ expansion. + */ +/* INSTALL_PREFIX_EXP: + * This symbol contains the "root" of installation tree for this package + * to be used in programs that are not prepared to deal with ~ expansion + * at run-time. + */ +#define INSTALL_PREFIX "$installprefix" /**/ +#define INSTALL_PREFIX_EXP "$installprefixexp" /**/ + /* PRIVLIB: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's diff --git a/gnu/usr.bin/perl/configpm b/gnu/usr.bin/perl/configpm index 2cdb60c2742..5ac43e40dda 100644 --- a/gnu/usr.bin/perl/configpm +++ b/gnu/usr.bin/perl/configpm @@ -227,15 +227,18 @@ open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!"; do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/; close(MYCONFIG); +# NB. as $summary is unique, we need to copy it in a lexical variable +# before expanding it, because may have been made readonly if a perl +# interpreter has been cloned. + print CONFIG "\n!END!\n", <<'EOT'; -my $summary_expanded = 0; +my $summary_expanded; sub myconfig { - return $summary if $summary_expanded; - $summary =~ s{\$(\w+)} + return $summary_expanded if $summary_expanded; + ($summary_expanded = $summary) =~ s{\$(\w+)} { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge; - $summary_expanded = 1; - $summary; + $summary_expanded; } our $Config_SH : unique = <<'!END!'; diff --git a/gnu/usr.bin/perl/doio.c b/gnu/usr.bin/perl/doio.c index 5ba40b9be61..dc192d4717f 100644 --- a/gnu/usr.bin/perl/doio.c +++ b/gnu/usr.bin/perl/doio.c @@ -48,9 +48,7 @@ # define OPEN_EXCL 0 #endif -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> -#endif bool Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, @@ -2290,8 +2288,9 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) if (*cp == '?') *cp = '%'; /* VMS style single-char wildcard */ while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt, &dfltdsc,NULL,NULL,NULL))&1)) { - end = rstr + (unsigned long int) *rslt; - if (!hasver) while (*end != ';') end--; + /* with varying string, 1st word of buffer contains result length */ + end = rstr + *((unsigned short int*)rslt); + if (!hasver) while (*end != ';' && end > rstr) end--; *(end++) = '\n'; *end = '\0'; for (cp = rstr; *cp; cp++) *cp = _tolower(*cp); if (hasdir) { diff --git a/gnu/usr.bin/perl/doop.c b/gnu/usr.bin/perl/doop.c index 546d33d14c2..e999e344cdb 100644 --- a/gnu/usr.bin/perl/doop.c +++ b/gnu/usr.bin/perl/doop.c @@ -17,10 +17,8 @@ #include "perl.h" #ifndef PERL_MICRO -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> #endif -#endif STATIC I32 S_do_trans_simple(pTHX_ SV *sv) @@ -670,6 +668,10 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s } sv_setpv(sv, ""); + /* sv_setpv retains old UTF8ness [perl #24846] */ + if (SvUTF8(sv)) + SvUTF8_off(sv); + if (PL_tainting && SvMAGICAL(sv)) SvTAINTED_off(sv); diff --git a/gnu/usr.bin/perl/embed.h b/gnu/usr.bin/perl/embed.h index 980a12f81e6..6112ca7c8f9 100644 --- a/gnu/usr.bin/perl/embed.h +++ b/gnu/usr.bin/perl/embed.h @@ -1339,9 +1339,6 @@ #define share_hek_flags S_share_hek_flags #endif #ifdef PERL_CORE -#define hv_fetch_flags S_hv_fetch_flags -#endif -#ifdef PERL_CORE #define hv_notallowed S_hv_notallowed #endif #endif @@ -2172,6 +2169,19 @@ #define get_debug_opts Perl_get_debug_opts #endif #endif +#define hv_clear_placeholders Perl_hv_clear_placeholders +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define hv_delete_common S_hv_delete_common +#endif +#ifdef PERL_CORE +#define hv_fetch_common S_hv_fetch_common +#endif +#endif +#define hv_scalar Perl_hv_scalar +#ifdef PERL_CORE +#define magic_scalarpack Perl_magic_scalarpack +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -3844,9 +3854,6 @@ #define share_hek_flags(a,b,c,d) S_share_hek_flags(aTHX_ a,b,c,d) #endif #ifdef PERL_CORE -#define hv_fetch_flags(a,b,c,d,e) S_hv_fetch_flags(aTHX_ a,b,c,d,e) -#endif -#ifdef PERL_CORE #define hv_notallowed(a,b,c,d) S_hv_notallowed(aTHX_ a,b,c,d) #endif #endif @@ -4676,6 +4683,19 @@ #define get_debug_opts(a) Perl_get_debug_opts(aTHX_ a) #endif #endif +#define hv_clear_placeholders(a) Perl_hv_clear_placeholders(aTHX_ a) +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g) +#endif +#ifdef PERL_CORE +#define hv_fetch_common(a,b,c,d,e,f,g,h) S_hv_fetch_common(aTHX_ a,b,c,d,e,f,g,h) +#endif +#endif +#define hv_scalar(a) Perl_hv_scalar(aTHX_ a) +#ifdef PERL_CORE +#define magic_scalarpack(a,b) Perl_magic_scalarpack(aTHX_ a,b) +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/gnu/usr.bin/perl/ext/Cwd/Cwd.xs b/gnu/usr.bin/perl/ext/Cwd/Cwd.xs index 742b0ee64b1..422e7d6d387 100644 --- a/gnu/usr.bin/perl/ext/Cwd/Cwd.xs +++ b/gnu/usr.bin/perl/ext/Cwd/Cwd.xs @@ -206,6 +206,157 @@ err2: #endif } +#ifndef getcwd_sv +/* Taken from perl 5.8's util.c */ +int getcwd_sv(pTHX_ register SV *sv) +{ +#ifndef PERL_MICRO + +#ifndef INCOMPLETE_TAINTS + SvTAINTED_on(sv); +#endif + +#ifdef HAS_GETCWD + { + char buf[MAXPATHLEN]; + + /* Some getcwd()s automatically allocate a buffer of the given + * size from the heap if they are given a NULL buffer pointer. + * The problem is that this behaviour is not portable. */ + if (getcwd(buf, sizeof(buf) - 1)) { + STRLEN len = strlen(buf); + sv_setpvn(sv, buf, len); + return TRUE; + } + else { + sv_setsv(sv, &PL_sv_undef); + return FALSE; + } + } + +#else + + Stat_t statbuf; + int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino; + int namelen, pathlen=0; + DIR *dir; + Direntry_t *dp; + + (void)SvUPGRADE(sv, SVt_PV); + + if (PerlLIO_lstat(".", &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } + + orig_cdev = statbuf.st_dev; + orig_cino = statbuf.st_ino; + cdev = orig_cdev; + cino = orig_cino; + + for (;;) { + odev = cdev; + oino = cino; + + if (PerlDir_chdir("..") < 0) { + SV_CWD_RETURN_UNDEF; + } + if (PerlLIO_stat(".", &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } + + cdev = statbuf.st_dev; + cino = statbuf.st_ino; + + if (odev == cdev && oino == cino) { + break; + } + if (!(dir = PerlDir_open("."))) { + SV_CWD_RETURN_UNDEF; + } + + while ((dp = PerlDir_read(dir)) != NULL) { +#ifdef DIRNAMLEN + namelen = dp->d_namlen; +#else + namelen = strlen(dp->d_name); +#endif + /* skip . and .. */ + if (SV_CWD_ISDOT(dp)) { + continue; + } + + if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } + + tdev = statbuf.st_dev; + tino = statbuf.st_ino; + if (tino == oino && tdev == odev) { + break; + } + } + + if (!dp) { + SV_CWD_RETURN_UNDEF; + } + + if (pathlen + namelen + 1 >= MAXPATHLEN) { + SV_CWD_RETURN_UNDEF; + } + + SvGROW(sv, pathlen + namelen + 1); + + if (pathlen) { + /* shift down */ + Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char); + } + + /* prepend current directory to the front */ + *SvPVX(sv) = '/'; + Move(dp->d_name, SvPVX(sv)+1, namelen, char); + pathlen += (namelen + 1); + +#ifdef VOID_CLOSEDIR + PerlDir_close(dir); +#else + if (PerlDir_close(dir) < 0) { + SV_CWD_RETURN_UNDEF; + } +#endif + } + + if (pathlen) { + SvCUR_set(sv, pathlen); + *SvEND(sv) = '\0'; + SvPOK_only(sv); + + if (PerlDir_chdir(SvPVX(sv)) < 0) { + SV_CWD_RETURN_UNDEF; + } + } + if (PerlLIO_stat(".", &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } + + cdev = statbuf.st_dev; + cino = statbuf.st_ino; + + if (cdev != orig_cdev || cino != orig_cino) { + Perl_croak(aTHX_ "Unstable directory path, " + "current directory changed unexpectedly"); + } + + return TRUE; +#endif + +#else + return FALSE; +#endif +} + +#endif + + MODULE = Cwd PACKAGE = Cwd PROTOTYPES: ENABLE diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm index 54e0b527b30..77ba6ccf14f 100644 --- a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm +++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmqs@cpan.org) -# last modified 22nd October 2002 -# version 1.807 +# last modified 22nd December 2003 +# version 1.808 # # Copyright (c) 1995-2003 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice_end_array); use Carp; -$VERSION = "1.807" ; +$VERSION = "1.808" ; { local $SIG{__WARN__} = sub {$splice_end_array = "@_";}; @@ -2233,7 +2233,7 @@ B<DB_File> comes with the standard Perl source distribution. Look in the directory F<ext/DB_File>. Given the amount of time between releases of Perl the version that ships with Perl is quite likely to be out of date, so the most recent version can always be found on CPAN (see -L<perlmod/CPAN> for details), in the directory +L<perlmodlib/CPAN> for details), in the directory F<modules/by-module/DB_File>. This version of B<DB_File> will work with either version 1.x, 2.x or @@ -2278,14 +2278,14 @@ Berkeley DB authors or the author of DB_File. See L<"AUTHOR"> for details. =head1 SEE ALSO -L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>, -L<dbmfilter> +L<perl>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>, +L<perldbmfilter> =head1 AUTHOR The DB_File interface was written by Paul Marquess -E<lt>pmqs@cpan.org<gt>. +E<lt>pmqs@cpan.orgE<gt>. Questions about the DB system itself may be addressed to -E<lt>db@sleepycat.com<gt>. +E<lt>db@sleepycat.comE<gt>. =cut diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs index 3f097de8dd2..fec250961d2 100644 --- a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs +++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess <pmqs@cpan.org> - last modified 22nd October 2002 - version 1.807 + last modified 22nd December 2003 + version 1.808 All comments/suggestions/problems are welcome @@ -107,6 +107,7 @@ Filter code can now cope with read-only $_ 1.806 - recursion detection beefed up. 1.807 - no change + 1.808 - leak fixed in ParseOpenInfo */ @@ -398,6 +399,7 @@ typedef DBT DBTKEY ; my_sv_setpvn(arg, name.data, name.size) ; \ TAINT; \ SvTAINTED_on(arg); \ + SvUTF8_off(arg); \ DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \ } \ } @@ -412,6 +414,7 @@ typedef DBT DBTKEY ; sv_setiv(arg, (I32)*(I32*)name.data - 1); \ TAINT; \ SvTAINTED_on(arg); \ + SvUTF8_off(arg); \ DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \ } \ } @@ -1489,8 +1492,10 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H sv = ST(5) ; RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ; - if (RETVAL->dbp == NULL) + if (RETVAL->dbp == NULL) { + Safefree(RETVAL); RETVAL = NULL ; + } } OUTPUT: RETVAL @@ -1653,7 +1658,8 @@ unshift(db, ...) #endif for (i = items-1 ; i > 0 ; --i) { - value.data = SvPV(ST(i), n_a) ; + DBM_ckFilter(ST(i), filter_store_value, "filter_store_value"); + value.data = SvPVbyte(ST(i), n_a) ; value.size = n_a ; One = 1 ; key.data = &One ; @@ -1762,7 +1768,8 @@ push(db, ...) keyval = 0 ; for (i = 1 ; i < items ; ++i) { - value.data = SvPV(ST(i), n_a) ; + DBM_ckFilter(ST(i), filter_store_value, "filter_store_value"); + value.data = SvPVbyte(ST(i), n_a) ; value.size = n_a ; ++ keyval ; key.data = &keyval ; diff --git a/gnu/usr.bin/perl/ext/DB_File/typemap b/gnu/usr.bin/perl/ext/DB_File/typemap index 8ad7b1282dc..4c9df9e3c02 100644 --- a/gnu/usr.bin/perl/ext/DB_File/typemap +++ b/gnu/usr.bin/perl/ext/DB_File/typemap @@ -19,7 +19,7 @@ T_dbtkeydatum DBT_clear($var) ; if (SvOK($arg)){ if (db->type != DB_RECNO) { - $var.data = SvPV($arg, PL_na); + $var.data = SvPVbyte($arg, PL_na); $var.size = (int)PL_na; } else { @@ -32,7 +32,7 @@ T_dbtdatum DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); DBT_clear($var) ; if (SvOK($arg)) { - $var.data = SvPV($arg, PL_na); + $var.data = SvPVbyte($arg, PL_na); $var.size = (int)PL_na; } diff --git a/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm b/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm index 23f43a26087..45a34b667b1 100644 --- a/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm +++ b/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm @@ -68,7 +68,9 @@ even if available, access to a fixed interface): call_method call_pv call_sv + dAX DEFSV + dITEMS dMY_CXT dMY_CXT_SV dNOOP @@ -159,7 +161,7 @@ require DynaLoader; use strict; use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data ); -$VERSION = "2.009"; +$VERSION = "2.011"; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(); @@ -366,9 +368,10 @@ __DATA__ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ +# define PERL_PATCHLEVEL_H_IMPLICIT # include <patchlevel.h> # endif -# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) +# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) # include <could_not_find_Perl_patchlevel.h> # endif # ifndef PERL_REVISION @@ -448,6 +451,13 @@ __DATA__ # define aTHX_ #endif +#ifndef dAX +# define dAX I32 ax = MARK - PL_stack_base + 1 +#endif +#ifndef dITEMS +# define dITEMS I32 items = SP - MARK +#endif + /* IV could also be a quad (say, a long long), but Perls * capable of those should have IVSIZE already. */ #if !defined(IVSIZE) && defined(LONGSIZE) diff --git a/gnu/usr.bin/perl/ext/Digest/MD5/Changes b/gnu/usr.bin/perl/ext/Digest/MD5/Changes index 51f93d2b9ce..ad06023bfe1 100644 --- a/gnu/usr.bin/perl/ext/Digest/MD5/Changes +++ b/gnu/usr.bin/perl/ext/Digest/MD5/Changes @@ -1,3 +1,34 @@ +2003-12-07 Gisle Aas <gisle@ActiveState.com> + + Release 2.33 + + Enable explicit context passing for slight performance + improvement in threaded perls. + + Tweaks to the Makefile.PL so that it is suitable both for + core and CPAN use. + + + +2003-12-05 Gisle Aas <gisle@ActiveState.com> + + Release 2.32 + + Don't run u32align test program on HP-UX 10.20 as it + will hang. Patch by H.Merijn Brand <h.m.brand@hccnet.nl>. + + Fixed documentation typo. + + + +2003-11-28 Gisle Aas <gisle@ActiveState.com> + + Release 2.31 + + Inherit add_bits() from Digest::base if available. + + + 2003-10-09 Gisle Aas <gisle@ActiveState.com> Release 2.30 diff --git a/gnu/usr.bin/perl/ext/Digest/MD5/t/files.t b/gnu/usr.bin/perl/ext/Digest/MD5/t/files.t index bd8c9ed05be..2cbd5dd6cfb 100644 --- a/gnu/usr.bin/perl/ext/Digest/MD5/t/files.t +++ b/gnu/usr.bin/perl/ext/Digest/MD5/t/files.t @@ -20,27 +20,27 @@ use Digest::MD5 qw(md5 md5_hex md5_base64); my $EXPECT; if (ord "A" == 193) { # EBCDIC $EXPECT = <<EOT; -e1d7df564fad76d2f0ed628c648d5833 Changes +15e4c91ad67f5ff238033305376c9140 Changes 0565ec21b15c0f23f4c51fb327c8926d README -4d48606863dbc7fd131c2e7b5eefc8c5 MD5.pm -45e5e6785b47fb922f33b4a74c29a148 MD5.xs +f0f77710cd8d5ba7d9faedec8d02dc2f MD5.pm +f9848c0ee3b20a9177465eec19361e6c MD5.xs 276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt EOT } elsif ("\n" eq "\015") { # MacOS $EXPECT = <<EOT; -c780484c87b64e32bd55c6be58b623b4 Changes +dea016b088ab4d88a5e7cbd9c15a9c88 Changes 6c950a0211a5a28f023bb482037698cd README -546c4e62999c9888d7d46732a21c9dff MD5.pm -ca3f8cb317c5d088ed9f97204c6b8cda MD5.xs +f057c88277ecee875cf6f0352468407a MD5.pm +5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt EOT } else { # This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt' $EXPECT = <<EOT; -465bf969cb780d0b268dcc6b077a4c21 Changes +0150d5fc16642cb4222e83a1cd7c0a1b Changes 6c950a0211a5a28f023bb482037698cd README -546c4e62999c9888d7d46732a21c9dff MD5.pm -ca3f8cb317c5d088ed9f97204c6b8cda MD5.xs +f057c88277ecee875cf6f0352468407a MD5.pm +5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt EOT } diff --git a/gnu/usr.bin/perl/ext/Encode/t/enc_eucjp.t b/gnu/usr.bin/perl/ext/Encode/t/enc_eucjp.t index 179e080bb0a..5ce654e73fb 100644 --- a/gnu/usr.bin/perl/ext/Encode/t/enc_eucjp.t +++ b/gnu/usr.bin/perl/ext/Encode/t/enc_eucjp.t @@ -1,4 +1,4 @@ -# $Id: enc_eucjp.t,v 1.2 2003/12/03 03:02:29 millert Exp $ +# $Id: enc_eucjp.t,v 1.3 2004/04/07 21:33:02 millert Exp $ # This is the twin of enc_utf8.t . BEGIN { diff --git a/gnu/usr.bin/perl/ext/Encode/t/enc_utf8.t b/gnu/usr.bin/perl/ext/Encode/t/enc_utf8.t index b54cd133809..eb0f4d2d637 100644 --- a/gnu/usr.bin/perl/ext/Encode/t/enc_utf8.t +++ b/gnu/usr.bin/perl/ext/Encode/t/enc_utf8.t @@ -1,4 +1,4 @@ -# $Id: enc_utf8.t,v 1.2 2003/12/03 03:02:29 millert Exp $ +# $Id: enc_utf8.t,v 1.3 2004/04/07 21:33:02 millert Exp $ # This is the twin of enc_eucjp.t . BEGIN { diff --git a/gnu/usr.bin/perl/ext/GDBM_File/typemap b/gnu/usr.bin/perl/ext/GDBM_File/typemap index 048f0dd11cc..8c7cb45b462 100644 --- a/gnu/usr.bin/perl/ext/GDBM_File/typemap +++ b/gnu/usr.bin/perl/ext/GDBM_File/typemap @@ -3,7 +3,7 @@ # datum_key T_DATUM_K -datum_key_copy T_DATUM_K_C +datum_key_copy T_DATUM_K datum_value T_DATUM_V NDBM_File T_PTROBJ GDBM_File T_PTROBJ @@ -16,7 +16,7 @@ FATALFUNC T_OPAQUEPTR INPUT T_DATUM_K DBM_ckFilter($arg, filter_store_key, \"filter_store_key\"); - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; T_DATUM_K_C { @@ -27,13 +27,13 @@ T_DATUM_K_C } else tmpSV = $arg; - $var.dptr = SvPV(tmpSV, PL_na); + $var.dptr = SvPVbyte(tmpSV, PL_na); $var.dsize = (int)PL_na; } T_DATUM_V DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); if (SvOK($arg)) { - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; } else { diff --git a/gnu/usr.bin/perl/ext/NDBM_File/typemap b/gnu/usr.bin/perl/ext/NDBM_File/typemap index 093c4264099..c88725bf757 100644 --- a/gnu/usr.bin/perl/ext/NDBM_File/typemap +++ b/gnu/usr.bin/perl/ext/NDBM_File/typemap @@ -16,12 +16,12 @@ FATALFUNC T_OPAQUEPTR INPUT T_DATUM_K DBM_ckFilter($arg, filter_store_key, \"filter_store_key\"); - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; T_DATUM_V DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); if (SvOK($arg)) { - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; } else { diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.pm b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm index 819fe57564b..b6b893442c4 100644 --- a/gnu/usr.bin/perl/ext/POSIX/POSIX.pm +++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm @@ -2,7 +2,7 @@ package POSIX; our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD) = (); -our $VERSION = "1.06" ; +our $VERSION = "1.07"; use AutoLoader; diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs index 54e087afffd..deefbd190ac 100644 --- a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs +++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs @@ -842,10 +842,12 @@ int_macro_int(sv, iv) int isalnum(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isalnum(*s)) RETVAL = 0; @@ -854,10 +856,12 @@ isalnum(charstring) int isalpha(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isalpha(*s)) RETVAL = 0; @@ -866,10 +870,12 @@ isalpha(charstring) int iscntrl(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!iscntrl(*s)) RETVAL = 0; @@ -878,10 +884,12 @@ iscntrl(charstring) int isdigit(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isdigit(*s)) RETVAL = 0; @@ -890,10 +898,12 @@ isdigit(charstring) int isgraph(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isgraph(*s)) RETVAL = 0; @@ -902,10 +912,12 @@ isgraph(charstring) int islower(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!islower(*s)) RETVAL = 0; @@ -914,10 +926,12 @@ islower(charstring) int isprint(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isprint(*s)) RETVAL = 0; @@ -926,10 +940,12 @@ isprint(charstring) int ispunct(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!ispunct(*s)) RETVAL = 0; @@ -938,10 +954,12 @@ ispunct(charstring) int isspace(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isspace(*s)) RETVAL = 0; @@ -950,10 +968,12 @@ isspace(charstring) int isupper(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isupper(*s)) RETVAL = 0; @@ -962,10 +982,12 @@ isupper(charstring) int isxdigit(charstring) - unsigned char * charstring + SV * charstring + PREINIT: + STRLEN len; CODE: - unsigned char *s = charstring; - unsigned char *e = s + SvCUR(ST(0)); + unsigned char *s = (unsigned char *) SvPV(charstring, len); + unsigned char *e = s + len; for (RETVAL = 1; RETVAL && s < e; s++) if (!isxdigit(*s)) RETVAL = 0; @@ -1805,10 +1827,24 @@ pause() SysRet setgid(gid) Gid_t gid + CLEANUP: +#ifndef WIN32 + if (RETVAL >= 0) { + PL_gid = getgid(); + PL_egid = getegid(); + } +#endif SysRet setuid(uid) Uid_t uid + CLEANUP: +#ifndef WIN32 + if (RETVAL >= 0) { + PL_uid = getuid(); + PL_euid = geteuid(); + } +#endif SysRetLong sysconf(name) diff --git a/gnu/usr.bin/perl/ext/SDBM_File/typemap b/gnu/usr.bin/perl/ext/SDBM_File/typemap index 093c4264099..c88725bf757 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/typemap +++ b/gnu/usr.bin/perl/ext/SDBM_File/typemap @@ -16,12 +16,12 @@ FATALFUNC T_OPAQUEPTR INPUT T_DATUM_K DBM_ckFilter($arg, filter_store_key, \"filter_store_key\"); - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; T_DATUM_V DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); if (SvOK($arg)) { - $var.dptr = SvPV($arg, PL_na); + $var.dptr = SvPVbyte($arg, PL_na); $var.dsize = (int)PL_na; } else { diff --git a/gnu/usr.bin/perl/global.sym b/gnu/usr.bin/perl/global.sym index ee68418e48d..20de759bf81 100644 --- a/gnu/usr.bin/perl/global.sym +++ b/gnu/usr.bin/perl/global.sym @@ -665,3 +665,5 @@ Perl_PerlIO_get_cnt Perl_PerlIO_stdin Perl_PerlIO_stdout Perl_PerlIO_stderr +Perl_hv_clear_placeholders +Perl_hv_scalar diff --git a/gnu/usr.bin/perl/hints/README.hints b/gnu/usr.bin/perl/hints/README.hints index 9b49a398bcc..f55ded98005 100644 --- a/gnu/usr.bin/perl/hints/README.hints +++ b/gnu/usr.bin/perl/hints/README.hints @@ -303,6 +303,13 @@ variable in question is defined; however, this may change, so the scheme in hints/solaris_2.sh of checking to see if uselongdouble is defined is a good idea. +=item Call status + +Call-backs are only called always, even if the value for the call-back is +uset: UU/usethreads.cbu is called when Configure is about to deal with +threads. All created call-backs from hints should thus check the status +of the variable, and act upon it. + =item Future status I hope this "call-back" scheme is simple enough to use but powerful diff --git a/gnu/usr.bin/perl/hints/linux.sh b/gnu/usr.bin/perl/hints/linux.sh index bc7d49ad821..437e5c94c3c 100644 --- a/gnu/usr.bin/perl/hints/linux.sh +++ b/gnu/usr.bin/perl/hints/linux.sh @@ -247,8 +247,8 @@ fi #'osfmach3ppc') ccdlflags='-Wl,-E' ;; #esac -case "`uname -r`" in -sparc-linux) +case "`uname -m`" in +sparc*) case "$cccdlflags" in *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;; *) cccdlflags="$cccdlflags -fPIC" ;; diff --git a/gnu/usr.bin/perl/hints/os2.sh b/gnu/usr.bin/perl/hints/os2.sh index a3fc0b6c50f..8c8ef21bb21 100644 --- a/gnu/usr.bin/perl/hints/os2.sh +++ b/gnu/usr.bin/perl/hints/os2.sh @@ -131,19 +131,23 @@ aout_lib_ext='.a' aout_ar='ar' aout_plibext='.a' aout_lddlflags="-Zdll $ld_dll_optimize" + +# -D__ST_MT_ERRNO__ allows a quick relink with -Zmtd to check problems +# which may be due to linking with -Zmtd DLLs + # Cannot have 32000K stack: get SYS0170 ?! if [ $emxcrtrev -ge 50 ]; then - aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000' + aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000 -D__ST_MT_ERRNO__' else - aout_ldflags='-Zexe -Zstack 16000' + aout_ldflags='-Zexe -Zstack 16000 -D__ST_MT_ERRNO__' fi # To get into config.sh: aout_ldflags="$aout_ldflags" aout_d_fork='define' -aout_ccflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" -aout_cppflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" +aout_ccflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev -D__ST_MT_ERRNO__" +aout_cppflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev -D__ST_MT_ERRNO__" aout_use_clib='c' aout_usedl='undef' aout_archobjs="os2.o dl_os2.o" diff --git a/gnu/usr.bin/perl/hints/solaris_2.sh b/gnu/usr.bin/perl/hints/solaris_2.sh index 965f49d62b1..7ffc53c6efe 100644 --- a/gnu/usr.bin/perl/hints/solaris_2.sh +++ b/gnu/usr.bin/perl/hints/solaris_2.sh @@ -448,15 +448,12 @@ EOM exit 1 ;; esac - ;; -esac + # gcc-2.8.1 on Solaris 8 with -Duse64bitint fails op/pat.t test 822 # if we compile regexec.c with -O. Turn off optimization for that one # file. See hints/README.hints , especially # =head2 Propagating variables to config.sh, method 3. # A. Dougherty May 24, 2002 -case "$use64bitint" in -"$define") case "${gccversion}-${optimize}" in 2.8*-O*) # Honor a command-line override (rather unlikely) @@ -516,14 +513,13 @@ EOM loclibpth="/usr/lib/sparcv9 $loclibpth" ccflags="$ccflags -mcpu=v9 -m64" if test X`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null` != X; then + # This adds in -Wa,-xarch=v9. I suspect that's superfluous, + # since the -m64 above should do that already. Someone + # with gcc-3.x.x, please test with gcc -v. A.D. 20-Nov-2003 ccflags="$ccflags -Wa,`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" fi - # no changes to ld flags, as (according to man ld): - # - # There is no specific option that tells ld to link 64-bit - # objects; the class of the first object that gets processed - # by ld determines whether it is to perform a 32-bit or a - # 64-bit link edit. + ldflags="$ldflags -m64" + lddlflags="$lddlflags -G -m64" ;; *) ccflags="$ccflags `getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" diff --git a/gnu/usr.bin/perl/hv.c b/gnu/usr.bin/perl/hv.c index 6874352952b..99b682da815 100644 --- a/gnu/usr.bin/perl/hv.c +++ b/gnu/usr.bin/perl/hv.c @@ -80,6 +80,7 @@ S_more_he(pTHX) STATIC HEK * S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) { + int flags_masked = flags & HVhek_MASK; char *k; register HEK *hek; @@ -89,7 +90,10 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) HEK_KEY(hek)[len] = 0; HEK_LEN(hek) = len; HEK_HASH(hek) = hash; - HEK_FLAGS(hek) = (unsigned char)flags; + HEK_FLAGS(hek) = (unsigned char)flags_masked; + + if (flags & HVhek_FREEKEY) + Safefree(str); return hek; } @@ -168,13 +172,30 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot * contains an SV* */ +#define HV_FETCH_ISSTORE 0x01 +#define HV_FETCH_ISEXISTS 0x02 +#define HV_FETCH_LVALUE 0x04 +#define HV_FETCH_JUST_SV 0x08 + /* -=for apidoc hv_fetch +=for apidoc hv_store -Returns the SV which corresponds to the specified key in the hash. The -C<klen> is the length of the key. If C<lval> is set then the fetch will be -part of a store. Check that the return value is non-null before -dereferencing it to an C<SV*>. +Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is +the length of the key. The C<hash> parameter is the precomputed hash +value; if it is zero then Perl will compute it. The return value will be +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise it can +be dereferenced to get the original C<SV*>. Note that the caller is +responsible for suitably incrementing the reference count of C<val> before +the call, and decrementing it if the function returned NULL. Effectively +a successful hv_store takes ownership of one reference to C<val>. This is +usually what you want; a newly created SV has a reference count of one, so +if all your code does is create SVs then store them in a hash, hv_store +will own the only reference to the new SV, and your code doesn't need to do +anything further to tidy up. hv_store is not implemented as a call to +hv_store_ent, and does not create a temporary SV for the key, so if your +key data is not already in SV form then use hv_store in preference to +hv_store_ent. See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more information on how to use this function on tied hashes. @@ -182,178 +203,144 @@ information on how to use this function on tied hashes. =cut */ - SV** -Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) +Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) { - bool is_utf8 = FALSE; - const char *keysave = key; - int flags = 0; - - if (klen < 0) { - klen = -klen; - is_utf8 = TRUE; - } + HE *hek; + STRLEN klen; + int flags; - if (is_utf8) { - STRLEN tmplen = klen; - /* Just casting the &klen to (STRLEN) won't work well - * if STRLEN and I32 are of different widths. --jhi */ - key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8); - klen = tmplen; - /* If we were able to downgrade here, then than means that we were - passed in a key which only had chars 0-255, but was utf8 encoded. */ - if (is_utf8) - flags = HVhek_UTF8; - /* If we found we were able to downgrade the string to bytes, then - we should flag that it needs upgrading on keys or each. */ - if (key != keysave) - flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; } + hek = hv_fetch_common (hv, NULL, key, klen, flags, + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0); + return hek ? &HeVAL(hek) : NULL; +} - return hv_fetch_flags (hv, key, klen, lval, flags); +SV** +Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, + register U32 hash, int flags) +{ + HE *hek = hv_fetch_common (hv, NULL, key, klen, flags, + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); + return hek ? &HeVAL(hek) : NULL; } -STATIC SV** -S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) +/* +=for apidoc hv_store_ent + +Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> +parameter is the precomputed hash value; if it is zero then Perl will +compute it. The return value is the new hash entry so created. It will be +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise the +contents of the return value can be accessed using the C<He?> macros +described here. Note that the caller is responsible for suitably +incrementing the reference count of C<val> before the call, and +decrementing it if the function returned NULL. Effectively a successful +hv_store_ent takes ownership of one reference to C<val>. This is +usually what you want; a newly created SV has a reference count of one, so +if all your code does is create SVs then store them in a hash, hv_store +will own the only reference to the new SV, and your code doesn't need to do +anything further to tidy up. Note that hv_store_ent only reads the C<key>; +unlike C<val> it does not take ownership of it, so maintaining the correct +reference count on C<key> is entirely the caller's responsibility. hv_store +is not implemented as a call to hv_store_ent, and does not create a temporary +SV for the key, so if your key data is not already in SV form then use +hv_store in preference to hv_store_ent. + +See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more +information on how to use this function on tied hashes. + +=cut +*/ + +HE * +Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) { - register XPVHV* xhv; - register U32 hash; - register HE *entry; - SV *sv; + return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash); +} - if (!hv) - return 0; +/* +=for apidoc hv_exists - if (SvRMAGICAL(hv)) { - /* All this clause seems to be utf8 unaware. - By moving the utf8 stuff out to hv_fetch_flags I need to ensure - key doesn't leak. I've not tried solving the utf8-ness. - NWC. - */ - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - sv = sv_newmortal(); - sv_upgrade(sv, SVt_PVLV); - mg_copy((SV*)hv, sv, key, klen); - if (flags & HVhek_FREEKEY) - Safefree(key); - LvTYPE(sv) = 't'; - LvTARG(sv) = sv; /* fake (SV**) */ - return &(LvTARG(sv)); - } -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - I32 i; - for (i = 0; i < klen; ++i) - if (isLOWER(key[i])) { - char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen)))); - SV **ret = hv_fetch(hv, nkey, klen, 0); - if (!ret && lval) { - ret = hv_store_flags(hv, key, klen, NEWSV(61,0), 0, - flags); - } else if (flags & HVhek_FREEKEY) - Safefree(key); - return ret; - } - } -#endif - } +Returns a boolean indicating whether the specified hash key exists. The +C<klen> is the length of the key. - /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to - avoid unnecessary pointer dereferencing. */ - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_array /* !HvARRAY(hv) */) { - if (lval -#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ - || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) -#endif - ) - Newz(503, xhv->xhv_array /* HvARRAY(hv) */, - PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), - char); - else { - if (flags & HVhek_FREEKEY) - Safefree(key); - return 0; - } - } +=cut +*/ - if (HvREHASH(hv)) { - PERL_HASH_INTERNAL(hash, key, klen); - /* Yes, you do need this even though you are not "storing" because - you can flip the flags below if doing an lval lookup. (And that - was put in to give the semantics Andreas was expecting.) */ - flags |= HVhek_REHASH; +bool +Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) +{ + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; } else { - PERL_HASH(hash, key, klen); + klen = klen_i32; + flags = 0; } + return hv_fetch_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) + ? TRUE : FALSE; +} - /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (; entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - /* flags is 0 if not utf8. need HeKFLAGS(entry) also 0. - flags is 1 if utf8. need HeKFLAGS(entry) also 1. - xor is true if bits differ, in which case this isn't a match. */ - if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) - continue; - if (lval && HeKFLAGS(entry) != flags) { - /* We match if HVhek_UTF8 bit in our flags and hash key's match. - But if entry was set previously with HVhek_WASUTF8 and key now - doesn't (or vice versa) then we should change the key's flag, - as this is assignment. */ - if (HvSHAREKEYS(hv)) { - /* Need to swap the key we have for a key with the flags we - need. As keys are shared we can't just write to the flag, - so we share the new one, unshare the old one. */ - int flags_nofree = flags & ~HVhek_FREEKEY; - HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree); - unshare_hek (HeKEY_hek(entry)); - HeKEY_hek(entry) = new_hek; - } - else - HeKFLAGS(entry) = flags; - if (flags & HVhek_ENABLEHVKFLAGS) - HvHASKFLAGS_on(hv); - } - if (flags & HVhek_FREEKEY) - Safefree(key); - /* if we find a placeholder, we pretend we haven't found anything */ - if (HeVAL(entry) == &PL_sv_placeholder) - break; - return &HeVAL(entry); +/* +=for apidoc hv_fetch +Returns the SV which corresponds to the specified key in the hash. The +C<klen> is the length of the key. If C<lval> is set then the fetch will be +part of a store. Check that the return value is non-null before +dereferencing it to an C<SV*>. + +See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more +information on how to use this function on tied hashes. + +=cut +*/ + +SV** +Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) +{ + HE *hek; + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; } -#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ - if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { - unsigned long len; - char *env = PerlEnv_ENVgetenv_len(key,&len); - if (env) { - sv = newSVpvn(env,len); - SvTAINTED_on(sv); - if (flags & HVhek_FREEKEY) - Safefree(key); - return hv_store(hv,key,klen,sv,hash); - } - } -#endif - if (!entry && SvREADONLY(hv)) { - S_hv_notallowed(aTHX_ flags, key, klen, - "access disallowed key '%"SVf"' in" - ); - } - if (lval) { /* gonna assign to this, so it better be there */ - sv = NEWSV(61,0); - return hv_store_flags(hv,key,klen,sv,hash,flags); - } - if (flags & HVhek_FREEKEY) - Safefree(key); - return 0; + hek = hv_fetch_common (hv, NULL, key, klen, flags, + HV_FETCH_JUST_SV | (lval ? HV_FETCH_LVALUE : 0), + Nullsv, 0); + return hek ? &HeVAL(hek) : NULL; +} + +/* +=for apidoc hv_exists_ent + +Returns a boolean indicating whether the specified hash key exists. C<hash> +can be a valid precomputed hash value, or 0 to ask for it to be +computed. + +=cut +*/ + +bool +Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) +{ + return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) + ? TRUE : FALSE; } /* returns an HE * structure with the all fields set */ @@ -378,62 +365,201 @@ information on how to use this function on tied hashes. HE * Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) { - register XPVHV* xhv; - register char *key; - STRLEN klen; - register HE *entry; + return hv_fetch_common(hv, keysv, NULL, 0, 0, + (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash); +} + +HE * +S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, + int flags, int action, SV *val, register U32 hash) +{ + XPVHV* xhv; + U32 n_links; + HE *entry; + HE **oentry; SV *sv; bool is_utf8; - int flags = 0; - char *keysave; + int masked_flags; if (!hv) return 0; - if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - sv = sv_newmortal(); - keysv = newSVsv(keysv); - mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); - /* grab a fake HE/HEK pair from the pool or make a new one */ - entry = PL_hv_fetch_ent_mh; - if (entry) - PL_hv_fetch_ent_mh = HeNEXT(entry); - else { - char *k; - entry = new_HE(); - New(54, k, HEK_BASESIZE + sizeof(SV*), char); - HeKEY_hek(entry) = (HEK*)k; + if (keysv) { + if (flags & HVhek_FREEKEY) + Safefree(key); + key = SvPV(keysv, klen); + flags = 0; + is_utf8 = (SvUTF8(keysv) != 0); + } else { + is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); + } + + xhv = (XPVHV*)SvANY(hv); + if (SvMAGICAL(hv)) { + if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) + { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { + sv = sv_newmortal(); + + /* XXX should be able to skimp on the HE/HEK here when + HV_FETCH_JUST_SV is true. */ + + if (!keysv) { + keysv = newSVpvn(key, klen); + if (is_utf8) { + SvUTF8_on(keysv); + } + } else { + keysv = newSVsv(keysv); + } + mg_copy((SV*)hv, sv, (char *)keysv, HEf_SVKEY); + + /* grab a fake HE/HEK pair from the pool or make a new one */ + entry = PL_hv_fetch_ent_mh; + if (entry) + PL_hv_fetch_ent_mh = HeNEXT(entry); + else { + char *k; + entry = new_HE(); + New(54, k, HEK_BASESIZE + sizeof(SV*), char); + HeKEY_hek(entry) = (HEK*)k; + } + HeNEXT(entry) = Nullhe; + HeSVKEY_set(entry, keysv); + HeVAL(entry) = sv; + sv_upgrade(sv, SVt_PVLV); + LvTYPE(sv) = 'T'; + /* so we can free entry when freeing sv */ + LvTARG(sv) = (SV*)entry; + + /* XXX remove at some point? */ + if (flags & HVhek_FREEKEY) + Safefree(key); + + return entry; } - HeNEXT(entry) = Nullhe; - HeSVKEY_set(entry, keysv); - HeVAL(entry) = sv; - sv_upgrade(sv, SVt_PVLV); - LvTYPE(sv) = 'T'; - LvTARG(sv) = (SV*)entry; /* so we can free entry when freeing sv */ - return entry; - } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - U32 i; - key = SvPV(keysv, klen); - for (i = 0; i < klen; ++i) - if (isLOWER(key[i])) { - SV *nkeysv = sv_2mortal(newSVpvn(key,klen)); - (void)strupr(SvPVX(nkeysv)); - entry = hv_fetch_ent(hv, nkeysv, 0, 0); - if (!entry && lval) - entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash); - return entry; + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + U32 i; + for (i = 0; i < klen; ++i) + if (isLOWER(key[i])) { + /* Would be nice if we had a routine to do the + copy and upercase in a single pass through. */ + char *nkey = strupr(savepvn(key,klen)); + /* Note that this fetch is for nkey (the uppercased + key) whereas the store is for key (the original) */ + entry = hv_fetch_common(hv, Nullsv, nkey, klen, + HVhek_FREEKEY, /* free nkey */ + 0 /* non-LVAL fetch */, + Nullsv /* no value */, + 0 /* compute hash */); + if (!entry && (action & HV_FETCH_LVALUE)) { + /* This call will free key if necessary. + Do it this way to encourage compiler to tail + call optimise. */ + entry = hv_fetch_common(hv, keysv, key, klen, + flags, HV_FETCH_ISSTORE, + NEWSV(61,0), hash); + } else { + if (flags & HVhek_FREEKEY) + Safefree(key); + } + return entry; + } + } +#endif + } /* ISFETCH */ + else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { + SV* svret; + /* I don't understand why hv_exists_ent has svret and sv, + whereas hv_exists only had one. */ + svret = sv_newmortal(); + sv = sv_newmortal(); + + if (keysv || is_utf8) { + if (!keysv) { + keysv = newSVpvn(key, klen); + SvUTF8_on(keysv); + } else { + keysv = newSVsv(keysv); + } + mg_copy((SV*)hv, sv, (char *)sv_2mortal(keysv), HEf_SVKEY); + } else { + mg_copy((SV*)hv, sv, key, klen); } - } + if (flags & HVhek_FREEKEY) + Safefree(key); + magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem)); + /* This cast somewhat evil, but I'm merely using NULL/ + not NULL to return the boolean exists. + And I know hv is not NULL. */ + return SvTRUE(svret) ? (HE *)hv : NULL; + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + const char *keysave = key; + /* Will need to free this, so set FREEKEY flag. */ + key = savepvn(key,klen); + key = (const char*)strupr((char*)key); + is_utf8 = 0; + hash = 0; + + if (flags & HVhek_FREEKEY) { + Safefree(keysave); + } + flags |= HVhek_FREEKEY; + } #endif - } + } /* ISEXISTS */ + else if (action & HV_FETCH_ISSTORE) { + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + if (needs_copy) { + bool save_taint = PL_tainted; + if (keysv || is_utf8) { + if (!keysv) { + keysv = newSVpvn(key, klen); + SvUTF8_on(keysv); + } + if (PL_tainting) + PL_tainted = SvTAINTED(keysv); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); + } else { + mg_copy((SV*)hv, val, key, klen); + } + + TAINT_IF(save_taint); + if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store) { + if (flags & HVhek_FREEKEY) + Safefree(key); + return Nullhe; + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + const char *keysave = key; + /* Will need to free this, so set FREEKEY flag. */ + key = savepvn(key,klen); + key = (const char*)strupr((char*)key); + is_utf8 = 0; + hash = 0; + + if (flags & HVhek_FREEKEY) { + Safefree(keysave); + } + flags |= HVhek_FREEKEY; + } +#endif + } + } /* ISSTORE */ + } /* SvMAGICAL */ - keysave = key = SvPV(keysv, klen); - xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array /* !HvARRAY(hv) */) { - if (lval + if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE)) #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) #endif @@ -441,271 +567,184 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) Newz(503, xhv->xhv_array /* HvARRAY(hv) */, PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), char); - else +#ifdef DYNAMIC_ENV_FETCH + else if (action & HV_FETCH_ISEXISTS) { + /* for an %ENV exists, if we do an insert it's by a recursive + store call, so avoid creating HvARRAY(hv) right now. */ + } +#endif + else { + /* XXX remove at some point? */ + if (flags & HVhek_FREEKEY) + Safefree(key); + return 0; + } } - is_utf8 = (SvUTF8(keysv)!=0); - if (is_utf8) { + const char *keysave = key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) - flags = HVhek_UTF8; - if (key != keysave) + flags |= HVhek_UTF8; + else + flags &= ~HVhek_UTF8; + if (key != keysave) { + if (flags & HVhek_FREEKEY) + Safefree(keysave); flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + } } if (HvREHASH(hv)) { PERL_HASH_INTERNAL(hash, key, klen); - /* Yes, you do need this even though you are not "storing" because + /* We don't have a pointer to the hv, so we have to replicate the + flag into every HEK, so that hv_iterkeysv can see it. */ + /* And yes, you do need this even though you are not "storing" because you can flip the flags below if doing an lval lookup. (And that was put in to give the semantics Andreas was expecting.) */ flags |= HVhek_REHASH; } else if (!hash) { - PERL_HASH(hash, key, klen); + /* Not enough shared hash key scalars around to make this worthwhile + (about 4% slowdown in perlbench with this in) + if (keysv && (SvIsCOW_shared_hash(keysv))) { + hash = SvUVX(keysv); + } else + */ + { + PERL_HASH(hash, key, klen); + } } - /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (; entry; entry = HeNEXT(entry)) { + masked_flags = (flags & HVhek_MASK); + n_links = 0; + +#ifdef DYNAMIC_ENV_FETCH + if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*); + else +#endif + { + /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + } + for (; entry; ++n_links, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; if (HeKLEN(entry) != (I32)klen) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; - if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) + if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; - if (lval && HeKFLAGS(entry) != flags) { - /* We match if HVhek_UTF8 bit in our flags and hash key's match. - But if entry was set previously with HVhek_WASUTF8 and key now - doesn't (or vice versa) then we should change the key's flag, - as this is assignment. */ - if (HvSHAREKEYS(hv)) { - /* Need to swap the key we have for a key with the flags we - need. As keys are shared we can't just write to the flag, - so we share the new one, unshare the old one. */ - int flags_nofree = flags & ~HVhek_FREEKEY; - HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree); - unshare_hek (HeKEY_hek(entry)); - HeKEY_hek(entry) = new_hek; - } - else - HeKFLAGS(entry) = flags; - if (flags & HVhek_ENABLEHVKFLAGS) - HvHASKFLAGS_on(hv); - } - if (key != keysave) - Safefree(key); - /* if we find a placeholder, we pretend we haven't found anything */ - if (HeVAL(entry) == &PL_sv_placeholder) + + if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) { + if (HeKFLAGS(entry) != masked_flags) { + /* We match if HVhek_UTF8 bit in our flags and hash key's + match. But if entry was set previously with HVhek_WASUTF8 + and key now doesn't (or vice versa) then we should change + the key's flag, as this is assignment. */ + if (HvSHAREKEYS(hv)) { + /* Need to swap the key we have for a key with the flags we + need. As keys are shared we can't just write to the + flag, so we share the new one, unshare the old one. */ + HEK *new_hek = share_hek_flags(key, klen, hash, + masked_flags); + unshare_hek (HeKEY_hek(entry)); + HeKEY_hek(entry) = new_hek; + } + else + HeKFLAGS(entry) = masked_flags; + if (masked_flags & HVhek_ENABLEHVKFLAGS) + HvHASKFLAGS_on(hv); + } + if (HeVAL(entry) == &PL_sv_placeholder) { + /* yes, can store into placeholder slot */ + if (action & HV_FETCH_LVALUE) { + if (SvMAGICAL(hv)) { + /* This preserves behaviour with the old hv_fetch + implementation which at this point would bail out + with a break; (at "if we find a placeholder, we + pretend we haven't found anything") + + That break mean that if a placeholder were found, it + caused a call into hv_store, which in turn would + check magic, and if there is no magic end up pretty + much back at this point (in hv_store's code). */ + break; + } + /* LVAL fetch which actaully needs a store. */ + val = NEWSV(61,0); + xhv->xhv_placeholders--; + } else { + /* store */ + if (val != &PL_sv_placeholder) + xhv->xhv_placeholders--; + } + HeVAL(entry) = val; + } else if (action & HV_FETCH_ISSTORE) { + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + } + } else if (HeVAL(entry) == &PL_sv_placeholder) { + /* if we find a placeholder, we pretend we haven't found + anything */ break; + } + if (flags & HVhek_FREEKEY) + Safefree(key); return entry; } #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ - if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { + if (!(action & HV_FETCH_ISSTORE) + && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { unsigned long len; char *env = PerlEnv_ENVgetenv_len(key,&len); if (env) { sv = newSVpvn(env,len); SvTAINTED_on(sv); - return hv_store_ent(hv,keysv,sv,hash); + return hv_fetch_common(hv,keysv,key,klen,flags,HV_FETCH_ISSTORE,sv, + hash); } } #endif - if (!entry && SvREADONLY(hv)) { + + if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) { S_hv_notallowed(aTHX_ flags, key, klen, "access disallowed key '%"SVf"' in" ); } - if (flags & HVhek_FREEKEY) - Safefree(key); - if (lval) { /* gonna assign to this, so it better be there */ - sv = NEWSV(61,0); - return hv_store_ent(hv,keysv,sv,hash); - } - return 0; -} - -STATIC void -S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store) -{ - MAGIC *mg = SvMAGIC(hv); - *needs_copy = FALSE; - *needs_store = TRUE; - while (mg) { - if (isUPPER(mg->mg_type)) { - *needs_copy = TRUE; - switch (mg->mg_type) { - case PERL_MAGIC_tied: - case PERL_MAGIC_sig: - *needs_store = FALSE; - } - } - mg = mg->mg_moremagic; - } -} - -/* -=for apidoc hv_store - -Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is -the length of the key. The C<hash> parameter is the precomputed hash -value; if it is zero then Perl will compute it. The return value will be -NULL if the operation failed or if the value did not need to be actually -stored within the hash (as in the case of tied hashes). Otherwise it can -be dereferenced to get the original C<SV*>. Note that the caller is -responsible for suitably incrementing the reference count of C<val> before -the call, and decrementing it if the function returned NULL. Effectively -a successful hv_store takes ownership of one reference to C<val>. This is -usually what you want; a newly created SV has a reference count of one, so -if all your code does is create SVs then store them in a hash, hv_store -will own the only reference to the new SV, and your code doesn't need to do -anything further to tidy up. hv_store is not implemented as a call to -hv_store_ent, and does not create a temporary SV for the key, so if your -key data is not already in SV form then use hv_store in preference to -hv_store_ent. - -See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more -information on how to use this function on tied hashes. - -=cut -*/ - -SV** -Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash) -{ - bool is_utf8 = FALSE; - const char *keysave = key; - int flags = 0; - - if (klen < 0) { - klen = -klen; - is_utf8 = TRUE; - } - - if (is_utf8) { - STRLEN tmplen = klen; - /* Just casting the &klen to (STRLEN) won't work well - * if STRLEN and I32 are of different widths. --jhi */ - key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8); - klen = tmplen; - /* If we were able to downgrade here, then than means that we were - passed in a key which only had chars 0-255, but was utf8 encoded. */ - if (is_utf8) - flags = HVhek_UTF8; - /* If we found we were able to downgrade the string to bytes, then - we should flag that it needs upgrading on keys or each. */ - if (key != keysave) - flags |= HVhek_WASUTF8 | HVhek_FREEKEY; - } - - return hv_store_flags (hv, key, klen, val, hash, flags); -} - -SV** -Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, - register U32 hash, int flags) -{ - register XPVHV* xhv; - register U32 n_links; - register HE *entry; - register HE **oentry; - - if (!hv) + if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) { + /* Not doing some form of store, so return failure. */ + if (flags & HVhek_FREEKEY) + Safefree(key); return 0; - - xhv = (XPVHV*)SvANY(hv); - if (SvMAGICAL(hv)) { - bool needs_copy; - bool needs_store; - hv_magic_check (hv, &needs_copy, &needs_store); - if (needs_copy) { - mg_copy((SV*)hv, val, key, klen); - if (!xhv->xhv_array /* !HvARRAY */ && !needs_store) { - if (flags & HVhek_FREEKEY) - Safefree(key); - return 0; - } -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - key = savepvn(key,klen); - key = (const char*)strupr((char*)key); - hash = 0; - } -#endif + } + if (action & HV_FETCH_LVALUE) { + val = NEWSV(61,0); + if (SvMAGICAL(hv)) { + /* At this point the old hv_fetch code would call to hv_store, + which in turn might do some tied magic. So we need to make that + magic check happen. */ + /* gonna assign to this, so it better be there */ + return hv_fetch_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE, val, hash); + /* XXX Surely that could leak if the fetch-was-store fails? + Just like the hv_fetch. */ } } - if (flags) - HvHASKFLAGS_on((SV*)hv); + /* Welcome to hv_store... */ - if (HvREHASH(hv)) { - /* We don't have a pointer to the hv, so we have to replicate the - flag into every HEK, so that hv_iterkeysv can see it. */ - flags |= HVhek_REHASH; - PERL_HASH_INTERNAL(hash, key, klen); - } else if (!hash) - PERL_HASH(hash, key, klen); - - if (!xhv->xhv_array /* !HvARRAY(hv) */) - Newz(505, xhv->xhv_array /* HvARRAY(hv) */, + if (!xhv->xhv_array) { + /* Not sure if we can get here. I think the only case of oentry being + NULL is for %ENV with dynamic env fetch. But that should disappear + with magic in the previous code. */ + Newz(503, xhv->xhv_array /* HvARRAY(hv) */, PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), char); - - /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - - n_links = 0; - - for (entry = *oentry; entry; ++n_links, entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) - continue; - if (HeVAL(entry) == &PL_sv_placeholder) - xhv->xhv_placeholders--; /* yes, can store into placeholder slot */ - else - SvREFCNT_dec(HeVAL(entry)); - if (flags & HVhek_PLACEHOLD) { - /* We have been requested to insert a placeholder. Currently - only Storable is allowed to do this. */ - xhv->xhv_placeholders++; - HeVAL(entry) = &PL_sv_placeholder; - } else - HeVAL(entry) = val; - - if (HeKFLAGS(entry) != flags) { - /* We match if HVhek_UTF8 bit in our flags and hash key's match. - But if entry was set previously with HVhek_WASUTF8 and key now - doesn't (or vice versa) then we should change the key's flag, - as this is assignment. */ - if (HvSHAREKEYS(hv)) { - /* Need to swap the key we have for a key with the flags we - need. As keys are shared we can't just write to the flag, - so we share the new one, unshare the old one. */ - int flags_nofree = flags & ~HVhek_FREEKEY; - HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree); - unshare_hek (HeKEY_hek(entry)); - HeKEY_hek(entry) = new_hek; - } - else - HeKFLAGS(entry) = flags; - } - if (flags & HVhek_FREEKEY) - Safefree(key); - return &HeVAL(entry); } - if (SvREADONLY(hv)) { - S_hv_notallowed(aTHX_ flags, key, klen, - "access disallowed key '%"SVf"' to" - ); - } + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; entry = new_HE(); /* share_hek_flags will do the free for us. This might be considered @@ -714,22 +753,21 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); else /* gotta do the real thing */ HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); - if (flags & HVhek_PLACEHOLD) { - /* We have been requested to insert a placeholder. Currently - only Storable is allowed to do this. */ - xhv->xhv_placeholders++; - HeVAL(entry) = &PL_sv_placeholder; - } else - HeVAL(entry) = val; + HeVAL(entry) = val; HeNEXT(entry) = *oentry; *oentry = entry; + if (val == &PL_sv_placeholder) + xhv->xhv_placeholders++; + if (masked_flags & HVhek_ENABLEHVKFLAGS) + HvHASKFLAGS_on(hv); + xhv->xhv_keys++; /* HvKEYS(hv)++ */ if (!n_links) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ } else if ((xhv->xhv_keys > (IV)xhv->xhv_max) || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) { - /* Use the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket + /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket splits on a rehashed hash, as we're not going to split it again, and if someone is lucky (evil) enough to get all the keys in one list they could exhaust our memory as we repeatedly double the @@ -738,177 +776,55 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, hsplit(hv); } - return &HeVAL(entry); + return entry; } -/* -=for apidoc hv_store_ent - -Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> -parameter is the precomputed hash value; if it is zero then Perl will -compute it. The return value is the new hash entry so created. It will be -NULL if the operation failed or if the value did not need to be actually -stored within the hash (as in the case of tied hashes). Otherwise the -contents of the return value can be accessed using the C<He?> macros -described here. Note that the caller is responsible for suitably -incrementing the reference count of C<val> before the call, and -decrementing it if the function returned NULL. Effectively a successful -hv_store_ent takes ownership of one reference to C<val>. This is -usually what you want; a newly created SV has a reference count of one, so -if all your code does is create SVs then store them in a hash, hv_store -will own the only reference to the new SV, and your code doesn't need to do -anything further to tidy up. Note that hv_store_ent only reads the C<key>; -unlike C<val> it does not take ownership of it, so maintaining the correct -reference count on C<key> is entirely the caller's responsibility. hv_store -is not implemented as a call to hv_store_ent, and does not create a temporary -SV for the key, so if your key data is not already in SV form then use -hv_store in preference to hv_store_ent. - -See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more -information on how to use this function on tied hashes. - -=cut -*/ - -HE * -Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) +STATIC void +S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store) { - XPVHV* xhv; - char *key; - STRLEN klen; - U32 n_links; - HE *entry; - HE **oentry; - bool is_utf8; - int flags = 0; - char *keysave; - - if (!hv) - return 0; - - xhv = (XPVHV*)SvANY(hv); - if (SvMAGICAL(hv)) { - bool needs_copy; - bool needs_store; - hv_magic_check (hv, &needs_copy, &needs_store); - if (needs_copy) { - bool save_taint = PL_tainted; - if (PL_tainting) - PL_tainted = SvTAINTED(keysv); - keysv = sv_2mortal(newSVsv(keysv)); - mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); - TAINT_IF(save_taint); - if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store) - return Nullhe; -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - key = SvPV(keysv, klen); - keysv = sv_2mortal(newSVpvn(key,klen)); - (void)strupr(SvPVX(keysv)); - hash = 0; + MAGIC *mg = SvMAGIC(hv); + *needs_copy = FALSE; + *needs_store = TRUE; + while (mg) { + if (isUPPER(mg->mg_type)) { + *needs_copy = TRUE; + switch (mg->mg_type) { + case PERL_MAGIC_tied: + case PERL_MAGIC_sig: + *needs_store = FALSE; } -#endif } + mg = mg->mg_moremagic; } +} - keysave = key = SvPV(keysv, klen); - is_utf8 = (SvUTF8(keysv) != 0); - - if (is_utf8) { - key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); - if (is_utf8) - flags = HVhek_UTF8; - if (key != keysave) - flags |= HVhek_WASUTF8 | HVhek_FREEKEY; - HvHASKFLAGS_on((SV*)hv); - } - - if (HvREHASH(hv)) { - /* We don't have a pointer to the hv, so we have to replicate the - flag into every HEK, so that hv_iterkeysv can see it. */ - flags |= HVhek_REHASH; - PERL_HASH_INTERNAL(hash, key, klen); - } else if (!hash) { - PERL_HASH(hash, key, klen); - } - - if (!xhv->xhv_array /* !HvARRAY(hv) */) - Newz(505, xhv->xhv_array /* HvARRAY(hv) */, - PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), - char); - - /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - n_links = 0; - entry = *oentry; - for (; entry; ++n_links, entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) - continue; - if (HeVAL(entry) == &PL_sv_placeholder) - xhv->xhv_placeholders--; /* yes, can store into placeholder slot */ - else - SvREFCNT_dec(HeVAL(entry)); - HeVAL(entry) = val; - if (HeKFLAGS(entry) != flags) { - /* We match if HVhek_UTF8 bit in our flags and hash key's match. - But if entry was set previously with HVhek_WASUTF8 and key now - doesn't (or vice versa) then we should change the key's flag, - as this is assignment. */ - if (HvSHAREKEYS(hv)) { - /* Need to swap the key we have for a key with the flags we - need. As keys are shared we can't just write to the flag, - so we share the new one, unshare the old one. */ - int flags_nofree = flags & ~HVhek_FREEKEY; - HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree); - unshare_hek (HeKEY_hek(entry)); - HeKEY_hek(entry) = new_hek; - } - else - HeKFLAGS(entry) = flags; - } - if (flags & HVhek_FREEKEY) - Safefree(key); - return entry; - } - - if (SvREADONLY(hv)) { - S_hv_notallowed(aTHX_ flags, key, klen, - "access disallowed key '%"SVf"' to" - ); - } +/* +=for apidoc hv_scalar - entry = new_HE(); - /* share_hek_flags will do the free for us. This might be considered - bad API design. */ - if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); - else /* gotta do the real thing */ - HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); - HeVAL(entry) = val; - HeNEXT(entry) = *oentry; - *oentry = entry; +Evaluates the hash in scalar context and returns the result. Handles magic when the hash is tied. - xhv->xhv_keys++; /* HvKEYS(hv)++ */ - if (!n_links) { /* initial entry? */ - xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if ((xhv->xhv_keys > (IV)xhv->xhv_max) - || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) { - /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket - splits on a rehashed hash, as we're not going to split it again, - and if someone is lucky (evil) enough to get all the keys in one - list they could exhaust our memory as we repeatedly double the - number of buckets on every entry. Linear search feels a less worse - thing to do. */ - hsplit(hv); - } +=cut +*/ - return entry; +SV * +Perl_hv_scalar(pTHX_ HV *hv) +{ + MAGIC *mg; + SV *sv; + + if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) { + sv = magic_scalarpack(hv, mg); + return sv; + } + + sv = sv_newmortal(); + if (HvFILL((HV*)hv)) + Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", + (long)HvFILL(hv), (long)HvMAX(hv) + 1); + else + sv_setiv(sv, 0); + + return sv; } /* @@ -923,155 +839,18 @@ will be returned. */ SV * -Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) +Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags) { - register XPVHV* xhv; - register I32 i; - register U32 hash; - register HE *entry; - register HE **oentry; - SV **svp; - SV *sv; - bool is_utf8 = FALSE; + STRLEN klen; int k_flags = 0; - const char *keysave = key; - if (!hv) - return Nullsv; - if (klen < 0) { - klen = -klen; - is_utf8 = TRUE; - } - if (SvRMAGICAL(hv)) { - bool needs_copy; - bool needs_store; - hv_magic_check (hv, &needs_copy, &needs_store); - - if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) { - sv = *svp; - if (SvMAGICAL(sv)) { - mg_clear(sv); - } - if (!needs_store) { - if (mg_find(sv, PERL_MAGIC_tiedelem)) { - /* No longer an element */ - sv_unmagic(sv, PERL_MAGIC_tiedelem); - return sv; - } - return Nullsv; /* element cannot be deleted */ - } -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - sv = sv_2mortal(newSVpvn(key,klen)); - key = strupr(SvPVX(sv)); - } -#endif - } - } - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_array /* !HvARRAY(hv) */) - return Nullsv; - - if (is_utf8) { - STRLEN tmplen = klen; - /* See the note in hv_fetch(). --jhi */ - key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8); - klen = tmplen; - if (is_utf8) - k_flags = HVhek_UTF8; - if (key != keysave) - k_flags |= HVhek_FREEKEY; - } - - if (HvREHASH(hv)) { - PERL_HASH_INTERNAL(hash, key, klen); + if (klen_i32 < 0) { + klen = -klen_i32; + k_flags |= HVhek_UTF8; } else { - PERL_HASH(hash, key, klen); + klen = klen_i32; } - - /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - entry = *oentry; - i = 1; - for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8) - continue; - if (k_flags & HVhek_FREEKEY) - Safefree(key); - /* if placeholder is here, it's already been deleted.... */ - if (HeVAL(entry) == &PL_sv_placeholder) - { - if (SvREADONLY(hv)) - return Nullsv; /* if still SvREADONLY, leave it deleted. */ - else { - /* okay, really delete the placeholder... */ - *oentry = HeNEXT(entry); - if (i && !*oentry) - xhv->xhv_fill--; /* HvFILL(hv)-- */ - if (entry == xhv->xhv_eiter /* HvEITER(hv) */) - HvLAZYDEL_on(hv); - else - hv_free_ent(hv, entry); - xhv->xhv_keys--; /* HvKEYS(hv)-- */ - if (xhv->xhv_keys == 0) - HvHASKFLAGS_off(hv); - xhv->xhv_placeholders--; - return Nullsv; - } - } - else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { - S_hv_notallowed(aTHX_ k_flags, key, klen, - "delete readonly key '%"SVf"' from" - ); - } - - if (flags & G_DISCARD) - sv = Nullsv; - else { - sv = sv_2mortal(HeVAL(entry)); - HeVAL(entry) = &PL_sv_placeholder; - } - - /* - * If a restricted hash, rather than really deleting the entry, put - * a placeholder there. This marks the key as being "approved", so - * we can still access via not-really-existing key without raising - * an error. - */ - if (SvREADONLY(hv)) { - HeVAL(entry) = &PL_sv_placeholder; - /* We'll be saving this slot, so the number of allocated keys - * doesn't go down, but the number placeholders goes up */ - xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */ - } else { - *oentry = HeNEXT(entry); - if (i && !*oentry) - xhv->xhv_fill--; /* HvFILL(hv)-- */ - if (entry == xhv->xhv_eiter /* HvEITER(hv) */) - HvLAZYDEL_on(hv); - else - hv_free_ent(hv, entry); - xhv->xhv_keys--; /* HvKEYS(hv)-- */ - if (xhv->xhv_keys == 0) - HvHASKFLAGS_off(hv); - } - return sv; - } - if (SvREADONLY(hv)) { - S_hv_notallowed(aTHX_ k_flags, key, klen, - "access disallowed key '%"SVf"' from" - ); - } - - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return Nullsv; + return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0); } /* @@ -1088,68 +867,111 @@ precomputed hash value, or 0 to ask for it to be computed. SV * Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) { + return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash); +} + +SV * +S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, + int k_flags, I32 d_flags, U32 hash) +{ register XPVHV* xhv; register I32 i; - register char *key; - STRLEN klen; register HE *entry; register HE **oentry; SV *sv; bool is_utf8; - int k_flags = 0; - char *keysave; + int masked_flags; if (!hv) return Nullsv; + + if (keysv) { + if (k_flags & HVhek_FREEKEY) + Safefree(key); + key = SvPV(keysv, klen); + k_flags = 0; + is_utf8 = (SvUTF8(keysv) != 0); + } else { + is_utf8 = ((k_flags & HVhek_UTF8) ? TRUE : FALSE); + } + if (SvRMAGICAL(hv)) { bool needs_copy; bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); - if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) { - sv = HeVAL(entry); - if (SvMAGICAL(sv)) { - mg_clear(sv); - } - if (!needs_store) { - if (mg_find(sv, PERL_MAGIC_tiedelem)) { - /* No longer an element */ - sv_unmagic(sv, PERL_MAGIC_tiedelem); - return sv; - } - return Nullsv; /* element cannot be deleted */ - } + if (needs_copy) { + entry = hv_fetch_common(hv, keysv, key, klen, + k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE, + Nullsv, hash); + sv = entry ? HeVAL(entry) : NULL; + if (sv) { + if (SvMAGICAL(sv)) { + mg_clear(sv); + } + if (!needs_store) { + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + /* No longer an element */ + sv_unmagic(sv, PERL_MAGIC_tiedelem); + return sv; + } + return Nullsv; /* element cannot be deleted */ + } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - key = SvPV(keysv, klen); - keysv = sv_2mortal(newSVpvn(key,klen)); - (void)strupr(SvPVX(keysv)); - hash = 0; - } + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + keysv = sv_2mortal(newSVpvn(key,klen)); + if (k_flags & HVhek_FREEKEY) { + Safefree(key); + } + key = strupr(SvPVX(keysv)); + is_utf8 = 0; + k_flags = 0; + hash = 0; + } #endif + } } } xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array /* !HvARRAY(hv) */) return Nullsv; - keysave = key = SvPV(keysv, klen); - is_utf8 = (SvUTF8(keysv) != 0); - if (is_utf8) { - key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); + const char *keysave = key; + key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); + if (is_utf8) - k_flags = HVhek_UTF8; - if (key != keysave) - k_flags |= HVhek_FREEKEY; + k_flags |= HVhek_UTF8; + else + k_flags &= ~HVhek_UTF8; + if (key != keysave) { + if (k_flags & HVhek_FREEKEY) { + /* This shouldn't happen if our caller does what we expect, + but strictly the API allows it. */ + Safefree(keysave); + } + k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + } + HvHASKFLAGS_on((SV*)hv); } if (HvREHASH(hv)) { PERL_HASH_INTERNAL(hash, key, klen); } else if (!hash) { - PERL_HASH(hash, key, klen); + /* Not enough shared hash key scalars around to make this worthwhile + (about 4% slowdown in perlbench with this in) + if (keysv && (SvIsCOW_shared_hash(keysv))) { + hash = SvUVX(keysv); + } else + */ + { + PERL_HASH(hash, key, klen); + } } + masked_flags = (k_flags & HVhek_MASK); + /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; entry = *oentry; @@ -1161,7 +983,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) continue; if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; - if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8) + if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; if (k_flags & HVhek_FREEKEY) Safefree(key); @@ -1192,7 +1014,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) ); } - if (flags & G_DISCARD) + if (d_flags & G_DISCARD) sv = Nullsv; else { sv = sv_2mortal(HeVAL(entry)); @@ -1235,220 +1057,6 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) return Nullsv; } -/* -=for apidoc hv_exists - -Returns a boolean indicating whether the specified hash key exists. The -C<klen> is the length of the key. - -=cut -*/ - -bool -Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) -{ - register XPVHV* xhv; - register U32 hash; - register HE *entry; - SV *sv; - bool is_utf8 = FALSE; - const char *keysave = key; - int k_flags = 0; - - if (!hv) - return 0; - - if (klen < 0) { - klen = -klen; - is_utf8 = TRUE; - } - - if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - sv = sv_newmortal(); - mg_copy((SV*)hv, sv, key, klen); - magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem)); - return (bool)SvTRUE(sv); - } -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - sv = sv_2mortal(newSVpvn(key,klen)); - key = strupr(SvPVX(sv)); - } -#endif - } - - xhv = (XPVHV*)SvANY(hv); -#ifndef DYNAMIC_ENV_FETCH - if (!xhv->xhv_array /* !HvARRAY(hv) */) - return 0; -#endif - - if (is_utf8) { - STRLEN tmplen = klen; - /* See the note in hv_fetch(). --jhi */ - key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8); - klen = tmplen; - if (is_utf8) - k_flags = HVhek_UTF8; - if (key != keysave) - k_flags |= HVhek_FREEKEY; - } - - if (HvREHASH(hv)) { - PERL_HASH_INTERNAL(hash, key, klen); - } else { - PERL_HASH(hash, key, klen); - } - -#ifdef DYNAMIC_ENV_FETCH - if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*); - else -#endif - /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (; entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8) - continue; - if (k_flags & HVhek_FREEKEY) - Safefree(key); - /* If we find the key, but the value is a placeholder, return false. */ - if (HeVAL(entry) == &PL_sv_placeholder) - return FALSE; - - return TRUE; - } -#ifdef DYNAMIC_ENV_FETCH /* is it out there? */ - if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { - unsigned long len; - char *env = PerlEnv_ENVgetenv_len(key,&len); - if (env) { - sv = newSVpvn(env,len); - SvTAINTED_on(sv); - (void)hv_store(hv,key,klen,sv,hash); - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return TRUE; - } - } -#endif - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return FALSE; -} - - -/* -=for apidoc hv_exists_ent - -Returns a boolean indicating whether the specified hash key exists. C<hash> -can be a valid precomputed hash value, or 0 to ask for it to be -computed. - -=cut -*/ - -bool -Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) -{ - register XPVHV* xhv; - register char *key; - STRLEN klen; - register HE *entry; - SV *sv; - bool is_utf8; - char *keysave; - int k_flags = 0; - - if (!hv) - return 0; - - if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - SV* svret = sv_newmortal(); - sv = sv_newmortal(); - keysv = sv_2mortal(newSVsv(keysv)); - mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); - magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem)); - return (bool)SvTRUE(svret); - } -#ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv, PERL_MAGIC_env)) { - key = SvPV(keysv, klen); - keysv = sv_2mortal(newSVpvn(key,klen)); - (void)strupr(SvPVX(keysv)); - hash = 0; - } -#endif - } - - xhv = (XPVHV*)SvANY(hv); -#ifndef DYNAMIC_ENV_FETCH - if (!xhv->xhv_array /* !HvARRAY(hv) */) - return 0; -#endif - - keysave = key = SvPV(keysv, klen); - is_utf8 = (SvUTF8(keysv) != 0); - if (is_utf8) { - key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); - if (is_utf8) - k_flags = HVhek_UTF8; - if (key != keysave) - k_flags |= HVhek_FREEKEY; - } - if (HvREHASH(hv)) { - PERL_HASH_INTERNAL(hash, key, klen); - } else if (!hash) - PERL_HASH(hash, key, klen); - -#ifdef DYNAMIC_ENV_FETCH - if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*); - else -#endif - /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */ - entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; - for (; entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8) - continue; - if (k_flags & HVhek_FREEKEY) - Safefree(key); - /* If we find the key, but the value is a placeholder, return false. */ - if (HeVAL(entry) == &PL_sv_placeholder) - return FALSE; - return TRUE; - } -#ifdef DYNAMIC_ENV_FETCH /* is it out there? */ - if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { - unsigned long len; - char *env = PerlEnv_ENVgetenv_len(key,&len); - if (env) { - sv = newSVpvn(env,len); - SvTAINTED_on(sv); - (void)hv_store_ent(hv,keysv,sv,hash); - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return TRUE; - } - } -#endif - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return FALSE; -} - STATIC void S_hsplit(pTHX_ HV *hv) { @@ -1837,7 +1445,7 @@ Perl_hv_clear(pTHX_ HV *hv) xhv = (XPVHV*)SvANY(hv); - if (SvREADONLY(hv)) { + if (SvREADONLY(hv) && xhv->xhv_array != NULL) { /* restricted hash: convert all keys to placeholders */ I32 i; HE* entry; @@ -1858,7 +1466,7 @@ Perl_hv_clear(pTHX_ HV *hv) } } } - return; + goto reset; } hfreeentries(hv); @@ -1872,6 +1480,63 @@ Perl_hv_clear(pTHX_ HV *hv) HvHASKFLAGS_off(hv); HvREHASH_off(hv); + reset: + HvEITER(hv) = NULL; +} + +/* +=for apidoc hv_clear_placeholders + +Clears any placeholders from a hash. If a restricted hash has any of its keys +marked as readonly and the key is subsequently deleted, the key is not actually +deleted but is marked by assigning it a value of &PL_sv_placeholder. This tags +it so it will be ignored by future operations such as iterating over the hash, +but will still allow the hash to have a value reaasigned to the key at some +future point. This function clears any such placeholder keys from the hash. +See Hash::Util::lock_keys() for an example of its use. + +=cut +*/ + +void +Perl_hv_clear_placeholders(pTHX_ HV *hv) +{ + I32 items; + items = (I32)HvPLACEHOLDERS(hv); + if (items) { + HE *entry; + I32 riter = HvRITER(hv); + HE *eiter = HvEITER(hv); + hv_iterinit(hv); + /* This may look suboptimal with the items *after* the iternext, but + it's quite deliberate. We only get here with items==0 if we've + just deleted the last placeholder in the hash. If we've just done + that then it means that the hash is in lazy delete mode, and the + HE is now only referenced in our iterator. If we just quit the loop + and discarded our iterator then the HE leaks. So we do the && the + other way to ensure iternext is called just one more time, which + has the side effect of triggering the lazy delete. */ + while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) + && items) { + SV *val = hv_iterval(hv, entry); + + if (val == &PL_sv_placeholder) { + + /* It seems that I have to go back in the front of the hash + API to delete a hash, even though I have a HE structure + pointing to the very entry I want to delete, and could hold + onto the previous HE that points to it. And it's easier to + go in with SVs as I can then specify the precomputed hash, + and don't have fun and games with utf8 keys. */ + SV *key = hv_iterkeysv(entry); + + hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry)); + items--; + } + } + HvRITER(hv) = riter; + HvEITER(hv) = eiter; + } } STATIC void @@ -2426,7 +2091,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) } if (!found) { entry = new_HE(); - HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags); + HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked); HeVAL(entry) = Nullsv; HeNEXT(entry) = *oentry; *oentry = entry; diff --git a/gnu/usr.bin/perl/installhtml b/gnu/usr.bin/perl/installhtml index 919346a86be..967f0c6d1e3 100644 --- a/gnu/usr.bin/perl/installhtml +++ b/gnu/usr.bin/perl/installhtml @@ -392,6 +392,7 @@ sub split_on_item { print "splitting files by item.\n" if $verbose && $#splititem >= 0; $pwd = getcwd(); my $splitter = absolute_path($pwd, "$splitpod/splitpod"); + my $perl = absolute_path($pwd, $^X); foreach my $pod (@splititem) { # figure out the directory to split into $pod =~ s,^([^/]*)$,/$1,; @@ -412,7 +413,7 @@ sub split_on_item { die "$0: error changing to directory $podroot/$dirname: $!\n"; die "$splitter not found. Use '-splitpod dir' option.\n" unless -f $splitter; - system($^X, $splitter, "../$filename") && + system($perl, $splitter, "../$filename") && warn "$0: error running '$splitter ../$filename'" ." from $podroot/$dirname"; } diff --git a/gnu/usr.bin/perl/installperl b/gnu/usr.bin/perl/installperl index faf89a91076..13d648b961a 100644 --- a/gnu/usr.bin/perl/installperl +++ b/gnu/usr.bin/perl/installperl @@ -103,6 +103,7 @@ Usage $0: [switches] name. -p Don't install the pod files. [This will break use diagnostics;] -netware Install correctly on a Netware server. + -destdir Prefix installation directories by this string. EOT exit; } @@ -128,7 +129,7 @@ close SCRIPTS; if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; } -my @pods = $nopods ? () : (<pod/*.pod>); +my @pods = $nopods ? () : (<pod/*.pod>, 'x2p/a2p.pod'); # Specify here any .pm files that are actually architecture-dependent. # (Those included with XS extensions under ext/ are automatically @@ -405,8 +406,8 @@ if ($Is_VMS) { # We did core file selection during build } else { # [als] hard-coded 'libperl' name... not good! - #@corefiles = <*.h *.inc libperl*.*>; - @corefiles = <*.h *.inc>; + #@corefiles = <*.h *.inc libperl*.* perl*$Config{lib_ext}>; + @corefiles = <*.h *.inc perl*$Config{lib_ext}>; push(@corefiles,<libperl*.*>) unless defined($ENV{"NOLIBINSTALL"}); # AIX needs perl.exp installed as well. @@ -738,14 +739,16 @@ sub link { $packlist->{$xto} = { from => $xfrom, type => 'link' }; }; if ($@) { - warn $@; + warn "Replacing link() with File::Copy::copy(): $@"; print $verbose ? " cp $from $xto\n" : " $xto\n" unless $silent; print " creating new version of $xto\n" if $Is_VMS and -e $to and !$silent; - File::Copy::copy($from, $to) - ? $success++ - : warn "Couldn't copy $from to $to: $!\n" - unless $nonono; + unless ($nonono or File::Copy::copy($from, $to) and ++$success) { + # Might have been that F::C::c can't overwrite the target + warn "Couldn't copy $from to $to: $!\n" + unless -f $to and (chmod(0666, $to), unlink $to) + and File::Copy::copy($from, $to) and ++$success; + } $packlist->{$xto} = { type => 'file' }; } $success; @@ -768,9 +771,12 @@ sub copy { $xto =~ s/^\Q$destdir\E// if $destdir; print $verbose ? " cp $from $xto\n" : " $xto\n" unless $silent; print " creating new version of $xto\n" if $Is_VMS and -e $to and !$silent; - File::Copy::copy($from, $to) - || warn "Couldn't copy $from to $to: $!\n" - unless $nonono; + unless ($nonono or File::Copy::copy($from, $to)) { + # Might have been that F::C::c can't overwrite the target + warn "Couldn't copy $from to $to: $!\n" + unless -f $to and (chmod(0666, $to), unlink $to) + and File::Copy::copy($from, $to); + } $packlist->{$xto} = { type => 'file' }; } @@ -815,7 +821,7 @@ sub installlib { my $name = $_; # Ignore version control directories. - if (($name eq 'CVS' or $name eq 'RCS' or $name eq '.svn') and -d $name) { + if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) { $File::Find::prune = 1; return; } @@ -824,8 +830,15 @@ sub installlib { # .exists files, .PL files, and test files. return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} || $dir =~ m{/t(?:/|$)}; - # ignore the cpan script in lib/CPAN/bin (installed later with other utils) - return if $name eq 'cpan'; + + # XXX xsubpp back out of the list. prove now integrated. Out of order, so + # p4 will conflict on the next update to the following lines: + + # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp + # scripts in lib/ExtUtils, and the prove script in lib/Test/Harness + # (they're installed later with other utils) + return if $name =~ /^(?:cpan|instmodsh|prove)\z/; + # ignore the Makefiles return if $name =~ /^makefile$/i; # ignore the test extensions diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm index c472d58ffd6..d7e34f88a68 100644 --- a/gnu/usr.bin/perl/lib/Benchmark.pm +++ b/gnu/usr.bin/perl/lib/Benchmark.pm @@ -432,7 +432,7 @@ our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); clearcache clearallcache disablecache enablecache); %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ; -$VERSION = 1.051; +$VERSION = 1.052; # --- ':hireswallclock' special handling @@ -890,7 +890,7 @@ sub cmpthese{ @vals = sort { $a->[7] <=> $b->[7] } @vals; # If more than half of the rates are greater than one... - my $display_as_rate = $vals[$#vals>>1]->[7] > 1; + my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0; my @rows; my @col_widths; diff --git a/gnu/usr.bin/perl/lib/CGI.pm b/gnu/usr.bin/perl/lib/CGI.pm index 96bba36edf5..a7dc37ccfcc 100644 --- a/gnu/usr.bin/perl/lib/CGI.pm +++ b/gnu/usr.bin/perl/lib/CGI.pm @@ -18,13 +18,13 @@ use Carp 'croak'; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.7 2003/12/03 03:02:35 millert Exp $ + patches by merlyn'; -$CGI::VERSION='3.00'; +$CGI::revision = '$Id: CGI.pm,v 1.8 2004/04/07 21:33:04 millert Exp $'; +$CGI::VERSION=3.01; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. # $CGITempFile::TMPDIRECTORY = '/usr/tmp'; -use CGI::Util qw(rearrange make_attributes unescape escape expires); +use CGI::Util qw(rearrange make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); #use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN', # 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd']; @@ -210,9 +210,9 @@ if ($OS eq 'VMS') { } if ($needs_binmode) { - $CGI::DefaultClass->binmode(main::STDOUT); - $CGI::DefaultClass->binmode(main::STDIN); - $CGI::DefaultClass->binmode(main::STDERR); + $CGI::DefaultClass->binmode(\*main::STDOUT); + $CGI::DefaultClass->binmode(\*main::STDIN); + $CGI::DefaultClass->binmode(\*main::STDERR); } %EXPORT_TAGS = ( @@ -232,8 +232,8 @@ if ($needs_binmode) { start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], ':cgi'=>[qw/param upload path_info path_translated url self_url script_name cookie Dump raw_cookie request_method query_string Accept user_agent remote_host content_type - remote_addr referer server_name server_software server_port server_protocol - virtual_host remote_ident auth_type http + remote_addr referer server_name server_software server_port server_protocol virtual_port + virtual_host remote_ident auth_type http append save_parameters restore_parameters param_fetch remote_user user_name header redirect import_names put Delete Delete_all url_param cgi_error/], @@ -295,6 +295,7 @@ sub expand_tags { sub new { my($class,@initializer) = @_; my $self = {}; + bless $self,ref $class || $class || $DefaultClass; if (ref($initializer[0]) && (UNIVERSAL::isa($initializer[0],'Apache') @@ -322,9 +323,20 @@ sub new { return $self; } -# We provide a DESTROY method so that the autoloader -# doesn't bother trying to find it. -sub DESTROY { } +# We provide a DESTROY method so that we can ensure that +# temporary files are closed (via Fh->DESTROY) before they +# are unlinked (via CGITempFile->DESTROY) because it is not +# possible to unlink an open file on Win32. We explicitly +# call DESTROY on each, rather than just undefing them and +# letting Perl DESTROY them by garbage collection, in case the +# user is still holding any reference to them as well. +sub DESTROY { + my $self = shift; + foreach my $href (values %{$self->{'.tmpfiles'}}) { + $href->{hndl}->DESTROY if defined $href->{hndl}; + $href->{name}->DESTROY if defined $href->{name}; + } +} sub r { my $self = shift; @@ -333,6 +345,12 @@ sub r { $r; } +sub upload_hook { + my ($self,$hook,$data) = self_or_default(@_); + $self->{'.upload_hook'} = $hook; + $self->{'.upload_data'} = $data; +} + #### Method: param # Returns the value(s)of a named parameter. # If invoked in a list context, returns the @@ -447,12 +465,15 @@ sub init { # quietly read and discard the post my $buffer; my $max = $content_length; - while ($max > 0 && (my $bytes = read(STDIN,$buffer,$max < 10000 ? $max : 10000))) { - $max -= $bytes; + while ($max > 0 && + (my $bytes = $MOD_PERL + ? $self->r->read($buffer,$max < 10000 ? $max : 10000) + : read(STDIN,$buffer,$max < 10000 ? $max : 10000) + )) { + $self->cgi_error("413 Request entity too large"); + last METHOD; } - $self->cgi_error("413 Request entity too large"); - last METHOD; - } + } # Process multipart postings, but only if the initializer is # not defined. @@ -495,6 +516,21 @@ sub init { last METHOD; } + if (defined($fh) && ($fh ne '')) { + while (<$fh>) { + chomp; + last if /^=/; + push(@lines,$_); + } + # massage back into standard format + if ("@lines" =~ /=/) { + $query_string=join("&",@lines); + } else { + $query_string=join("+",@lines); + } + last METHOD; + } + # last chance -- treat it as a string $initializer = $$initializer if ref($initializer) eq 'SCALAR'; $query_string = $initializer; @@ -515,7 +551,7 @@ sub init { } if ($meth eq 'POST') { - $self->read_from_client(\*STDIN,\$query_string,$content_length,0) + $self->read_from_client(\$query_string,$content_length,0) if $content_length > 0; # Some people want to have their cake and eat it too! # Uncomment this line to have the contents of the query string @@ -528,7 +564,15 @@ sub init { # Check the command line and then the standard input for data. # We use the shellwords package in order to behave the way that # UN*X programmers expect. - $query_string = read_from_cmdline() if $DEBUG; + if ($DEBUG) + { + my $cmdline_ret = read_from_cmdline(); + $query_string = $cmdline_ret->{'query_string'}; + if (defined($cmdline_ret->{'subpath'})) + { + $self->path_info($cmdline_ret->{'subpath'}); + } + } } # YL: Begin Change for XML handler 10/19/2001 @@ -655,6 +699,7 @@ sub all_parameters { # put a filehandle into binary mode (DOS) sub binmode { + return unless defined($_[1]) && defined fileno($_[1]); CORE::binmode($_[1]); } @@ -823,18 +868,19 @@ END_OF_FUNC 'new_MultipartBuffer' => <<'END_OF_FUNC', # Create a new multipart buffer sub new_MultipartBuffer { - my($self,$boundary,$length,$filehandle) = @_; - return MultipartBuffer->new($self,$boundary,$length,$filehandle); + my($self,$boundary,$length) = @_; + return MultipartBuffer->new($self,$boundary,$length); } END_OF_FUNC 'read_from_client' => <<'END_OF_FUNC', # Read data from a file handle sub read_from_client { - my($self, $fh, $buff, $len, $offset) = @_; + my($self, $buff, $len, $offset) = @_; local $^W=0; # prevent a warning - return undef unless defined($fh); - return read($fh, $$buff, $len, $offset); + return $MOD_PERL + ? $self->r->read($$buff, $len, $offset) + : read(\*STDIN, $$buff, $len, $offset); } END_OF_FUNC @@ -1300,7 +1346,7 @@ sub header { my($self,@p) = self_or_default(@_); my(@header); - return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE; + return "" if $self->{'.header_printed'}++ and $HEADERS_ONCE; my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], @@ -1530,7 +1576,7 @@ sub _style { : qq(<link rel="stylesheet" type="$type" href="$src"$other>) ) if $src; } - if ($verbatim) { + if ($verbatim) { push(@result, "<style type=\"text/css\">\n$verbatim\n</style>"); } push(@result,style({'type'=>$type},"$cdata_start\n$code\n$cdata_end")) if $code; @@ -1639,6 +1685,7 @@ sub startform { $method = lc($method) || 'post'; $enctype = $enctype || &URL_ENCODED; unless (defined $action) { + $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1)); if (length($ENV{QUERY_STRING})>0) { $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1); @@ -2509,7 +2556,7 @@ sub url { $url .= server_name(); my $port = $self->server_port; $url .= ":" . $port - unless (lc($protocol) eq 'http' && $port == 80) + unless (lc($protocol) eq 'http' && $port == 80) || (lc($protocol) eq 'https' && $port == 443); } return $url if $base; @@ -2850,6 +2897,21 @@ sub server_software { } END_OF_FUNC +#### Method: virtual_port +# Return the server port, taking virtual hosts into account +#### +'virtual_port' => <<'END_OF_FUNC', +sub virtual_port { + my($self) = self_or_default(@_); + my $vh = $self->http('host'); + if ($vh) { + return ($vh =~ /:(\d+)$/)[0] || '80'; + } else { + return $self->server_port(); + } +} +END_OF_FUNC + #### Method: server_port # Return the tcp/ip port the server is running on #### @@ -3062,11 +3124,12 @@ END_OF_FUNC sub read_from_cmdline { my($input,@words); my($query_string); + my($subpath); if ($DEBUG && @ARGV) { @words = @ARGV; } elsif ($DEBUG > 1) { require "shellwords.pl"; - print STDERR "(offline mode: enter name=value pairs on standard input)\n"; + print STDERR "(offline mode: enter name=value pairs on standard input; press ^D or ^Z when done)\n"; chomp(@lines = <STDIN>); # remove newlines $input = join(" ",@lines); @words = &shellwords($input); @@ -3081,7 +3144,12 @@ sub read_from_cmdline { } else { $query_string = join('+',@words); } - return $query_string; + if ($query_string =~ /^(.*?)\?(.*)$/) + { + $query_string = $2; + $subpath = $1; + } + return { 'query_string' => $query_string, 'subpath' => $subpath }; } END_OF_FUNC @@ -3095,8 +3163,8 @@ END_OF_FUNC ##### 'read_multipart' => <<'END_OF_FUNC', sub read_multipart { - my($self,$boundary,$length,$filehandle) = @_; - my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle); + my($self,$boundary,$length) = @_; + my($buffer) = $self->new_MultipartBuffer($boundary,$length); return unless $buffer; my(%header,$body); my $filenumber = 0; @@ -3156,10 +3224,11 @@ sub read_multipart { $seqno += int rand(100); } die "CGI open of tmpfile: $!\n" unless defined $filehandle; - $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode + && defined fileno($filehandle); # if this is an multipart/mixed attachment, save the header - # together with the body for lateron parsing with an external + # together with the body for later parsing with an external # MIME parser module if ( $multipart ) { foreach ( keys %header ) { @@ -3170,9 +3239,15 @@ sub read_multipart { my ($data); local($\) = ''; - while (defined($data = $buffer->read)) { + my $totalbytes; + while (defined($data = $buffer->read)) { + if (defined $self->{'.upload_hook'}) + { + $totalbytes += length($data); + &{$self->{'.upload_hook'}}($filename ,$data, $totalbytes, $self->{'.upload_data'}); + } print $filehandle $data; - } + } # back up to beginning of file seek($filehandle,0,0); @@ -3187,6 +3262,7 @@ sub read_multipart { # Save some information about the uploaded file where we can get # at it later. $self->{'.tmpfiles'}->{fileno($filehandle)}= { + hndl => $filehandle, name => $tmpfile, info => {%header}, }; @@ -3337,6 +3413,8 @@ END_OF_AUTOLOAD ######################## MultipartBuffer #################### package MultipartBuffer; +use constant DEBUG => 0; + # how many bytes to read at a time. We use # a 4K buffer by default. $INITIAL_FILLUNIT = 1024 * 4; @@ -3359,17 +3437,9 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; 'new' => <<'END_OF_FUNC', sub new { - my($package,$interface,$boundary,$length,$filehandle) = @_; + my($package,$interface,$boundary,$length) = @_; $FILLUNIT = $INITIAL_FILLUNIT; - my $IN; - if ($filehandle) { - my($package) = caller; - # force into caller's package if necessary - $IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; - } - $IN = "main::STDIN" unless $IN; - - $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode; + $CGI::DefaultClass->binmode($IN); # if $CGI::needs_binmode; # just do it always # If the user types garbage into the file upload field, # then Netscape passes NOTHING to the server (not good). @@ -3392,7 +3462,7 @@ sub new { } else { # otherwise we find it ourselves my($old); ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line - $boundary = <$IN>; # BUG: This won't work correctly under mod_perl + $boundary = <STDIN>; # BUG: This won't work correctly under mod_perl $length -= length($boundary); chomp($boundary); # remove the CRLF $/ = $old; # restore old line separator @@ -3401,7 +3471,6 @@ sub new { my $self = {LENGTH=>$length, BOUNDARY=>$boundary, - IN=>$IN, INTERFACE=>$interface, BUFFER=>'', }; @@ -3415,7 +3484,7 @@ sub new { unless ($boundary_read) { while ($self->read(0)) { } } - die "Malformed multipart POST\n" if $self->eof; + die "Malformed multipart POST: data truncated\n" if $self->eof; return $retval; } @@ -3428,7 +3497,7 @@ sub readHeader { my($ok) = 0; my($bad) = 0; - local($CRLF) = "\015\012" if $CGI::OS eq 'VMS'; + local($CRLF) = "\015\012" if $CGI::OS eq 'VMS' || $CGI::EBCDIC; do { $self->fillBuffer($FILLUNIT); @@ -3440,10 +3509,18 @@ sub readHeader { } until $ok || $bad; return () if $bad; + #EBCDIC NOTE: translate header into EBCDIC, but watch out for continuation lines! + my($header) = substr($self->{BUFFER},0,$end+2); substr($self->{BUFFER},0,$end+4) = ''; my %return; + if ($CGI::EBCDIC) { + warn "untranslated header=$header\n" if DEBUG; + $header = CGI::Util::ascii2ebcdic($header); + warn "translated header=$header\n" if DEBUG; + } + # See RFC 2045 Appendix A and RFC 822 sections 3.4.8 # (Folding Long Header Fields), 3.4.3 (Comments) # and 3.4.5 (Quoted-Strings). @@ -3466,9 +3543,18 @@ sub readBody { my($self) = @_; my($data); my($returnval)=''; + + #EBCDIC NOTE: want to translate returnval into EBCDIC HERE + while (defined($data = $self->read)) { $returnval .= $data; } + + if ($CGI::EBCDIC) { + warn "untranslated body=$returnval\n" if DEBUG; + $returnval = CGI::Util::ascii2ebcdic($returnval); + warn "translated body=$returnval\n" if DEBUG; + } return $returnval; } END_OF_FUNC @@ -3481,30 +3567,38 @@ sub read { my($self,$bytes) = @_; # default number of bytes to read - $bytes = $bytes || $FILLUNIT; + $bytes = $bytes || $FILLUNIT; # Fill up our internal buffer in such a way that the boundary # is never split between reads. $self->fillBuffer($bytes); + my $boundary_start = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY}) : $self->{BOUNDARY}; + my $boundary_end = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY}.'--') : $self->{BOUNDARY}.'--'; + # Find the boundary in the buffer (it may not be there). - my $start = index($self->{BUFFER},$self->{BOUNDARY}); + my $start = index($self->{BUFFER},$boundary_start); + + warn "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n" if DEBUG; # protect against malformed multipart POST operations die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0); + + #EBCDIC NOTE: want to translate boundary search into ASCII here. + # If the boundary begins the data, then skip past it # and return undef. if ($start == 0) { # clear us out completely if we've hit the last boundary. - if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) { + if (index($self->{BUFFER},$boundary_end)==0) { $self->{BUFFER}=''; $self->{LENGTH}=0; return undef; } # just remove the boundary. - substr($self->{BUFFER},0,length($self->{BOUNDARY}))=''; + substr($self->{BUFFER},0,length($boundary_start))=''; $self->{BUFFER} =~ s/^\012\015?//; return undef; } @@ -3516,7 +3610,7 @@ sub read { # leave enough bytes in the buffer to allow us to read # the boundary. Thanks to Kevin Hendrick for finding # this one. - $bytesToReturn = $bytes - (length($self->{BOUNDARY})+1); + $bytesToReturn = $bytes - (length($boundary_start)+1); } my $returnval=substr($self->{BUFFER},0,$bytesToReturn); @@ -3541,11 +3635,11 @@ sub fillBuffer { my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2; $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead; - # Try to read some data. We may hang here if the browser is screwed up. - my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN}, - \$self->{BUFFER}, + # Try to read some data. We may hang here if the browser is screwed up. + my $bytesRead = $self->{INTERFACE}->read_from_client(\$self->{BUFFER}, $bytesToRead, $bufferLength); + warn "bytesToRead=$bytesToRead, bufferLength=$bufferLength, buffer=$self->{BUFFER}\n" if DEBUG; $self->{BUFFER} = '' unless defined $self->{BUFFER}; # An apparent bug in the Apache server causes the read() @@ -4634,11 +4728,8 @@ The redirect() function redirects the browser to a different URL. If you use redirection like this, you should B<not> print out a header as well. -One hint I can offer is that relative links may not work correctly -when you generate a redirection to another document on your site. -This is due to a well-intentioned optimization that some servers use. -The solution to this is to use the full URL (including the http: part) -of the document you are redirecting to. +You should always use full URLs (including the http: or ftp: part) in +redirection requests. Relative URLs will not work correctly. You can also use named arguments: @@ -5544,6 +5635,29 @@ Example: You are free to create a custom HTML page to complain about the error, if you wish. +You can set up a callback that will be called whenever a file upload +is being read during the form processing. This is much like the +UPLOAD_HOOK facility available in Apache::Request, with the exception +that the first argument to the callback is an Apache::Upload object, +here it's the remote filename. + + $q = CGI->new(); + $q->upload_hook(\&hook,$data); + + sub hook + { + my ($filename, $buffer, $bytes_read, $data) = @_; + print "Read $bytes_read bytes of $filename\n"; + } + +If using the function-oriented interface, call the CGI::upload_hook() +method before calling param() or any other CGI functions: + + CGI::upload_hook(\&hook,$data); + +This method is not exported by default. You will have to import it +explicitly if you wish to use it without the CGI:: prefix. + If you are using CGI.pm on a Windows platform and find that binary files get slightly larger when uploaded but that text files remain the same, then you have forgotten to activate binary mode on the output @@ -6393,8 +6507,8 @@ side-by-side frames. CGI.pm has limited support for HTML3's cascading style sheets (css). To incorporate a stylesheet into your document, pass the start_html() method a B<-style> parameter. The value of this -parameter may be a scalar, in which case it is incorporated directly -into a <style> section, or it may be a hash reference. In the latter +parameter may be a scalar, in which case it is treated as the source +URL for the stylesheet, or it may be a hash reference. In the latter case you should provide the hash with one or more of B<-src> or B<-code>. B<-src> points to a URL where an externally-defined stylesheet can be found. B<-code> points to a scalar value to be @@ -6534,6 +6648,11 @@ pairs: your_script.pl "name1='I am a long value'" "name2=two\ words" +Finally, you can set the path info for the script by prefixing the first +name/value parameter with the path followed by a question mark (?): + + your_script.pl /your/path/here?name1=value1&name2=value2 + =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS The Dump() method produces a string consisting of all the query's @@ -6662,6 +6781,11 @@ the browser attempted to contact Return the port that the server is listening on. +=item B<virtual_port ()> + +Like server_port() except that it takes virtual hosts into account. +Use this when running with virtual hosts. + =item B<server_software ()> Returns the server software and version number. diff --git a/gnu/usr.bin/perl/lib/CGI/Carp.pm b/gnu/usr.bin/perl/lib/CGI/Carp.pm index b99004189d3..255b9e758a6 100644 --- a/gnu/usr.bin/perl/lib/CGI/Carp.pm +++ b/gnu/usr.bin/perl/lib/CGI/Carp.pm @@ -243,6 +243,8 @@ non-overridden program name former isn't working in some people's hands. There is no such thing as reliable exception handling in Perl. +1.27 Replaced tell STDOUT with bytes=tell STDOUT. + =head1 AUTHORS Copyright 1995-2002, Lincoln D. Stein. All rights reserved. @@ -279,7 +281,7 @@ use File::Spec; $main::SIG{__WARN__}=\&CGI::Carp::warn; -$CGI::Carp::VERSION = '1.26'; +$CGI::Carp::VERSION = '1.27'; $CGI::Carp::CUSTOM_MSG = undef; @@ -490,7 +492,8 @@ END $r->custom_response(500,$mess); } } else { - if (eval{tell STDOUT}) { + my $bytes_written = eval{tell STDOUT}; + if (defined $bytes_written && $bytes_written > 0) { print STDOUT $mess; } else { diff --git a/gnu/usr.bin/perl/lib/CGI/Cookie.pm b/gnu/usr.bin/perl/lib/CGI/Cookie.pm index 7060fb48273..27a93c55b0d 100644 --- a/gnu/usr.bin/perl/lib/CGI/Cookie.pm +++ b/gnu/usr.bin/perl/lib/CGI/Cookie.pm @@ -220,7 +220,7 @@ sub expires { sub max_age { my $self = shift; my $expires = shift; - $self->{'max-age'} = CGI::Util::expire_calc($expires)-time if defined $expires; + $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires; return $self->{'max-age'}; } diff --git a/gnu/usr.bin/perl/lib/CGI/Fast.pm b/gnu/usr.bin/perl/lib/CGI/Fast.pm index 5f744e3584c..ad7a28eddc7 100644 --- a/gnu/usr.bin/perl/lib/CGI/Fast.pm +++ b/gnu/usr.bin/perl/lib/CGI/Fast.pm @@ -16,7 +16,7 @@ package CGI::Fast; # The most recent version and complete docs are available at: # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ -$CGI::Fast::VERSION='1.041'; +$CGI::Fast::VERSION='1.05'; use CGI; use FCGI; diff --git a/gnu/usr.bin/perl/lib/CGI/Pretty.pm b/gnu/usr.bin/perl/lib/CGI/Pretty.pm index 61aff822565..d824a025e4f 100644 --- a/gnu/usr.bin/perl/lib/CGI/Pretty.pm +++ b/gnu/usr.bin/perl/lib/CGI/Pretty.pm @@ -10,7 +10,7 @@ package CGI::Pretty; use strict; use CGI (); -$CGI::Pretty::VERSION = '1.07_00'; +$CGI::Pretty::VERSION = '1.08'; $CGI::DefaultClass = __PACKAGE__; $CGI::Pretty::AutoloadClass = 'CGI'; @CGI::Pretty::ISA = qw( CGI ); diff --git a/gnu/usr.bin/perl/lib/CGI/Util.pm b/gnu/usr.bin/perl/lib/CGI/Util.pm index e0e7a842283..be104facf91 100644 --- a/gnu/usr.bin/perl/lib/CGI/Util.pm +++ b/gnu/usr.bin/perl/lib/CGI/Util.pm @@ -4,9 +4,10 @@ use strict; use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A); require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(rearrange make_attributes unescape escape expires); +@EXPORT_OK = qw(rearrange make_attributes unescape escape + expires ebcdic2ascii ascii2ebcdic); -$VERSION = '1.31'; +$VERSION = '1.4'; $EBCDIC = "\t" ne "\011"; if ($EBCDIC) { @@ -268,6 +269,18 @@ sub expire_calc { return (time+$offset); } +sub ebcdic2ascii { + my $data = shift; + $data =~ s/(.)/chr $E2A[ord($1)]/ge; + $data; +} + +sub ascii2ebcdic { + my $data = shift; + $data =~ s/(.)/chr $A2E[ord($1)]/ge; + $data; +} + 1; __END__ diff --git a/gnu/usr.bin/perl/lib/CGI/t/carp.t b/gnu/usr.bin/perl/lib/CGI/t/carp.t index dcdf7324108..6d20a4fe9d6 100644 --- a/gnu/usr.bin/perl/lib/CGI/t/carp.t +++ b/gnu/usr.bin/perl/lib/CGI/t/carp.t @@ -8,7 +8,7 @@ use lib qw(t/lib); # ensure the blib's are in @INC, else we might use the core CGI.pm use lib qw(blib/lib blib/arch); -use Test::More tests => 47; +use Test::More tests => 41; use IO::Handle; BEGIN { use_ok('CGI::Carp') }; @@ -68,7 +68,6 @@ like(stamp2(), $stamp, "Time in correct format"); # set some variables to control what's going on. $CGI::Carp::WARN = 0; $CGI::Carp::EMIT_WARNINGS = 0; -@CGI::Carp::WARNINGS = (); my $q_file = quotemeta($file); @@ -82,7 +81,6 @@ $expect_l = __LINE__ + 1; is(CGI::Carp::warn("There is a problem"), "Called realwarn", "CGI::Carp::warn calls CORE::warn"); -is(@CGI::Carp::WARNINGS, 0, "_warn not called"); # Test that message is constructed correctly eval 'sub CGI::Carp::realwarn {my $mess = shift; return $mess};'; @@ -91,21 +89,15 @@ $expect_l = __LINE__ + 1; like(CGI::Carp::warn("There is a problem"), "/] $id: There is a problem at $q_file line $expect_l.".'$/', "CGI::Carp::warn builds correct message"); -is(@CGI::Carp::WARNINGS, 0, "_warn not called"); # Test that _warn is called at the correct time $CGI::Carp::WARN = 1; -$expect_l = __LINE__ + 1; +my $warn_expect_l = $expect_l = __LINE__ + 1; like(CGI::Carp::warn("There is a problem"), "/] $id: There is a problem at $q_file line $expect_l.".'$/', "CGI::Carp::warn builds correct message"); -is(@CGI::Carp::WARNINGS, 1, "_warn now called"); -like($CGI::Carp::WARNINGS[0], - "/There is a problem at $q_file line $expect_l.".'$/', - "CGI::Carp::WARNINGS has correct message (without stamp)"); - #----------------------------------------------------------------------------- # Test ineval #----------------------------------------------------------------------------- @@ -180,9 +172,6 @@ is ($CGI::Carp::PROGNAME,undef,"CGI::Carp::set_progname program name unset corre CGI::Carp::warningsToBrowser(0); is($CGI::Carp::EMIT_WARNINGS, 0, "Warnings turned off"); -unless( is(@CGI::Carp::WARNINGS, 1, "_warn not called") ) { - print join "\n", map "'$_'", @CGI::Carp::WARNINGS; -} # turn off STDOUT (prevents spurious warnings to screen tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT"; @@ -193,11 +182,10 @@ untie *STDOUT; open(STDOUT, ">&REAL_STDOUT"); my $fname = $0; $fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also -is( $fake_out, "<!-- warning: There is a problem at $fname line 100. -->\n", +is( $fake_out, "<!-- warning: There is a problem at $fname line $warn_expect_l. -->\n", 'warningsToBrowser() on' ); is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off"); -is(@CGI::Carp::WARNINGS, 0, "_warn is called"); #----------------------------------------------------------------------------- # Test fatals_to_browser diff --git a/gnu/usr.bin/perl/lib/CGI/t/request.t b/gnu/usr.bin/perl/lib/CGI/t/request.t index 96775a92797..d39619c4908 100644 --- a/gnu/usr.bin/perl/lib/CGI/t/request.t +++ b/gnu/usr.bin/perl/lib/CGI/t/request.t @@ -2,7 +2,7 @@ # Test ability to retrieve HTTP request info ######################### We start with some black magic to print on failure. -use lib '../blib/lib','../blib/arch'; +use lib '.','../blib/lib','../blib/arch'; BEGIN {$| = 1; print "1..33\n"; } END {print "not ok 1\n" unless $loaded;} diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm index 984375fb0f6..51ca5b6f540 100644 --- a/gnu/usr.bin/perl/lib/Cwd.pm +++ b/gnu/usr.bin/perl/lib/Cwd.pm @@ -1,5 +1,4 @@ package Cwd; -use 5.006; =head1 NAME @@ -137,12 +136,14 @@ L<File::chdir> =cut use strict; +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -our $VERSION = '2.08'; +$VERSION = '2.12'; -use base qw/ Exporter /; -our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); -our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); +@ISA = qw/ Exporter /; +@EXPORT = qw(cwd getcwd fastcwd fastgetcwd); +@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # sys_cwd may keep the builtin command @@ -150,16 +151,19 @@ our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # there is no sense to process the rest of the file. # The best choice may be to have this in BEGIN, but how to return from BEGIN? -if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) { +if ($^O eq 'os2') { local $^W = 0; - *cwd = \&sys_cwd; - *getcwd = \&cwd; - *fastgetcwd = \&cwd; - *fastcwd = \&cwd; - *abs_path = \&sys_abspath; - *fast_abs_path = \&abs_path; - *realpath = \&abs_path; - *fast_realpath = \&abs_path; + + *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; + *getcwd = \&cwd; + *fastgetcwd = \&cwd; + *fastcwd = \&cwd; + + *fast_abs_path = \&sys_abspath if defined &sys_abspath; + *abs_path = \&fast_abs_path; + *realpath = \&fast_abs_path; + *fast_realpath = \&fast_abs_path; + return 1; } @@ -191,6 +195,10 @@ unless ($pwd_cmd) { } } +# Lazy-load Carp +sub _carp { require Carp; Carp::carp(@_) } +sub _croak { require Carp; Carp::croak(@_) } + # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; @@ -358,8 +366,7 @@ sub _perl_abs_path unless (@cst = stat( $start )) { - require Carp; - Carp::carp ("stat($start): $!"); + _carp("stat($start): $!"); return ''; } $cwd = ''; @@ -371,14 +378,12 @@ sub _perl_abs_path local *PARENT; unless (opendir(PARENT, $dotdots)) { - require Carp; - Carp::carp ("opendir($dotdots): $!"); + _carp("opendir($dotdots): $!"); return ''; } unless (@cst = stat($dotdots)) { - require Carp; - Carp::carp ("stat($dotdots): $!"); + _carp("stat($dotdots): $!"); closedir(PARENT); return ''; } @@ -392,8 +397,7 @@ sub _perl_abs_path { unless (defined ($dir = readdir(PARENT))) { - require Carp; - Carp::carp ("readdir($dotdots): $!"); + _carp("readdir($dotdots): $!"); closedir(PARENT); return ''; } @@ -426,13 +430,11 @@ sub fast_abs_path { ($cwd) = $cwd =~ /(.*)/; if (!CORE::chdir($path)) { - require Carp; - Carp::croak ("Cannot chdir to $path: $!"); + _croak("Cannot chdir to $path: $!"); } my $realpath = getcwd(); if (! ((-d $cwd) && (CORE::chdir($cwd)))) { - require Carp; - Carp::croak ("Cannot chdir back to $cwd: $!"); + _croak("Cannot chdir back to $cwd: $!"); } $realpath; } @@ -461,8 +463,7 @@ sub _vms_abs_path { my $path = VMS::Filespec::pathify($_[0]); if (! defined $path) { - require Carp; - Carp::croak("Invalid path name $_[0]") + _croak("Invalid path name $_[0]") } return VMS::Filespec::rmsexpand($path); } @@ -545,14 +546,6 @@ sub _epoc_cwd { *abs_path = \&fast_abs_path; *realpath = \&fast_abs_path; } - elsif ($^O eq 'os2') { - # sys_cwd may keep the builtin command - *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; - *getcwd = \&cwd; - *fastgetcwd = \&cwd; - *fastcwd = \&cwd; - *abs_path = \&fast_abs_path; - } elsif ($^O eq 'dos') { *cwd = \&_dos_cwd; *getcwd = \&_dos_cwd; @@ -573,6 +566,7 @@ sub _epoc_cwd { *fastgetcwd = \&cwd; *fastcwd = \&cwd; *abs_path = \&fast_abs_path; + *realpath = \&abs_path; } elsif ($^O eq 'epoc') { *cwd = \&_epoc_cwd; diff --git a/gnu/usr.bin/perl/lib/Digest.t b/gnu/usr.bin/perl/lib/Digest.t deleted file mode 100644 index 5741b777fe2..00000000000 --- a/gnu/usr.bin/perl/lib/Digest.t +++ /dev/null @@ -1,26 +0,0 @@ -print "1..3\n"; - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use Digest; - -my $hexdigest = "900150983cd24fb0d6963f7d28e17f72"; -if (ord('A') == 193) { # EBCDIC - $hexdigest = "fe4ea0d98f9cd8d1d27f102a93cb0bb0"; # IBM-1047 -} - -print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest; -print "ok 1\n"; - -print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest; -print "ok 2\n"; - -eval { - print "not " unless Digest->new("HMAC-MD5" => "Jefe")->add("what do ya want for nothing?")->hexdigest eq "750c783e6ab0b503eaa86e310a5db738"; - print "ok 3\n"; -}; -print "ok 3\n" if $@ && $@ =~ /^Can't locate/; - diff --git a/gnu/usr.bin/perl/lib/Exporter.pm b/gnu/usr.bin/perl/lib/Exporter.pm index 753ea6aab27..176f6b8a98f 100644 --- a/gnu/usr.bin/perl/lib/Exporter.pm +++ b/gnu/usr.bin/perl/lib/Exporter.pm @@ -9,7 +9,7 @@ require 5.006; our $Debug = 0; our $ExportLevel = 0; our $Verbose ||= 0; -our $VERSION = '5.567'; +our $VERSION = '5.57'; our (%Cache); $Carp::Internal{Exporter} = 1; @@ -30,6 +30,11 @@ sub import { my $pkg = shift; my $callpkg = caller($ExportLevel); + if ($pkg eq "Exporter" and @_ and $_[0] eq "import") { + *{$callpkg."::import"} = \&import; + return; + } + # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-( my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"}); return export $pkg, $callpkg, @_ @@ -103,6 +108,12 @@ In module YourModule.pm: @ISA = qw(Exporter); @EXPORT_OK = qw(munge frobnicate); # symbols to export on request +or + + package YourModule; + use Exporter 'import'; # gives you Exporter's import() method directly + @EXPORT_OK = qw(munge frobnicate); # symbols to export on request + In other files which wish to use YourModule: use ModuleName qw(frobnicate); # import listed symbols @@ -286,9 +297,21 @@ Instead, say the following: This will export the symbols one level 'above' the current package - ie: to the program or module that used package A. -Note: Be careful not to modify '@_' at all before you call export_to_level +Note: Be careful not to modify C<@_> at all before you call export_to_level - or people using your package will get very unexplained results! +=head2 Exporting without inheriting from Exporter + +By including Exporter in your @ISA you inherit an Exporter's import() method +but you also inherit several other helper methods which you probably don't +want. To avoid this you can do + + package YourModule; + use Exporter qw( import ); + +which will export Exporter's own import() method into YourModule. +Everything will work as before but you won't need to include Exporter in +@YourModule::ISA. =head2 Module Version Checking diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm index 97987332547..3cd6cd37ce1 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm +++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm @@ -2769,7 +2769,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) require File::Find; File::Find::find(sub { return unless m/\Q$self->{LIB_EXT}\E$/; - return if m/^libperl/; + return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/; # Skip purified versions of libraries (e.g., DynaLoader_pure_p1_c0_032.a) return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure"; diff --git a/gnu/usr.bin/perl/lib/File/CheckTree.pm b/gnu/usr.bin/perl/lib/File/CheckTree.pm index 7884ca711e6..20ffd68124d 100644 --- a/gnu/usr.bin/perl/lib/File/CheckTree.pm +++ b/gnu/usr.bin/perl/lib/File/CheckTree.pm @@ -7,7 +7,7 @@ use File::Spec; use warnings; use strict; -our $VERSION = '4.2'; +our $VERSION = '4.3'; our @ISA = qw(Exporter); our @EXPORT = qw(validate); @@ -50,7 +50,9 @@ The routine returns the number of warnings issued. =head1 AUTHOR -Unknown. Revised by Paul Grassie <F<grassie@perl.com>> in 2002. +File::CheckTree was derived from lib/validate.pl which was +written by Larry Wall. +Revised by Paul Grassie <F<grassie@perl.com>> in 2002. =head1 HISTORY diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm index 0e87e988d52..f5b22e288a0 100644 --- a/gnu/usr.bin/perl/lib/File/Copy.pm +++ b/gnu/usr.bin/perl/lib/File/Copy.pm @@ -24,7 +24,7 @@ sub mv; # package has not yet been updated to work with Perl 5.004, and so it # would be a Bad Thing for the CPAN module to grab it and replace this # module. Therefore, we set this module's version higher than 2.0. -$VERSION = '2.06'; +$VERSION = '2.07'; require Exporter; @ISA = qw(Exporter); @@ -77,13 +77,12 @@ sub copy { croak("'$from' and '$to' are identical (not copied)"); } - if ($Config{d_symlink} && $Config{d_readlink} && - !($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) { - no warnings 'io'; # don't warn if -l on filehandle - if ((-e $from && -l $from) || (-e $to && -l $to)) { - my @fs = stat($from); + if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) && + !($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'vms')) { + my @fs = stat($from); + if (@fs) { my @ts = stat($to); - if (@fs && @ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) { + if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) { croak("'$from' and '$to' are identical (not copied)"); } } diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm index 4c15d384d75..f9fb16b12c2 100644 --- a/gnu/usr.bin/perl/lib/File/Find.pm +++ b/gnu/usr.bin/perl/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.05'; +our $VERSION = '1.06'; require Exporter; require Cwd; @@ -44,27 +44,29 @@ but have subtle differences. find(\&wanted, @directories); find(\%options, @directories); -find() does a breadth-first search over the given @directories in the +C<find()> does a breadth-first search over the given C<@directories> in the order they are given. In essence, it works from the top down. -For each file or directory found the &wanted subroutine is called (see -below for details). Additionally, for each directory found it will go -into that directory and continue the search. +For each file or directory found, the C<&wanted> subroutine is called, +with the return code ignored. (See below for details on how to use +the C<&wanted> function). Additionally, for each directory found, +it will go into that directory and continue the search. =item B<finddepth> finddepth(\&wanted, @directories); finddepth(\%options, @directories); -finddepth() works just like find() except it does a depth-first search. +C<finddepth()> works just like C<find()> except it does a depth-first search. It works from the bottom of the directory tree up. =back =head2 %options -The first argument to find() is either a hash reference describing the -operations to be performed for each file, or a code reference. The +The first argument to C<find()> is either a code reference to your +C<&wanted> function, or a hash reference describing the operations +to be performed for each file. The code reference is described in L<The wanted function> below. Here are the possible keys for the hash: @@ -79,15 +81,15 @@ described in L<The wanted function> below. =item C<bydepth> Reports the name of a directory only AFTER all its entries -have been reported. Entry point finddepth() is a shortcut for -specifying C<{ bydepth =E<gt> 1 }> in the first argument of find(). +have been reported. Entry point C<finddepth()> is a shortcut for +specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>. =item C<preprocess> The value should be a code reference. This code reference is used to -preprocess the current directory. The name of currently processed -directory is in $File::Find::dir. Your preprocessing function is -called after readdir() but before the loop that calls the wanted() +preprocess the current directory. The name of the currently processed +directory is in C<$File::Find::dir>. Your preprocessing function is +called after C<readdir()>, but before the loop that calls the C<wanted()> function. It is called with a list of strings (actually file/directory names) and is expected to return a list of strings. The code can be used to sort the file/directory names alphabetically, numerically, @@ -98,7 +100,7 @@ I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op. The value should be a code reference. It is invoked just before leaving the currently processed directory. It is called in void context with no -arguments. The name of the current directory is in $File::Find::dir. This +arguments. The name of the current directory is in C<$File::Find::dir>. This hook is handy for summarizing a directory, such as calculating its disk usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a no-op. @@ -117,7 +119,7 @@ If either I<follow> or I<follow_fast> is in effect: =item * It is guaranteed that an I<lstat> has been called before the user's -I<wanted()> function is called. This enables fast file checks involving S< _>. +C<wanted()> function is called. This enables fast file checks involving S< _>. =item * @@ -131,7 +133,7 @@ pathname of the file with all symbolic links resolved This is similar to I<follow> except that it may report some files more than once. It does detect cycles, however. Since only symbolic links have to be hashed, this is much cheaper both in space and time. If -processing a file more than once (by the user's I<wanted()> function) +processing a file more than once (by the user's C<wanted()> function) is worse than just taking time, the option I<follow> should be used. =item C<follow_skip> @@ -140,8 +142,10 @@ C<follow_skip==1>, which is the default, causes all files which are neither directories nor symbolic links to be ignored if they are about to be processed a second time. If a directory or a symbolic link are about to be processed a second time, File::Find dies. + C<follow_skip==0> causes File::Find to die if any file is about to be processed a second time. + C<follow_skip==2> causes File::Find to ignore any duplicate files and directories but to proceed normally otherwise. @@ -155,7 +159,7 @@ will be silently ignored. =item C<no_chdir> -Does not C<chdir()> to each directory as it recurses. The wanted() +Does not C<chdir()> to each directory as it recurses. The C<wanted()> function will need to be aware of this, of course. In this case, C<$_> will be the same as C<$File::Find::name>. @@ -183,8 +187,13 @@ including all its sub-directories. The default is to 'die' in such a case. =head2 The wanted function -The wanted() function does whatever verifications you want on each -file and directory. It takes no arguments but rather does its work +The C<wanted()> function does whatever verifications you want on +each file and directory. Note that despite its name, the C<wanted()> +function is a generic callback function, and does B<not> tell +File::Find if a file is "wanted" or not. In fact, its return value +is ignored. + +The wanted function takes no arguments but rather does its work through a collection of variables. =over 4 @@ -199,7 +208,7 @@ through a collection of variables. Don't modify these variables. -For example, when examining the file /some/path/foo.ext you will have: +For example, when examining the file F</some/path/foo.ext> you will have: $File::Find::dir = /some/path/ $_ = foo.ext @@ -251,7 +260,7 @@ produces something like: Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical filehandle that caches the information from the preceding -stat(), lstat(), or filetest. +C<stat()>, C<lstat()>, or filetest. Here's another interesting wanted function. It will find all symbolic links that don't resolve: diff --git a/gnu/usr.bin/perl/lib/FindBin.pm b/gnu/usr.bin/perl/lib/FindBin.pm index 8be9cb6b5af..4610beb2cd3 100644 --- a/gnu/usr.bin/perl/lib/FindBin.pm +++ b/gnu/usr.bin/perl/lib/FindBin.pm @@ -42,13 +42,19 @@ directory. =head1 KNOWN ISSUES If there are two modules using C<FindBin> from different directories -under the same interpreter, this won't work. Since C<FindBin> uses +under the same interpreter, this won't work. Since C<FindBin> uses a C<BEGIN> block, it'll be executed only once, and only the first caller will get it right. This is a problem under mod_perl and other persistent Perl environments, where you shouldn't use this module. Which also means that you should avoid using C<FindBin> in modules that you plan to put -on CPAN. The only way to make sure that C<FindBin> will work is to force -the C<BEGIN> block to be executed again: +on CPAN. To make sure that C<FindBin> will work is to call the C<again> +function: + + use FindBin; + FindBin::again(); # or FindBin->again; + +In former versions of FindBin there was no C<again> function. The +workaround was to force the C<BEGIN> block to be executed again: delete $INC{'FindBin.pm'}; require FindBin; @@ -96,9 +102,9 @@ use File::Spec; %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); @ISA = qw(Exporter); -$VERSION = "1.43"; +$VERSION = "1.44"; -BEGIN +sub init { *Dir = \$Bin; *RealDir = \$RealBin; @@ -179,5 +185,9 @@ BEGIN } } +BEGIN { init } + +*again = \&init; + 1; # Keep require happy diff --git a/gnu/usr.bin/perl/lib/Getopt/Std.pm b/gnu/usr.bin/perl/lib/Getopt/Std.pm index 6c420937636..9bbc24f55a0 100644 --- a/gnu/usr.bin/perl/lib/Getopt/Std.pm +++ b/gnu/usr.bin/perl/lib/Getopt/Std.pm @@ -71,7 +71,7 @@ and version_mess() with the switches string as an argument. @ISA = qw(Exporter); @EXPORT = qw(getopt getopts); -$VERSION = '1.04'; +$VERSION = '1.05'; # uncomment the next line to disable 1.03-backward compatibility paranoia # $STANDARD_HELP_VERSION = 1; diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm index c193b8b4671..9a26f335210 100644 --- a/gnu/usr.bin/perl/lib/Math/BigInt.pm +++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm @@ -18,21 +18,20 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.66'; +$VERSION = '1.68'; use Exporter; @ISA = qw( Exporter ); -@EXPORT_OK = qw( objectify _swap bgcd blcm); -use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/; -use vars qw/$upgrade $downgrade/; -# the following are internal and should never be accessed from the outside -use vars qw/$_trap_nan $_trap_inf/; +@EXPORT_OK = qw( objectify bgcd blcm); +# _trap_inf and _trap_nan are internal and should never be accessed from the +# outside +use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode + $upgrade $downgrade $_trap_nan $_trap_inf/; use strict; # Inside overload, the first arg is always an object. If the original code had -# it reversed (like $x = 2 * $y), then the third paramater indicates this -# swapping. To make it work, we use a helper routine which not only reswaps the -# params, but also makes a new object in this case. See _swap() for details, -# especially the cases of operators with different classes. +# it reversed (like $x = 2 * $y), then the third paramater is true. +# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes +# no difference, but in some cases it does. # For overloaded ops with only one argument we simple use $_[0]->copy() to # preserve the argument. @@ -43,14 +42,6 @@ use strict; use overload '=' => sub { $_[0]->copy(); }, -# '+' and '-' do not use _swap, since it is a triffle slower. If you want to -# override _swap (if ever), then override overload of '+' and '-', too! -# for sub it is a bit tricky to keep b: b-a => -a+b -'-' => sub { my $c = $_[0]->copy; $_[2] ? - $c->bneg()->badd($_[1]) : - $c->bsub( $_[1]) }, -'+' => sub { $_[0]->copy()->badd($_[1]); }, - # some shortcuts for speed (assumes that reversed order of arguments is routed # to normal '+' and we thus can always modify first arg. If this is changed, # this breaks and must be adjusted.) @@ -75,35 +66,62 @@ use overload "$_[1]" cmp $_[0]->bstr() : $_[0]->bstr() cmp "$_[1]" }, -'log' => sub { $_[0]->copy()->blog(); }, +# make cos()/sin()/exp() "work" with BigInt's or subclasses +'cos' => sub { cos($_[0]->numify()) }, +'sin' => sub { sin($_[0]->numify()) }, +'exp' => sub { exp($_[0]->numify()) }, +'atan2' => sub { atan2($_[0]->numify(),$_[1]) }, + +'log' => sub { $_[0]->copy()->blog($_[1]); }, 'int' => sub { $_[0]->copy(); }, 'neg' => sub { $_[0]->copy()->bneg(); }, 'abs' => sub { $_[0]->copy()->babs(); }, 'sqrt' => sub { $_[0]->copy()->bsqrt(); }, '~' => sub { $_[0]->copy()->bnot(); }, -'*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); }, -'/' => sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);}, -'%' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); }, -'**' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); }, -'<<' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); }, -'>>' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); }, - -'&' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); }, -'|' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); }, -'^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); }, - -# can modify arg of ++ and --, so avoid a new-copy for speed, but don't -# use $_[0]->__one(), it modifies $_[0] to be 1! +# for sub it is a bit tricky to keep b: b-a => -a+b +'-' => sub { my $c = $_[0]->copy; $_[2] ? + $c->bneg()->badd($_[1]) : + $c->bsub( $_[1]) }, +'+' => sub { $_[0]->copy()->badd($_[1]); }, +'*' => sub { $_[0]->copy()->bmul($_[1]); }, + +'/' => sub { + $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]); + }, +'%' => sub { + $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]); + }, +'**' => sub { + $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]); + }, +'<<' => sub { + $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]); + }, +'>>' => sub { + $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]); + }, +'&' => sub { + $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]); + }, +'|' => sub { + $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]); + }, +'^' => sub { + $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]); + }, + +# can modify arg of ++ and --, so avoid a copy() for speed, but don't +# use $_[0]->bone(), it would modify $_[0] to be 1! '++' => sub { $_[0]->binc() }, '--' => sub { $_[0]->bdec() }, # if overloaded, O(1) instead of O(N) and twice as fast for small numbers 'bool' => sub { # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/ - # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-( - my $t = !$_[0]->is_zero(); - undef $t if $t == 0; + # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-( + my $t = undef; + $t = 1 if !$_[0]->is_zero(); $t; }, @@ -129,16 +147,21 @@ $downgrade = undef; # default is no downgrade # these are internally, and not to be used from the outside -use constant MB_NEVER_ROUND => 0x0001; +sub MB_NEVER_ROUND () { 0x0001; } $_trap_nan = 0; # are NaNs ok? set w/ config() $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do the low level math + # default is Calc.pm +my %CAN; # cache for $CALC->can(...) my $IMPORT = 0; # was import() called yet? # used to make require work +my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math +my $EMU = 'Math::BigInt::CalcEmu'; # emulate low-level math + ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -147,7 +170,16 @@ sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } sub FETCH { return $round_mode; } sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } -BEGIN { tie $rnd_mode, 'Math::BigInt'; } +BEGIN + { + # tie to enable $rnd_mode to work transparently + tie $rnd_mode, 'Math::BigInt'; + + # set up some handy alias names + *as_int = \&as_number; + *is_pos = \&is_positive; + *is_neg = \&is_negative; + } ############################################################################## @@ -746,6 +778,7 @@ sub bone } else { + # call like: $x->bone($sign,$a,$p,$r); $self->{_a} = $_[0] if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); $self->{_p} = $_[1] @@ -772,8 +805,9 @@ sub bsstr return 'inf'; # +inf } my ($m,$e) = $x->parts(); - my $sign = 'e+'; # e can only be positive - return $m->bstr().$sign.$e->bstr(); + #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt + # 'e+' because E can only be positive in BigInt + $m->bstr() . 'e+' . ${$CALC->_str($e->{value})}; } sub bstr @@ -788,7 +822,7 @@ sub bstr return 'inf'; # +inf } my $es = ''; $es = $x->{sign} if $x->{sign} eq '-'; - return $es.${$CALC->_str($x->{value})}; + $es.${$CALC->_str($x->{value})}; } sub numify @@ -808,7 +842,7 @@ sub numify sub sign { # return the sign of the number: +/-/-inf/+inf/NaN - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign}; } @@ -934,7 +968,7 @@ sub round $r = ${"$c\::round_mode"} unless defined $r; if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/) { - + require Carp; Carp::croak ("Unknown round mode '$r'"); } # now round, by calling either fround or ffround: @@ -953,7 +987,7 @@ sub bnorm { # (numstr or BINT) return BINT # Normalize number -- no-op here - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x; } @@ -1024,7 +1058,7 @@ sub bcmp } # $x && $y both < 0 - $CALC->_acmp($y->{value},$x->{value}); # swaped (lib returns 0,1,-1) + $CALC->_acmp($y->{value},$x->{value}); # swaped acmp (lib returns 0,1,-1) } sub bacmp @@ -1068,7 +1102,7 @@ sub badd } return $x if $x->modify('badd'); - return $upgrade->badd($x,$y,@r) if defined $upgrade && + return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); $r[3] = $y; # no push! @@ -1090,34 +1124,29 @@ sub badd return $x; } - my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs + my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs if ($sx eq $sy) { $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add - $x->{sign} = $sx; } else { my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare if ($a > 0) { - #print "swapped sub (a=$a)\n"; $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap $x->{sign} = $sy; } elsif ($a == 0) { # speedup, if equal, set result to 0 - #print "equal sub, result = 0\n"; $x->{value} = $CALC->_zero(); $x->{sign} = '+'; } else # a < 0 { - #print "unswapped sub (a=$a)\n"; $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub - $x->{sign} = $sx; } } $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; @@ -1126,7 +1155,7 @@ sub badd sub bsub { - # (BINT or num_str, BINT or num_str) return num_str + # (BINT or num_str, BINT or num_str) return BINT # subtract second arg from first, modify first # set up parameters @@ -1175,46 +1204,71 @@ sub binc return $x; } # inf, nan handling etc - $x->badd($self->__one(),$a,$p,$r); # badd does round + $x->badd($self->bone(),$a,$p,$r); # badd does round } sub bdec { # decrement arg by one - my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bdec'); - my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+'; - # <= 0 - if (($x->{sign} eq '-') || $zero) + if ($x->{sign} eq '-') { + # < 0 $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 - $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - return $x; - } - # > 0 - elsif ($x->{sign} eq '+') + } + else { - $x->{value} = $CALC->_dec($x->{value}); - $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - return $x; + return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf/NaN + # >= 0 + if ($CALC->_is_zero($x->{value})) + { + # == 0 + $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1 + } + else + { + # > 0 + $x->{value} = $CALC->_dec($x->{value}); + } } - # inf, nan handling etc - $x->badd($self->__one('-'),$a,$p,$r); # badd does round - } + $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; + $x; + } sub blog { - # not implemented yet - my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - return $upgrade->blog($upgrade->new($x),$base,$a,$p,$r) if defined $upgrade; + # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base + # $base of $x) - return $x->bnan(); + # set up parameters + my ($self,$x,$base,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$base,@r) = objectify(2,$class,@_); + } + + # inf, -inf, NaN, <0 => NaN + return $x->bnan() + if $x->{sign} ne '+' || $base->{sign} ne '+'; + + return $upgrade->blog($upgrade->new($x),$base,@r) if + defined $upgrade && (ref($x) ne $upgrade || ref($base) ne $upgrade); + + if ($CAN{log_int}) + { + my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value}); + return $x->bnan() unless defined $rc; + $x->{value} = $rc; + return $x->round(@r); + } + + require $EMU_LIB; + __emu_blog($self,$x,$base,@r); } - + sub blcm { # (BINT or num_str, BINT or num_str) return BINT @@ -1244,7 +1298,7 @@ sub bgcd $y = __PACKAGE__->new($y) if !ref($y); my $self = ref($y); my $x = $y->copy(); # keep arguments - if ($CALC->can('_gcd')) + if ($CAN{gcd}) { while (@_) { @@ -1273,15 +1327,16 @@ sub bnot my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bnot'); - $x->bneg()->bdec(); # bdec already does round + $x->binc()->bneg(); # binc already does round } +############################################################################## # is_foo test routines +# we don't need $self, so undef instead of ref($_[0]) make it slightly faster sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't @@ -1291,36 +1346,28 @@ sub is_zero sub is_nan { # return true if arg (BINT or num_str) is NaN - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if $x->{sign} eq $nan; - 0; + $x->{sign} eq $nan ? 1 : 0; } sub is_inf { # return true if arg (BINT or num_str) is +-inf - my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - $sign = '' if !defined $sign; - return 1 if $sign eq $x->{sign}; # match ("+inf" eq "+inf") - return 0 if $sign !~ /^([+-]|)$/; + my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); - if ($sign eq '') + if (defined $sign) { - return 1 if ($x->{sign} =~ /^[+-]inf$/); - return 0; + $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf + $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-' + return $x->{sign} =~ /^$sign$/ ? 1 : 0; } - $sign = quotemeta($sign.'inf'); - return 1 if ($x->{sign} =~ /^$sign$/); - 0; + $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity } sub is_one { - # return true if arg (BINT or num_str) is +1 - # or -1 if sign is given - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + # return true if arg (BINT or num_str) is +1, or -1 if sign is given my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $sign = '+' if !defined $sign || $sign ne '-'; @@ -1332,7 +1379,6 @@ sub is_one sub is_odd { # return true when arg (BINT or num_str) is odd, false for even - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't @@ -1342,7 +1388,6 @@ sub is_odd sub is_even { # return true when arg (BINT or num_str) is even, false for odd - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't @@ -1352,28 +1397,23 @@ sub is_even sub is_positive { # return true when arg (BINT or num_str) is positive (>= 0) - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if $x->{sign} =~ /^\+/; - 0; + $x->{sign} =~ /^\+/ ? 1 : 0; # +inf is also positive, but NaN not } sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if ($x->{sign} =~ /^-/); - 0; + $x->{sign} =~ /^-/ ? 1 : 0; # -inf is also negative, but NaN not } sub is_int { # return true when arg (BINT or num_str) is an integer - # always true for BigInt, but different for Floats - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + # always true for BigInt, but different for BigFloats my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't @@ -1550,7 +1590,7 @@ sub bmod return $x->round(@r); } - if ($CALC->can('_mod')) + if ($CAN{mod}) { # calc new sign and in case $y == +/- 1, return $x $x->{value} = $CALC->_mod($x->{value},$y->{value}); @@ -1561,7 +1601,6 @@ sub bmod if ($xsign ne $y->{sign}) { 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 } } @@ -1572,6 +1611,8 @@ sub bmod $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; return $x; } + # disable upgrade temporarily, otherwise endless loop due to bdiv() + local $upgrade = undef; my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds) # modify in place foreach (qw/value sign _a _p/) @@ -1607,57 +1648,19 @@ sub bmodinv # 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')) + if ($CAN{modinv}) { my $sign; ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value}); - $x->bnan() if !defined $x->{value}; # in case no GCD found - return $x if !defined $sign; # already real result - $x->{sign} = $sign; # flip/flop see below - $x->bmod($y); # calc real result + return $x->bnan() if !defined $x->{value}; # in case no GCD found + return $x if !defined $sign; # already real result + $x->{sign} = $sign; # flip/flop see below + $x->bmod($y); # calc real result return $x; } - my ($u, $u1) = ($self->bzero(), $self->bone()); - 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 - # thus saving us one step #2 at the loop end. Typical loop count is 1. Even - # a case with 28 loops still gains about 3% with this layout. - my $q; - ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 - # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate - # two values in $u and $u1, we use only $u1 afterwards) - my $sign = 1; # flip-flop - while (!$b->is_zero()) # found GCD if $b == 0 - { - # the original algorithm had: - # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2 - # The following creates exact the same sequence of numbers in $u1, - # except for the sign ($u1 is now always positive). Since formerly - # the sign of $u1 was alternating between '-' and '+', the $sign - # flip-flop will take care of that, so that at the end of the loop - # we have the real sign of $u1. Keeping numbers positive gains us - # speed since badd() is faster than bsub() and makes it possible - # to have the algorithmn in Calc for even more speed. - - ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2 - $sign = - $sign; # flip sign - - ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again - } - - # 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 $x->bnan() unless $a->is_one(); - $u1->bneg() if $sign != 1; # need to flip? - - $u1->bmod($y); # calc result - $x->{value} = $u1->{value}; # and copy over to $x - $x->{sign} = $u1->{sign}; # to modify in place - $x; + require $EMU_LIB; + __emu_bmodinv($self,$x,$y,@r); } sub bmodpow @@ -1685,34 +1688,15 @@ sub bmodpow # check num for valid values (also NaN if there was no inverse but $exp < 0) return $num->bnan() if $num->{sign} !~ /^[+-]$/; - if ($CALC->can('_modpow')) + if ($CAN{modpow}) { # $mod is positive, sign on $exp is ignored, result also positive $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value}); return $num; } - # in the trivial case, - 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... - - $num->bone(); # keep ref to $num - - my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix - my $len = CORE::length($expbin); - while (--$len >= 0) - { - if( substr($expbin,$len,1) eq '1') - { - $num->bmul($acc)->bmod($mod); - } - $acc->bmul($acc)->bmod($mod); - } - - $num; + require $EMU_LIB; + __emu_bmodpow($self,$num,$exp,$mod,@r); } ############################################################################### @@ -1720,30 +1704,22 @@ sub bmodpow sub bfac { # (BINT or num_str, BINT or num_str) return BINT - # compute factorial numbers - # modifies first argument + # compute factorial number from $x, modify $x in place 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 if $x->{sign} eq '+inf'; # inf => inf + return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN - if ($CALC->can('_fac')) + if ($CAN{fac}) { $x->{value} = $CALC->_fac($x->{value}); return $x->round(@r); } - 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,@r); # last step and also round + require $EMU_LIB; + __emu_bfac($self,$x,@r); } sub bpow @@ -1768,8 +1744,9 @@ sub 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->round(@r) if $x->is_one() || $y->is_one(); + + # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu + if ($x->{sign} eq '-' && $CALC->_is_one($x->{value})) { # if $x == -1 and odd/even y => +1/-1 @@ -1778,44 +1755,18 @@ sub bpow } # 1 ** -y => 1 / (1 ** |y|) # so do test for negative $y after above's clause - return $x->bnan() if $y->{sign} eq '-'; - return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) + return $x->bnan() if $y->{sign} eq '-' && !$x->is_one(); - if ($CALC->can('_pow')) + if ($CAN{pow}) { $x->{value} = $CALC->_pow($x->{value},$y->{value}); + $x->{sign} = '+' if $CALC->_is_zero($y->{value}); $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 -# works faster if numbers are small: we count trailing zeros (this step is -# O(1)..O(N), but in case of O(N) we save much more time due to this), -# 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 since brsft/blsft use bpow sometimes. -# my $zeros = $x->_trailing_zeros(); -# if ($zeros > 0) -# { -# $x->brsft($zeros,10); # remove zeros -# $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(@r); -# } - - my $pow2 = $self->__one(); - my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//; - my $len = CORE::length($y_bin); - while (--$len > 0) - { - $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd? - $x->bmul($x); - } - $x->bmul($pow2); - $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - $x; + require $EMU_LIB; + __emu_bpow($self,$x,$y,@r); } sub blsft @@ -1837,13 +1788,13 @@ sub blsft $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'); + my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CAN{lsft}; if (defined $t) { $x->{value} = $t; return $x->round(@r); } # fallback - return $x->bmul( $self->bpow($n, $y, @r), @r ); + $x->bmul( $self->bpow($n, $y, @r), @r ); } sub brsft @@ -1899,10 +1850,11 @@ sub brsft $x->{value} = $res->{value}; # take over value return $x->round(@r); # we are done now, magic, isn't? } + # x < 0, n == 2, y == 1 $x->bdec(); # n == 2, but $y == 1: this fixes it } - my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); + my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CAN{rsft}; if (defined $t) { $x->{value} = $t; @@ -1929,40 +1881,26 @@ sub band 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(@r) if $y->is_zero() || $x->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-'); - my $sx = 1; $sx = -1 if $x->{sign} eq '-'; - my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + my $sx = $x->{sign} eq '+' ? 1 : -1; + my $sy = $y->{sign} eq '+' ? 1 : -1; - if ($CALC->can('_and') && $sx == 1 && $sy == 1) + if ($CAN{and} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_and($x->{value},$y->{value}); return $x->round(@r); } - - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new (0x1000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() && !$y1->is_zero()) + + if ($CAN{signed_and}) { - ($x1, $xr) = bdiv($x1, $x10000); - ($y1, $yr) = bdiv($y1, $x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) & $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); } - $x->bneg() if $sign; - $x->round(@r); + + require $EMU_LIB; + __emu_band($self,$x,$y,$sx,$sy,@r); } sub bior @@ -1984,38 +1922,28 @@ sub bior local $Math::BigInt::upgrade = undef; return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - return $x->round(@r) if $y->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-'); - my $sx = 1; $sx = -1 if $x->{sign} eq '-'; - my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + my $sx = $x->{sign} eq '+' ? 1 : -1; + my $sy = $y->{sign} eq '+' ? 1 : -1; + # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior() + # don't use lib for negative values - if ($CALC->can('_or') && $sx == 1 && $sy == 1) + if ($CAN{or} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_or($x->{value},$y->{value}); return $x->round(@r); } - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new(0x10000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() || !$y1->is_zero()) + # if lib can do negative values, let it handle this + if ($CAN{signed_or}) { - ($x1, $xr) = bdiv($x1,$x10000); - ($y1, $yr) = bdiv($y1,$x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) | $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); } - $x->bneg() if $sign; - $x->round(@r); + + require $EMU_LIB; + __emu_bior($self,$x,$y,$sx,$sy,@r); } sub bxor @@ -2034,49 +1962,35 @@ sub bxor 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->round(@r) if $y->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if $x->{sign} ne $y->{sign}; - my $sx = 1; $sx = -1 if $x->{sign} eq '-'; - my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + my $sx = $x->{sign} eq '+' ? 1 : -1; + my $sy = $y->{sign} eq '+' ? 1 : -1; # don't use lib for negative values - if ($CALC->can('_xor') && $sx == 1 && $sy == 1) + if ($CAN{xor} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_xor($x->{value},$y->{value}); return $x->round(@r); } - - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new(0x10000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() || !$y1->is_zero()) + + # if lib can do negative values, let it handle this + if ($CAN{signed_xor}) { - ($x1, $xr) = bdiv($x1, $x10000); - ($y1, $yr) = bdiv($y1, $x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); } - $x->bneg() if $sign; - $x->round(@r); + + require $EMU_LIB; + __emu_bxor($self,$x,$y,$sx,$sy,@r); } sub length { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); my $e = $CALC->_len($x->{value}); - return wantarray ? ($e,0) : $e; + wantarray ? ($e,0) : $e; } sub digit @@ -2089,13 +2003,13 @@ sub digit sub _trailing_zeros { - # return the amount of trailing zeros in $x + # return the amount of trailing zeros in $x (as scalar) my $x = shift; $x = $class->new($x) unless ref $x; return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; - return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); + return $CALC->_zeros($x->{value}) if $CAN{zeros}; # if not: since we do not know underlying internal representation: my $es = "$x"; $es =~ /([0]*)$/; @@ -2112,35 +2026,17 @@ sub bsqrt return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf - return $x->round(@r) if $x->is_zero() || $x->is_one(); # 0,1 => 0,1 return $upgrade->bsqrt($x,@r) if defined $upgrade; - if ($CALC->can('_sqrt')) + if ($CAN{sqrt}) { $x->{value} = $CALC->_sqrt($x->{value}); return $x->round(@r); } - return $x->bone('+',@r) if $x < 4; # 2,3 => 1 - my $y = $x->copy(); - my $l = int($x->length()/2); - - $x->bone(); # keep ref($x), but modify it - $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2)) - - my $last = $self->bzero(); - my $two = $self->new(2); - my $lastlast = $self->bzero(); - #my $lastlast = $x+$two; - while ($last != $x && $lastlast != $x) - { - $lastlast = $last; $last = $x->copy(); - $x->badd($y / $x); - $x->bdiv($two); - } - $x->bdec() if $x * $x > $y; # overshot? - $x->round(@r); + require $EMU_LIB; + __emu_bsqrt($self,$x,@r); } sub broot @@ -2155,7 +2051,7 @@ sub broot # objectify is costly, so avoid it if ((!ref($x)) || (ref($x) ne ref($y))) { - ($self,$x,$y,@r) = $self->objectify(2,@_); + ($self,$x,$y,@r) = objectify(2,$self || $class,@_); } return $x if $x->modify('broot'); @@ -2169,54 +2065,14 @@ sub broot return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade; - if ($CALC->can('_root')) + if ($CAN{root}) { $x->{value} = $CALC->_root($x->{value},$y->{value}); return $x->round(@r); } - return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root - - # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2): - return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1 - - my $num = $x->numify(); - - if ($num <= 1000000) - { - $x = $self->new( int($num ** (1 / $y->numify()) )); - return $x->round(@r); - } - - # if $n is a power of two, we can repeatedly take sqrt($X) and find the - # proper result, because sqrt(sqrt($x)) == root($x,4) - # See Calc.pm for more details - my $b = $y->as_bin(); - if ($b =~ /0b1(0+)/) - { - my $count = CORE::length($1); # 0b100 => len('00') => 2 - my $cnt = $count; # counter for loop - my $shift = $self->new(6); - $x->blsft($shift); # add some zeros (even amount) - while ($cnt-- > 0) - { - # 'inflate' $X by adding more zeros - $x->blsft($shift); - # calculate sqrt($x), $x is now a bit too big, again. In the next - # round we make even bigger, again. - $x->bsqrt($x); - } - # $x is still to big, so truncate result - $x->brsft($shift); - } - else - { - # Should compute a guess of the result (by rule of thumb), then improve it - # via Newton's method or something similiar. - # XXX TODO - warn ('broot() not fully implemented in BigInt.'); - } - return $x->round(@r); + require $EMU_LIB; + __emu_broot($self,$x,$y,@r); } sub exponent @@ -2226,13 +2082,12 @@ sub exponent if ($x->{sign} !~ /^[+-]$/) { - my $s = $x->{sign}; $s =~ s/^[+-]//; - return $self->new($s); # -inf,+inf => inf + my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf + return $self->new($s); } - my $e = $class->bzero(); - return $e->binc() if $x->is_zero(); - $e += $x->_trailing_zeros(); - $e; + return $self->bone() if $x->is_zero(); + + $self->new($x->_trailing_zeros()); } sub mantissa @@ -2242,10 +2097,11 @@ sub mantissa if ($x->{sign} !~ /^[+-]$/) { - return $self->new($x->{sign}); # keep + or - sign + # for NaN, +inf, -inf: keep the sign + return $self->new($x->{sign}); } - my $m = $x->copy(); - # that's inefficient + my $m = $x->copy(); delete $m->{_p}; delete $m->{_a}; + # that's a bit inefficient: my $zeros = $m->_trailing_zeros(); $m->brsft($zeros,10) if $zeros != 0; $m; @@ -2254,9 +2110,9 @@ sub mantissa sub parts { # return a copy of both the exponent and the mantissa - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return ($x->mantissa(),$x->exponent()); + ($x->mantissa(),$x->exponent()); } ############################################################################## @@ -2267,18 +2123,14 @@ sub bfround # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 || $n == 1 => round to integer my $x = shift; $x = $class->new($x) unless ref $x; + my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_); - return $x if !defined $scale; # no-op - return $x if $x->modify('bfround'); + + return $x if !defined $scale || $x->modify('bfround'); # no-op # no-op for BigInts if $n <= 0 - if ($scale <= 0) - { - $x->{_a} = undef; # clear an eventual set A - $x->{_p} = $scale; return $x; - } + $x->bround( $x->length()-$scale, $mode) if $scale > 0; - $x->bround( $x->length()-$scale, $mode); $x->{_a} = undef; # bround sets {_a} $x->{_p} = $scale; # so correct it $x; @@ -2286,9 +2138,8 @@ sub bfround sub _scan_for_nonzero { - my $x = shift; - my $pad = shift; - my $xs = shift; + # internal, used by bround() + my ($x,$pad,$xs) = @_; my $len = $x->length(); return 0 if $len == 1; # '5' is trailed by invisible zeros @@ -2296,18 +2147,16 @@ sub _scan_for_nonzero return 0 if $follow > $len || $follow < 1; # 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]/; - 0; + $r =~ /[^0]/ ? 1 : 0; } sub fround { - # to make life easier for switch between MBF and MBI (autoload fxxx() - # like MBF does for bxxx()?) + # Exists to make life easier for switch between MBF and MBI (should we + # autoload fxxx() like MBF does for bxxx()?) my $x = shift; - return $x->bround(@_); + $x->bround(@_); } sub bround @@ -2418,61 +2267,67 @@ sub bround sub bfloor { - # return integer less or equal then number, since it is already integer, - # always returns $self - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + # return integer less or equal then number; no-op since it's already integer + my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } sub bceil { - # return integer greater or equal then number, since it is already integer, - # always returns $self - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + # return integer greater or equal then number; no-op since it's already int + my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } -############################################################################## -# private stuff (internal use only) +sub as_number + { + # An object might be asked to return itself as bigint on certain overloaded + # operations, this does exactly this, so that sub classes can simple inherit + # it or override with their own integer conversion routine. + $_[0]->copy(); + } -sub __one +sub as_hex { - # internal speedup, set argument to 1, or create a +/- 1 - my $self = shift; - my $x = $self->bone(); # $x->{value} = $CALC->_one(); - $x->{sign} = shift || '+'; - $x; + # return as hex string, with prefixed 0x + my $x = shift; $x = $class->new($x) if !ref($x); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + + my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + if ($CAN{as_hex}) + { + return $s . ${$CALC->_as_hex($x->{value})}; + } + + require $EMU_LIB; + __emu_as_hex(ref($x),$x,$s); } -sub _swap +sub as_bin { - # Overload will swap params if first one is no object ref so that the first - # one is always an object ref. In this case, third param is true. - # This routine is to overcome the effect of scalar,$object creating an object - # of the class of this package, instead of the second param $object. This - # happens inside overload, when the overload section of this package is - # inherited by sub classes. - # For overload cases (and this is used only there), we need to preserve the - # args, hence the copy(). - # You can override this method in a subclass, the overload section will call - # $object->_swap() to make sure it arrives at the proper subclass, with some - # exceptions like '+' and '-'. To make '+' and '-' work, you also need to - # specify your own overload for them. - - # object, (object|scalar) => preserve first and make copy - # scalar, object => swapped, re-swap and create new from first - # (using class of second object, not $class!!) - my $self = shift; # for override in subclass - if ($_[2]) + # return as binary string, with prefixed 0b + my $x = shift; $x = $class->new($x) if !ref($x); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + + my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; + if ($CAN{as_bin}) { - my $c = ref ($_[0]) || $class; # fallback $class should not happen - return ( $c->new($_[1]), $_[0] ); + return $s . ${$CALC->_as_bin($x->{value})}; } - return ( $_[0]->copy(), $_[1] ); + + require $EMU_LIB; + __emu_as_bin(ref($x),$x,$s); + } +############################################################################## +# private stuff (internal use only) + sub objectify { # check for strings, if yes, return objects instead @@ -2574,15 +2429,16 @@ sub import { my $self = shift; - $IMPORT++; + $IMPORT++; # remember we did import() my @a; my $l = scalar @_; for ( my $i = 0; $i < $l ; $i++ ) { if ($_[$i] eq ':constant') { # this causes overlord er load to step in - overload::constant integer => sub { $self->new(shift) }; - overload::constant binary => sub { $self->new(shift) }; + overload::constant + integer => sub { $self->new(shift) }, + binary => sub { $self->new(shift) }; } elsif ($_[$i] eq 'upgrade') { @@ -2634,7 +2490,23 @@ sub import if ($CALC eq '') { require Carp; - Carp::croak ("Couldn't load any math lib, not even the default"); + Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'"); + } + _fill_can_cache(); + } + +sub _fill_can_cache + { + # fill $CAN with the results of $CALC->can(...) + + %CAN = (); + for my $method (qw/gcd mod modinv modpow fac pow lsft rsft + and signed_and or signed_or xor signed_xor + from_hex as_hex from_bin as_bin + zeros sqrt root log_int log + /) + { + $CAN{$method} = $CALC->can("_$method") ? 1 : 0; } } @@ -2654,17 +2526,17 @@ sub __from_hex my $sign = '+'; $sign = '-' if ($$hs =~ /^-/); $$hs =~ s/^[+-]//; # strip sign - if ($CALC->can('_from_hex')) + if ($CAN{'from_hex'}) { $x->{value} = $CALC->_from_hex($hs); } else { # fallback to pure perl - my $mul = Math::BigInt->bzero(); $mul++; + my $mul = Math::BigInt->bone(); my $x65536 = Math::BigInt->new(65536); - my $len = CORE::length($$hs)-2; - $len = int($len/4); # 4-digit parts, w/o '0x' + my $len = CORE::length($$hs)-2; # minus 2 for 0x + $len = int($len/4); # 4-digit parts, w/o '0x' my $val; my $i = -4; while ($len >= 0) { @@ -2693,15 +2565,15 @@ sub __from_bin my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/); $$bs =~ s/^[+-]//; # strip sign - if ($CALC->can('_from_bin')) + if ($CAN{'from_bin'}) { $x->{value} = $CALC->_from_bin($bs); } else { - my $mul = Math::BigInt->bzero(); $mul++; + my $mul = Math::BigInt->bone(); my $x256 = Math::BigInt->new(256); - my $len = CORE::length($$bs)-2; + my $len = CORE::length($$bs)-2; # minus 2 for 0b $len = int($len/8); # 8-digit parts, w/o '0b' my $val; my $i = -8; while ($len >= 0) @@ -2770,7 +2642,7 @@ sub _split # valid mantissa? return if $m eq '.' || $m eq ''; my ($mi,$mf,$lastf) = split /\./,$m; - return if defined $lastf; # last defined => 1.2.3 or others + return if defined $lastf; # lastf defined => 1.2.3 or others $mi = '0' if !defined $mi; $mi .= '0' if $mi =~ /^[\-\+]?$/; $mf = '0' if !defined $mf || $mf eq ''; @@ -2787,91 +2659,6 @@ sub _split return; # NaN, not a number } -sub as_number - { - # an object might be asked to return itself as bigint on certain overloaded - # operations, this does exactly this, so that sub classes can simple inherit - # it or override with their own integer conversion routine - my $self = shift; - - $self->copy(); - } - -sub as_hex - { - # return as hex string, with prefixed 0x - my $x = shift; $x = $class->new($x) if !ref($x); - - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - - my $es = ''; my $s = ''; - $s = $x->{sign} if $x->{sign} eq '-'; - if ($CALC->can('_as_hex')) - { - $es = ${$CALC->_as_hex($x->{value})}; - } - else - { - return '0x0' if $x->is_zero(); - - my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h); - if ($] >= 5.006) - { - $x10000 = Math::BigInt->new (0x10000); $h = 'h4'; - } - else - { - $x10000 = Math::BigInt->new (0x1000); $h = 'h3'; - } - while (!$x1->is_zero()) - { - ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack($h,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s .= '0x'; - } - $s . $es; - } - -sub as_bin - { - # return as binary string, with prefixed 0b - my $x = shift; $x = $class->new($x) if !ref($x); - - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - - my $es = ''; my $s = ''; - $s = $x->{sign} if $x->{sign} eq '-'; - if ($CALC->can('_as_bin')) - { - $es = ${$CALC->_as_bin($x->{value})}; - } - else - { - return '0b0' if $x->is_zero(); - my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b); - if ($] >= 5.006) - { - $x10000 = Math::BigInt->new (0x10000); $b = 'b16'; - } - else - { - $x10000 = Math::BigInt->new (0x1000); $b = 'b12'; - } - while (!$x1->is_zero()) - { - ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack($b,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s .= '0b'; - } - $s . $es; - } - ############################################################################## # internal calculation routines (others are in Math::BigInt::Calc etc) @@ -2904,7 +2691,7 @@ sub __gcd ############################################################################### # this method return 0 if the object can be modified, or 1 for not -# We use a fast use constant statement here, to avoid costly calls. Subclasses +# We use a fast constant sub() here, to avoid costly calls. Subclasses # may override it with special code (f.i. Math::BigInt::Constant does so) sub modify () { 0; } @@ -2944,8 +2731,8 @@ Math::BigInt - Arbitrary size integer math package $x->is_one('-'); # if $x is -1 $x->is_odd(); # if $x is odd $x->is_even(); # if $x is even - $x->is_positive(); # if $x >= 0 - $x->is_negative(); # if $x < 0 + $x->is_pos(); # if $x >= 0 + $x->is_neg(); # if $x < 0 $x->is_inf(sign); # if $x is +inf, or -inf (sign is default '+') $x->is_int(); # if $x is an integer (not a float) @@ -3022,14 +2809,15 @@ Math::BigInt - Arbitrary size integer math package $x->mantissa(); # return (signed) mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->copy(); # make a true copy of $x (unlike $y = $x;) - $x->as_number(); # return as BigInt (in BigInt: same as copy()) + $x->as_int(); # return as BigInt (in BigInt: same as copy()) + $x->numify(); # return as scalar (might overflow!) # conversation to string (do not modify their argument) $x->bstr(); # normalized string $x->bsstr(); # normalized string in scientific notation $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b - + # precision and accuracy (see section about rounding for more) $x->precision(); # return P of $x (or global, if P of $x undef) @@ -3061,7 +2849,7 @@ and results in an integer, including hexadecimal and binary numbers. Scalars holding numbers may also be passed, but note that non-integer numbers may already have lost precision due to the conversation to float. Quote -your input if you want BigInt to see all the digits. +your input if you want BigInt to see all the digits: $x = Math::BigInt->new(12345678890123456789); # bad $x = Math::BigInt->new('12345678901234567890'); # good @@ -3072,10 +2860,14 @@ This means integer values like 1.01E2 or even 1000E-2 are also accepted. Non-integer values result in NaN. Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('') -results in 'NaN'. +results in 'NaN'. This might change in the future, so use always the following +explicit forms to get a zero or NaN: + + $zero = Math::BigInt->bzero(); + $nan = Math::BigInt->bnan(); C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers -are always stored in normalized form. On a string, it creates a BigInt +are always stored in normalized form. If passed a string, creates a BigInt object from the input. =item Output @@ -3109,15 +2901,15 @@ appropriate information. key Description Example ============================================================ - lib Name of the Math library + lib Name of the low-level math library Math::BigInt::Calc - lib_version Version of 'lib' + lib_version Version of low-level math library (see 'lib') 0.30 - class The class of config you just called + class The class name of config() you just called Math::BigInt - upgrade To which class numbers are upgraded + upgrade To which class math operations might be upgraded Math::BigFloat - downgrade To which class numbers are downgraded + downgrade To which class math operations might be downgraded undef precision Global precision undef @@ -3129,6 +2921,10 @@ appropriate information. 1.61 div_scale Fallback acccuracy for div 40 + trap_nan If true, traps creation of NaN via croak() + 1 + trap_inf If true, traps creation of +inf/-inf via croak() + 1 The following values can be set by passing C<config()> a reference to a hash: @@ -3300,10 +3096,10 @@ like: if ($x == 0) -=head2 is_positive()/is_negative() +=head2 is_pos()/is_neg() - $x->is_positive(); # true if >= 0 - $x->is_negative(); # true if < 0 + $x->is_pos(); # true if >= 0 + $x->is_neg(); # true if < 0 The methods return true if the argument is positive or negative, respectively. C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and @@ -3311,6 +3107,11 @@ C<-inf> is negative. A C<zero> is positive. These methods are only testing the sign, and not the value. +C<is_positive()> and C<is_negative()> are aliase to C<is_pos()> and +C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were +introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced +in v1.68. + =head2 is_odd()/is_even()/is_int() $x->is_odd(); # true if odd, false for even @@ -3341,9 +3142,11 @@ Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef. Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN. -=head2 bcmp +=head2 digit + + $x->digit($n); # return the nth digit, counting from right - $x->digit($n); # return the nth digit, counting from right +If C<$n> is negative, returns the digit counting from left. =head2 bneg @@ -3366,7 +3169,13 @@ numbers. =head2 bnot - $x->bnot(); # two's complement (bit wise not) + $x->bnot(); + +Two's complement (bit wise not). This is equivalent to + + $x->binc()->bneg(); + +but faster. =head2 binc @@ -3416,7 +3225,7 @@ writing $num ** $exp % $mod -because C<bmodpow> is much faster--it reduces internal variables into +because it is much faster - it reduces internal variables into the modulus whenever possible, so it operates on smaller numbers. C<bmodpow> also supports negative exponents. @@ -3531,13 +3340,21 @@ Return the signed mantissa of $x as BigInt. $x->copy(); # make a true copy of $x (unlike $y = $x;) -=head2 as_number +=head2 as_int + + $x->as_int(); - $x->as_number(); # return as BigInt (in BigInt: same as copy()) +Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as +C<copy()>. + +C<as_number()> is an alias to this method. C<as_number> was introduced in +v1.22, while C<as_int()> was only introduced in v1.68. -=head2 bsrt +=head2 bstr + + $x->bstr(); - $x->bstr(); # return normalized string +Returns a normalized string represantation of C<$x>. =head2 bsstr @@ -3555,7 +3372,7 @@ Return the signed mantissa of $x as BigInt. Since version v1.33, Math::BigInt and Math::BigFloat have full support for accuracy and precision based rounding, both automatically after every -operation as well as manually. +operation, as well as manually. This section describes the accuracy/precision handling in Math::Big* as it used to be and as it is now, complete with an explanation of all terms and @@ -3713,7 +3530,7 @@ versions <= 5.7.2) is like this: Actually, the 'difference' added to the scale is calculated from the number of "significant digits" in dividend and divisor, which is derived by looking at the length of the mantissa. Which is wrong, since it includes - the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups + the + sign (oops) and actually gets 2 for '+100' and 4 for '+101'. Oops again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange assumption that 124 has 3 significant digits, while 120/7 will get you '17', not '17.1' since 120 is thought to have 2 significant digits. @@ -3730,23 +3547,26 @@ This is how it works now: =item Setting/Accessing - * You can set the A global via Math::BigInt->accuracy() or - Math::BigFloat->accuracy() or whatever class you are using. - * You can also set P globally by using Math::SomeClass->precision() likewise. + * You can set the A global via C<< Math::BigInt->accuracy() >> or + C<< Math::BigFloat->accuracy() >> or whatever class you are using. + * You can also set P globally by using C<< Math::SomeClass->precision() >> + likewise. * Globals are classwide, and not inherited by subclasses. - * to undefine A, use Math::SomeCLass->accuracy(undef); - * to undefine P, use Math::SomeClass->precision(undef); - * Setting Math::SomeClass->accuracy() clears automatically - Math::SomeClass->precision(), and vice versa. + * to undefine A, use C<< Math::SomeCLass->accuracy(undef); >> + * to undefine P, use C<< Math::SomeClass->precision(undef); >> + * Setting C<< Math::SomeClass->accuracy() >> clears automatically + C<< Math::SomeClass->precision() >>, and vice versa. * To be valid, A must be > 0, P can have any value. * If P is negative, this means round to the P'th place to the right of the decimal point; positive values mean to the left of the decimal point. P of 0 means round to integer. - * to find out the current global A, take Math::SomeClass->accuracy() - * to find out the current global P, take Math::SomeClass->precision() - * use $x->accuracy() respective $x->precision() for the local setting of $x. - * Please note that $x->accuracy() respecive $x->precision() fall back to the - defined globals, when $x's A or P is not set. + * to find out the current global A, use C<< Math::SomeClass->accuracy() >> + * to find out the current global P, use C<< Math::SomeClass->precision() >> + * use C<< $x->accuracy() >> respective C<< $x->precision() >> for the local + setting of C<< $x >>. + * Please note that C<< $x->accuracy() >> respecive C<< $x->precision() >> + return eventually defined global A or P, when C<< $x >>'s A or P is not + set. =item Creating numbers @@ -3761,7 +3581,7 @@ This is how it works now: B<not> be used. This is used by subclasses to create numbers without suffering rounding in the parent. Thus a subclass is able to have it's own globals enforced upon creation of a number by using - $x = Math::BigInt->new($number,undef,undef): + C<< $x = Math::BigInt->new($number,undef,undef) >>: use Math::BigInt::SomeSubclass; use Math::BigInt; @@ -3779,22 +3599,21 @@ This is how it works now: operation according to the rules below * Negative P is ignored in Math::BigInt, since BigInts never have digits after the decimal point - * Math::BigFloat uses Math::BigInts internally, but setting A or P inside - Math::BigInt as globals should not tamper with the parts of a BigFloat. - Thus a flag is used to mark all Math::BigFloat numbers as 'never round' + * Math::BigFloat uses Math::BigInt internally, but setting A or P inside + Math::BigInt as globals does not tamper with the parts of a BigFloat. + A flag is used to mark all Math::BigFloat numbers as 'never round'. =item Precedence * It only makes sense that a number has only one of A or P at a time. - Since you can set/get both A and P, there is a rule that will practically - enforce only A or P to be in effect at a time, even if both are set. - This is called precedence. + If you set either A or P on one object, or globally, the other one will + be automatically cleared. * If two objects are involved in an operation, and one of them has A in effect, and the other P, this results in an error (NaN). - * A takes precendence over P (Hint: A comes before P). If A is defined, it - is used, otherwise P is used. If neither of them is defined, nothing is - used, i.e. the result will have as many digits as it can (with an - exception for fdiv/fsqrt) and will not be rounded. + * A takes precendence over P (Hint: A comes before P). + If neither of them is defined, nothing is used, i.e. the result will have + as many digits as it can (with an exception for fdiv/fsqrt) and will not + be rounded. * There is another setting for fdiv() (and thus for fsqrt()). If neither of A or P is defined, fdiv() will use a fallback (F) of $div_scale digits. If either the dividend's or the divisor's mantissa has more digits than @@ -3805,7 +3624,7 @@ This is how it works now: A, P or F), and, if F is not used, round the result (this will still fail in the case of a result like 0.12345000000001 with A or P of 5, but this can not be helped - or can it?) - * Thus you can have the math done by on Math::Big* class in three modes: + * Thus you can have the math done by on Math::Big* class in two modi: + never round (this is the default): This is done by setting A and P to undef. No math operation will round the result, with fdiv() and fsqrt() as exceptions to guard @@ -3854,10 +3673,11 @@ This is how it works now: =item Local settings - * You can set A and P locally by using $x->accuracy() and $x->precision() + * You can set A or P locally by using C<< $x->accuracy() >> or + C<< $x->precision() >> and thus force different A and P for different objects/numbers. * Setting A or P this way immediately rounds $x to the new value. - * $x->accuracy() clears $x->precision(), and vice versa. + * C<< $x->accuracy() >> clears C<< $x->precision() >>, and vice versa. =item Rounding @@ -3867,12 +3687,12 @@ This is how it works now: * the two rounding functions take as the second parameter one of the following rounding modes (R): 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' - * you can set and get the global R by using Math::SomeClass->round_mode() - or by setting $Math::SomeClass::round_mode - * after each operation, $result->round() is called, and the result may + * you can set/get the global R by using C<< Math::SomeClass->round_mode() >> + or by setting C<< $Math::SomeClass::round_mode >> + * after each operation, C<< $result->round() >> is called, and the result may eventually be rounded (that is, if A or P were set either locally, globally or as parameter to the operation) - * to manually round a number, call $x->round($A,$P,$round_mode); + * to manually round a number, call C<< $x->round($A,$P,$round_mode); >> this will round the number by using the appropriate rounding function and then normalize it. * rounding modifies the local settings of the number: @@ -3911,7 +3731,7 @@ instead relying on the internal hash keys like in C<< $x->{sign}; >>. =head2 MATH LIBRARY Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +C<Math::BigInt::Calc>. This is equivalent to saying: use Math::BigInt lib => 'Calc'; @@ -3924,11 +3744,17 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: use Math::BigInt lib => 'Foo,Math::BigInt::Bar'; -Calc.pm uses as internal format an array of elements of some decimal base -(usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm -uses a bit vector of base 2, most significant bit first. Other modules might -use even different means of representing the numbers. See the respective -module documentation for further details. +Since Math::BigInt::GMP is in almost all cases faster than Calc (especially in +cases involving really big numbers, where it is B<much> faster), and there is +no penalty if Math::BigInt::GMP is not installed, it is a good idea to always +use the following: + + use Math::BigInt lib => 'GMP'; + +Different low-level libraries use different formats to store the +numbers. You should not depend on the number having a specific format. + +See the respective math library module documentation for further details. =head2 SIGN @@ -3952,14 +3778,13 @@ that: C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them in one go. Both the returned mantissa and exponent have a sign. -Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf, -where it will be NaN; and for $x == 0, where it will be 1 -(to be compatible with Math::BigFloat's internal representation of a zero as -C<0E1>). +Currently, for BigInts C<$e> is always 0, except for NaN, +inf and -inf, +where it is C<NaN>; and for C<$x == 0>, where it is C<1> (to be compatible +with Math::BigFloat's internal representation of a zero as C<0E1>). -C<$m> will always be a copy of the original number. The relation between $e -and $m might change in the future, but will always be equivalent in a -numerical sense, e.g. $m might get minimized. +C<$m> is currently just a copy of the original number. The relation between +C<$e> and C<$m> will stay always the same, though their real values might +change. =head1 EXAMPLES @@ -4068,18 +3893,19 @@ more time then the actual addition. With a technique called copy-on-write, the cost of copying with overload could be minimized or even completely avoided. A test implementation of COW did show performance gains for overloaded math, but introduced a performance loss due -to a constant overhead for all other operatons. +to a constant overhead for all other operatons. So Math::BigInt does currently +not COW. -The rewritten version of this module is slower on certain operations, like -new(), bstr() and numify(). The reason are that it does now more work and -handles more cases. The time spent in these operations is usually gained in -the other operations so that programs on the average should get faster. If -they don't, please contect the author. +The rewritten version of this module (vs. v0.01) is slower on certain +operations, like C<new()>, C<bstr()> and C<numify()>. The reason are that it +does now more work and handles much more cases. The time spent in these +operations is usually gained in the other math operations so that code on +the average should get (much) faster. If they don't, please contact the author. Some operations may be slower for small numbers, but are significantly faster -for big numbers. Other operations are now constant (O(1), like bneg(), babs() -etc), instead of O(N) and thus nearly always take much less time. These -optimizations were done on purpose. +for big numbers. Other operations are now constant (O(1), like C<bneg()>, +C<babs()> etc), instead of O(N) and thus nearly always take much less time. +These optimizations were done on purpose. If you find the Calc module to slow, try to install any of the replacement modules and see if they help you. @@ -4236,14 +4062,16 @@ known to be troublesome: =over 1 -=item stringify, bstr(), bsstr() and 'cmp' +=item bstr(), bsstr() and 'cmp' -Both stringify and bstr() now drop the leading '+'. The old code would return -'+3', the new returns '3'. This is to be consistent with Perl and to make -cmp (especially with overloading) to work as you expect. It also solves -problems with Test.pm, it's ok() uses 'eq' internally. +Both C<bstr()> and C<bsstr()> as well as automated stringify via overload now +drop the leading '+'. The old code would return '+3', the new returns '3'. +This is to be consistent with Perl and to make C<cmp> (especially with +overloading) to work as you expect. It also solves problems with C<Test.pm>, +because it's C<ok()> uses 'eq' internally. -Mark said, when asked about to drop the '+' altogether, or make only cmp work: +Mark Biggar said, when asked about to drop the '+' altogether, or make only +C<cmp> work: I agree (with the first alternative), don't add the '+' on positive numbers. It's not as important anymore with the new internal @@ -4273,7 +4101,8 @@ Additionally, the following still works: There is now a C<bsstr()> method to get the string in scientific notation aka C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr() for comparisation, but Perl will represent some numbers as 100 and others -as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq: +as 1e+308. If in doubt, convert both arguments to Math::BigInt before +comparing them as strings: use Test; BEGIN { plan tests => 3 } @@ -4285,9 +4114,9 @@ as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq: $y = Math::BigInt->new($y); ok ($x,$y); # okay -Alternatively, simple use <=> for comparisations, that will get it always -right. There is not yet a way to get a number automatically represented as -a string that matches exactly the way Perl represents it. +Alternatively, simple use C<< <=> >> for comparisations, this will get it +always right. There is not yet a way to get a number automatically represented +as a string that matches exactly the way Perl represents it. =item int() diff --git a/gnu/usr.bin/perl/lib/Math/BigInt/Scalar.pm b/gnu/usr.bin/perl/lib/Math/BigInt/Scalar.pm deleted file mode 100644 index 44bab5d53f4..00000000000 --- a/gnu/usr.bin/perl/lib/Math/BigInt/Scalar.pm +++ /dev/null @@ -1,242 +0,0 @@ -############################################################################### -# core math lib for BigInt, representing big numbers by normal int/float's -# for testing only, will fail any bignum test if range is exceeded - -package Math::BigInt::Scalar; - -use 5.005; -use strict; -# use warnings; # dont use warnings for older Perls - -require Exporter; - -use vars qw/@ISA $VERSION/; -@ISA = qw(Exporter); - -$VERSION = '0.11'; - -############################################################################## -# global constants, flags and accessory - -# constants for easier life -my $nan = 'NaN'; - -############################################################################## -# create objects from various representations - -sub _new - { - # (string) return ref to num - my $d = $_[1]; - my $x = $$d; # make copy - return \$x; - } - -sub _zero - { - my $x = 0; return \$x; - } - -sub _one - { - my $x = 1; return \$x; - } - -sub _copy - { - my $x = $_[1]; - my $z = $$x; - return \$z; - } - -# catch and throw away -sub import { } - -############################################################################## -# convert back to string and number - -sub _str - { - # make string - return \"${$_[1]}"; - } - -sub _num - { - # make a number - return ${$_[1]}; - } - - -############################################################################## -# actual math code - -sub _add - { - my ($c,$x,$y) = @_; - $$x += $$y; - return $x; - } - -sub _sub - { - my ($c,$x,$y) = @_; - $$x -= $$y; - return $x; - } - -sub _mul - { - my ($c,$x,$y) = @_; - $$x *= $$y; - return $x; - } - -sub _div - { - my ($c,$x,$y) = @_; - - my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u; - return ($x,\$r) if wantarray; - return $x; - } - -sub _pow - { - my ($c,$x,$y) = @_; - my $u = $$x ** $$y; $$x = $u; - return $x; - } - -sub _and - { - my ($c,$x,$y) = @_; - my $u = int($$x) & int($$y); $$x = $u; - return $x; - } - -sub _xor - { - my ($c,$x,$y) = @_; - my $u = int($$x) ^ int($$y); $$x = $u; - return $x; - } - -sub _or - { - my ($c,$x,$y) = @_; - my $u = int($$x) | int($$y); $$x = $u; - return $x; - } - -sub _inc - { - my ($c,$x) = @_; - my $u = int($$x)+1; $$x = $u; - return $x; - } - -sub _dec - { - my ($c,$x) = @_; - my $u = int($$x)-1; $$x = $u; - return $x; - } - -############################################################################## -# testing - -sub _acmp - { - my ($c,$x, $y) = @_; - return ($$x <=> $$y); - } - -sub _len - { - return length("${$_[1]}"); - } - -sub _digit - { - # return the nth digit, negative values count backward - # 0 is the rightmost digit - my ($c,$x,$n) = @_; - - $n ++; # 0 => 1, 1 => 2 - return substr($$x,-$n,1); # 1 => -1, -2 => 2 etc - } - -############################################################################## -# _is_* routines - -sub _is_zero - { - # return true if arg is zero - my ($c,$x) = @_; - return ($$x == 0) <=> 0; - } - -sub _is_even - { - # return true if arg is even - my ($c,$x) = @_; - return (!($$x & 1)) <=> 0; - } - -sub _is_odd - { - # return true if arg is odd - my ($c,$x) = @_; - return ($$x & 1) <=> 0; - } - -sub _is_one - { - # return true if arg is one - my ($c,$x) = @_; - return ($$x == 1) <=> 0; - } - -############################################################################### -# check routine to test internal state of corruptions - -sub _check - { - # no checks yet, pull it out from the test suite - my ($c,$x) = @_; - return "$x is not a reference" if !ref($x); - return 0; - } - -1; -__END__ - -=head1 NAME - -Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars - -=head1 SYNOPSIS - -Provides support for big integer calculations via means of 'small' int/floats. -Only for testing purposes, since it will fail at large values. But it is simple -enough not to introduce bugs on it's own and to serve as a testbed. - -=head1 DESCRIPTION - -Please see Math::BigInt::Calc. - -=head1 LICENSE - -This program is free software; you may redistribute it and/or modify it under -the same terms as Perl itself. - -=head1 AUTHOR - -Tels http://bloodgate.com in 2001. - -=head1 SEE ALSO - -L<Math::BigInt>, L<Math::BigInt::Calc>. - -=cut diff --git a/gnu/usr.bin/perl/lib/Pod/Html.pm b/gnu/usr.bin/perl/lib/Pod/Html.pm index c4af19cb80e..3f697205bcd 100644 --- a/gnu/usr.bin/perl/lib/Pod/Html.pm +++ b/gnu/usr.bin/perl/lib/Pod/Html.pm @@ -3,7 +3,7 @@ use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -$VERSION = 1.0501; +$VERSION = 1.0502; @ISA = qw(Exporter); @EXPORT = qw(pod2html htmlify); @EXPORT_OK = qw(anchorify); @@ -78,6 +78,20 @@ section. By default, no headers are generated. Displays the usage message. +=item hiddendirs + + --hiddendirs + --nohiddendirs + +Include hidden directories in the search for POD's in podpath if recurse +is set. +The default is not to traverse any directory whose name begins with C<.>. +See L</"podpath"> and L</"recurse">. + +[This option is for backward compatibility only. +It's hard to imagine that one would usefully create a module with a +name component beginning with C<.>.] + =item htmldir --htmldir=name @@ -213,6 +227,7 @@ my $Css; my $Recurse; my $Quiet; +my $HiddenDirs; my $Verbose; my $Doindex; @@ -604,6 +619,7 @@ Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> --flush - flushes the item and directory caches. --[no]header - produce block header/footer (default is no headers). --help - prints this message. + --hiddendirs - search hidden directories in podpath --htmldir - directory for resulting HTML files. --htmlroot - http-server base directory from which all relative paths in podpath stem (default is /). @@ -636,7 +652,7 @@ sub parse_command_line { my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help, $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods, $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet, - $opt_recurse,$opt_title,$opt_verbose); + $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs); unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; my $result = GetOptions( @@ -646,6 +662,7 @@ sub parse_command_line { 'flush' => \$opt_flush, 'header!' => \$opt_header, 'help' => \$opt_help, + 'hiddendirs!'=> \$opt_hiddendirs, 'htmldir=s' => \$opt_htmldir, 'htmlroot=s' => \$opt_htmlroot, 'index!' => \$opt_index, @@ -676,6 +693,7 @@ sub parse_command_line { $Htmlroot = $opt_htmlroot if defined $opt_htmlroot; $Doindex = $opt_index if defined $opt_index; $Podfile = $opt_infile if defined $opt_infile; + $HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs; $Htmlfile = $opt_outfile if defined $opt_outfile; $Podroot = $opt_podroot if defined $opt_podroot; $Quiet = $opt_quiet if defined $opt_quiet; @@ -921,7 +939,9 @@ sub scan_dir { opendir(DIR, $dir) || die "$0: error opening directory $dir: $!\n"; while (defined($_ = readdir(DIR))) { - if (-d "$dir/$_" && $_ ne "." && $_ ne "..") { # directory + if (-d "$dir/$_" && $_ ne "." && $_ ne ".." + && ($HiddenDirs || !/^\./) + ) { # directory $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_:"; push(@subdirs, $_); diff --git a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm index 9cd347b969a..d895b104a48 100644 --- a/gnu/usr.bin/perl/lib/Pod/InputObjects.pm +++ b/gnu/usr.bin/perl/lib/Pod/InputObjects.pm @@ -932,6 +932,8 @@ See L<Pod::Parser>, L<Pod::Select> =head1 AUTHOR +Please report bugs using L<http://rt.cpan.org>. + Brad Appleton E<lt>bradapp@enteract.comE<gt> =cut diff --git a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm index d00b604483c..5413fbd3307 100644 --- a/gnu/usr.bin/perl/lib/Pod/Perldoc.pm +++ b/gnu/usr.bin/perl/lib/Pod/Perldoc.pm @@ -12,7 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir); use vars qw($VERSION @Pagers $Bindir $Pod2man $Temp_Files_Created $Temp_File_Lifetime ); -$VERSION = '3.11'; +$VERSION = '3.12'; #.......................................................................... BEGIN { # Make a DEBUG constant very first thing... @@ -766,9 +766,12 @@ sub maybe_generate_dynamic_pod { push @{ $self->{'temp_file_list'} }, $buffer; # I.e., it MIGHT be deleted at the end. - print $buffd "=over 8\n\n"; + my $in_list = $self->opt_f; + + print $buffd "=over 8\n\n" if $in_list; print $buffd @dynamic_pod or die "Can't print $buffer: $!"; - print $buffd "=back\n"; + print $buffd "=back\n" if $in_list; + close $buffd or die "Can't close $buffer: $!"; @$found_things = $buffer; diff --git a/gnu/usr.bin/perl/lib/Pod/PlainText.pm b/gnu/usr.bin/perl/lib/Pod/PlainText.pm index 02c9205714e..316cd077d78 100644 --- a/gnu/usr.bin/perl/lib/Pod/PlainText.pm +++ b/gnu/usr.bin/perl/lib/Pod/PlainText.pm @@ -1,5 +1,5 @@ # Pod::PlainText -- Convert POD data to formatted ASCII text. -# $Id: PlainText.pm,v 1.2 2003/12/03 03:02:40 millert Exp $ +# $Id: PlainText.pm,v 1.3 2004/04/07 21:33:06 millert Exp $ # # Copyright 1999-2000 by Russ Allbery <rra@stanford.edu> # @@ -29,7 +29,7 @@ use vars qw(@ISA %ESCAPES $VERSION); # by Pod::Usage. @ISA = qw(Pod::Select); -($VERSION = (split (' ', q$Revision: 1.2 $ ))[1]) =~ s/\.(\d)$/.0$1/; +$VERSION = '2.02'; ############################################################################ @@ -396,7 +396,10 @@ sub seq_l { # something looking like L<manpage(section)>. The latter is an # enhancement over the original Pod::Text. my ($manpage, $section) = ('', $_); - if (/^"\s*(.*?)\s*"$/) { + if (/^(?:https?|ftp|news):/) { + # a URL + return $_; + } elsif (/^"\s*(.*?)\s*"$/) { $section = '"' . $1 . '"'; } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) { ($manpage, $section) = ($_, ''); @@ -404,8 +407,8 @@ sub seq_l { ($manpage, $section) = split (/\s*\/\s*/, $_, 2); } - # Now build the actual output text. my $text = ''; + # Now build the actual output text. if (!length $section) { $text = "the $manpage manpage" if length $manpage; } elsif ($section =~ /^[:\w]+(?:\(\))?/) { @@ -692,6 +695,8 @@ pod2text(1) =head1 AUTHOR +Please report bugs using L<http://rt.cpan.org>. + Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and its conversion to Pod::Parser by Brad Appleton diff --git a/gnu/usr.bin/perl/lib/Test/Harness.pm b/gnu/usr.bin/perl/lib/Test/Harness.pm index bcb72368f6e..6a101fa4bf1 100644 --- a/gnu/usr.bin/perl/lib/Test/Harness.pm +++ b/gnu/usr.bin/perl/lib/Test/Harness.pm @@ -1,5 +1,5 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Harness.pm,v 1.7 2003/12/03 03:02:41 millert Exp $ +# $Id: Harness.pm,v 1.8 2004/04/07 21:33:06 millert Exp $ package Test::Harness; @@ -11,19 +11,39 @@ use Benchmark; use Config; use strict; -use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest - $Columns $verbose $switches $ML $Strap - @ISA @EXPORT @EXPORT_OK $Last_ML_Print - ); +use vars qw( + $VERSION + @ISA @EXPORT @EXPORT_OK + $Verbose $Switches $Debug + $verbose $switches $debug + $Have_Devel_Corestack + $Curtest + $Columns + $ML $Last_ML_Print + $Strap +); + +=head1 NAME + +Test::Harness - Run Perl standard test scripts with statistics + +=head1 VERSION + +Version 2.40 + + $Header: /cvs/OpenBSD/src/gnu/usr.bin/perl/lib/Test/Attic/Harness.pm,v 1.8 2004/04/07 21:33:06 millert Exp $ + +=cut + +$VERSION = '2.40'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; *switches = *Switches; +*debug = *Debug; $Have_Devel_Corestack = 0; -$VERSION = '2.30'; - $ENV{HARNESS_ACTIVE} = 1; END { @@ -45,15 +65,11 @@ $Strap = Test::Harness::Straps->new; @EXPORT_OK = qw($verbose $switches); $Verbose = $ENV{HARNESS_VERBOSE} || 0; +$Debug = $ENV{HARNESS_DEBUG} || 0; $Switches = "-w"; $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; $Columns--; # Some shells have trouble with a full line of text. - -=head1 NAME - -Test::Harness - run perl standard test scripts with statistics - =head1 SYNOPSIS use Test::Harness; @@ -163,13 +179,15 @@ emitted if the test script is skipped completely: =item B<Todo tests> -If the standard output line contains the substring C< # TODO> after +If the standard output line contains the substring C< # TODO > after C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text afterwards is the thing that has to be done before this test will succeed. not ok 13 # TODO harness the power of the atom +Note that the TODO must have a space after it. + =begin _deprecated Alternatively, you can specify a list of what tests are todo as part @@ -220,17 +238,15 @@ test script, please use a comment. =back - =head2 Taint mode -Test::Harness will honor the C<-T> in the #! line on your test files. So -if you begin a test with: +Test::Harness will honor the C<-T> or C<-t> in the #! line on your +test files. So if you begin a test with: #!perl -T the test will be run with taint mode on. - =head2 Configuration variables. These variables can be used to configure the behavior of @@ -238,24 +254,25 @@ Test::Harness. They are exported on request. =over 4 -=item B<$Test::Harness::verbose> +=item B<$Test::Harness::Verbose> -The global variable $Test::Harness::verbose is exportable and can be -used to let runtests() display the standard output of the script -without altering the behavior otherwise. +The global variable C<$Test::Harness::Verbose> is exportable and can be +used to let C<runtests()> display the standard output of the script +without altering the behavior otherwise. The F<prove> utility's C<-v> +flag will set this. =item B<$Test::Harness::switches> -The global variable $Test::Harness::switches is exportable and can be +The global variable C<$Test::Harness::switches> is exportable and can be used to set perl command line options used for running the test -script(s). The default value is C<-w>. +script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>. =back =head2 Failure -It will happen, your tests will fail. After you mop up your ego, you +It will happen: your tests will fail. After you mop up your ego, you can begin examining the summary report: t/base..............ok @@ -288,7 +305,7 @@ If the test exited with non-zero, this is its exit status. =item B<Wstat> -The wait status of the test I<umm, I need a better explanation here>. +The wait status of the test. =item B<Total> @@ -388,9 +405,9 @@ sub _globdir { my($total, $failed) = _run_all_tests(@test_files); -Runs all the given @test_files (as runtests()) but does it quietly (no -report). $total is a hash ref summary of all the tests run. Its keys -and values are this: +Runs all the given C<@test_files> (as C<runtests()>) but does it +quietly (no report). $total is a hash ref summary of all the tests +run. Its keys and values are this: bonus Number of individual todo tests unexpectedly passed max Number of individual tests ran @@ -404,8 +421,8 @@ and values are this: tests Number of test files originally given skipped Number of test files skipped -If $total->{bad} == 0 and $total->{max} > 0, you've got a successful -test. +If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've +got a successful test. $failed is a hash ref of all the test scripts which failed. Each key is the name of a test script, each value is another hash representing @@ -419,7 +436,7 @@ how that script failed. Its keys are these: percent Percentage of tests which failed canon List of tests which failed (as string). -Needless to say, $failed should be empty if everything passed. +C<$failed> should be empty if everything passed. B<NOTE> Currently this function is still noisy. I'm working on it. @@ -451,16 +468,21 @@ sub _run_all_tests { my $width = _leader_width(@tests); foreach my $tfile (@tests) { + if ( $Test::Harness::Debug ) { + print "# Running: ", $Strap->_command_line($tfile), "\n"; + } + $Last_ML_Print = 0; # so each test prints at least once my($leader, $ml) = _mk_leader($tfile, $width); local $ML = $ml; + print $leader; $tot{files}++; $Strap->{_seen_header} = 0; my %results = $Strap->analyze_file($tfile) or - do { warn "$Strap->{error}\n"; next }; + do { warn $Strap->{error}, "\n"; next }; # state of the current test. my @failed = grep { !$results{details}[$_-1]{ok} } @@ -526,7 +548,7 @@ sub _run_all_tests { } elsif($results{seen}) { if (@{$test{failed}} and $test{max}) { - my ($txt, $canon) = canonfailed($test{max},$test{skipped}, + my ($txt, $canon) = _canonfailed($test{max},$test{skipped}, @{$test{failed}}); print "$test{ml}$txt"; $failedtests{$tfile} = { canon => $canon, @@ -587,12 +609,12 @@ sub _run_all_tests { my($leader, $ml) = _mk_leader($test_file, $width); -Generates the 't/foo........' $leader for the given $test_file as well +Generates the 't/foo........' $leader for the given C<$test_file> as well as a similar version which will overwrite the current line (by use of -\r and such). $ml may be empty if Test::Harness doesn't think you're +\r and such). C<$ml> may be empty if Test::Harness doesn't think you're on TTY. -The $width is the width of the "yada/blah.." string. +The C<$width> is the width of the "yada/blah.." string. =cut @@ -789,7 +811,7 @@ sub _dubious_return { $wstatus,$wstatus; print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS'; - if (corestatus($wstatus)) { # until we have a wait module + if (_corestatus($wstatus)) { # until we have a wait module if ($Have_Devel_Corestack) { Devel::CoreStack::stack($^X); } else { @@ -808,7 +830,7 @@ sub _dubious_return { else { push @{$test->{failed}}, $test->{'next'}..$test->{max}; $failed = @{$test->{failed}}; - (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}}); + (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}}); $percent = 100*(scalar @{$test->{failed}})/$test->{max}; print "DIED. ",$txt; } @@ -878,7 +900,7 @@ sub _create_fmts { { my $tried_devel_corestack; - sub corestatus { + sub _corestatus { my($st) = @_; my $did_core; @@ -898,7 +920,7 @@ sub _create_fmts { } } -sub canonfailed ($$@) { +sub _canonfailed ($$@) { my($max,$skipped,@failed) = @_; my %seen; @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed; @@ -966,8 +988,7 @@ __END__ C<&runtests> is exported by Test::Harness by default. -C<$verbose> and C<$switches> are exported upon request. - +C<$verbose>, C<$switches> and C<$debug> are exported upon request. =head1 DIAGNOSTICS @@ -1027,6 +1048,13 @@ C<perlcc> before running it. B<NOTE> This currently only works when sitting in the perl source directory! +=item C<HARNESS_DEBUG> + +If true, Test::Harness will print debugging information about itself as +it runs the tests. This is different from C<HARNESS_VERBOSE>, which prints +the output from the test being run. Setting C<$Test::Harness::Debug> will +override this, or you can use the C<-d> switch in the F<prove> utility. + =item C<HARNESS_FILELEAK_IN_DIR> When set to the name of a directory, harness will check after each @@ -1052,9 +1080,17 @@ somewhat messy output). =item C<HARNESS_OK_SLOW> -If true, the C<ok> messages are printed out only every second. -This reduces output and therefore may for example help testing -over slow connections. +If true, the C<ok> messages are printed out only every second. This +reduces output and may help increase testing speed over slow +connections, or with very large numbers of tests. + +=item C<HARNESS_PERL> + +Usually your tests will be run by C<$^X>, the currently-executing Perl. +However, you may want to have it run by a different executable, such as +a threading perl, or a different version. + +If you're using the F<prove> utility, you can use the C<--perl> switch. =item C<HARNESS_PERL_SWITCHES> @@ -1065,7 +1101,8 @@ run all tests with all warnings enabled. =item C<HARNESS_VERBOSE> If true, Test::Harness will output the verbose results of running -its tests. Setting $Test::Harness::verbose will override this. +its tests. Setting C<$Test::Harness::verbose> will override this, +or you can use the C<-v> switch in the F<prove> utility. =back @@ -1165,4 +1202,22 @@ Clean up how the summary is printed. Get rid of those damned formats. HARNESS_COMPILE_TEST currently assumes it's run from the Perl source directory. +Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>. +You can also mail bugs, fixes and enhancements to +C<< <bug-test-harness@rt.cpan.org> >>. + +=head1 AUTHORS + +Original code by Michael G Schwern, maintained by Andy Lester. + +=head1 COPYRIGHT + +Copyright 2003 by Michael G Schwern C<< <schwern@pobox.com> >>, + Andy Lester C<< <andy@petdance.com> >>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L<http://www.perl.com/perl/misc/Artistic.html>. + =cut diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm index 65f9dd0b385..98e0d50e7de 100644 --- a/gnu/usr.bin/perl/lib/Tie/Hash.pm +++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm @@ -1,6 +1,6 @@ package Tie::Hash; -our $VERSION = '1.00'; +our $VERSION = '1.01'; =head1 NAME @@ -105,6 +105,13 @@ Delete the key I<key> from the tied hash I<this>. Clear all values from the tied hash I<this>. +=item SCALAR this + +Returns what evaluating the hash in scalar context yields. + +B<Tie::Hash> does not implement this method (but B<Tie::StdHash> +and B<Tie::ExtraHash> do). + =back =head1 Inheriting from B<Tie::StdHash> @@ -131,7 +138,7 @@ should operate on the hash referenced by the first argument: =head1 Inheriting from B<Tie::ExtraHash> The accessor methods assume that the actual storage for the data in the tied -hash is in the hash referenced by C<(tied(%tiedhash))[0]>. Thus overwritten +hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten C<TIEHASH> method should return an array reference with the first element being a hash reference, and the remaining methods should operate on the hash C<< %{ $_[0]->[0] } >>: @@ -156,15 +163,18 @@ same storage algorithm as in TIEHASH subroutine above. Hence, a typical package inheriting from B<Tie::ExtraHash> does not need to overwrite this method. -=head1 C<UNTIE> and C<DESTROY> +=head1 C<SCALAR>, C<UNTIE> and C<DESTROY> The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require presense of these methods, but if defined, the methods will be called in proper time, see L<perltie>. +C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>. + If needed, these methods should be defined by the package inheriting from -B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. +B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<pertie/"SCALAR"> +to find out what happens when C<SCALAR> does not exist. =head1 MORE INFORMATION @@ -230,6 +240,7 @@ sub NEXTKEY { each %{$_[0]} } sub EXISTS { exists $_[0]->{$_[1]} } sub DELETE { delete $_[0]->{$_[1]} } sub CLEAR { %{$_[0]} = () } +sub SCALAR { scalar %{$_[0]} } package Tie::ExtraHash; @@ -241,5 +252,6 @@ sub NEXTKEY { each %{$_[0][0]} } sub EXISTS { exists $_[0][0]->{$_[1]} } sub DELETE { delete $_[0][0]->{$_[1]} } sub CLEAR { %{$_[0][0]} = () } +sub SCALAR { scalar %{$_[0][0]} } 1; diff --git a/gnu/usr.bin/perl/lib/base.pm b/gnu/usr.bin/perl/lib/base.pm index 3177488eac0..04a8aa961ea 100644 --- a/gnu/usr.bin/perl/lib/base.pm +++ b/gnu/usr.bin/perl/lib/base.pm @@ -2,7 +2,7 @@ package base; use strict 'vars'; use vars qw($VERSION); -$VERSION = '2.03'; +$VERSION = '2.04'; # constant.pm is slow sub SUCCESS () { 1 } @@ -113,7 +113,7 @@ sub inherit_fields { if( keys %$dfields ) { warn "$derived is inheriting from $base but already has its own ". "fields!\n". - "This will cause problems with pseudo-hashes.\n". + "This will cause problems.\n". "Be sure you use base BEFORE declaring fields\n"; } @@ -151,7 +151,7 @@ __END__ =head1 NAME -base - Establish IS-A relationship with base class at compile time +base - Establish IS-A relationship with base classes at compile time =head1 SYNOPSIS @@ -160,31 +160,29 @@ base - Establish IS-A relationship with base class at compile time =head1 DESCRIPTION -Roughly similar in effect to +Allows you to both load one or more modules, while setting up inheritance from +those modules at the same time. Roughly similar in effect to + package Baz; BEGIN { require Foo; require Bar; push @ISA, qw(Foo Bar); } +If any of the listed modules are not loaded yet, I<base> silently attempts to +C<require> them (and silently continues if the C<require> failed). Whether to +C<require> a base class module is determined by the absence of a global variable +$VERSION in the base package. If $VERSION is not detected even after loading +it, <base> will define $VERSION in the base package, setting it to the string +C<-1, set by base.pm>. + Will also initialize the fields if one of the base classes has it. -Multiple Inheritence of fields is B<NOT> supported, if two or more +Multiple inheritence of fields is B<NOT> supported, if two or more base classes each have inheritable fields the 'base' pragma will croak. See L<fields>, L<public> and L<protected> for a description of this feature. -When strict 'vars' is in scope, I<base> also lets you assign to @ISA -without having to declare @ISA with the 'vars' pragma first. - -If any of the base classes are not loaded yet, I<base> silently -C<require>s them (but it won't call the C<import> method). Whether to -C<require> a base class package is determined by the absence of a global -$VERSION in the base package. If $VERSION is not detected even after -loading it, I<base> will define $VERSION in the base package, setting it to -the string C<-1, set by base.pm>. - - =head1 HISTORY This module was introduced with Perl 5.004_04. @@ -192,7 +190,7 @@ This module was introduced with Perl 5.004_04. =head1 CAVEATS -Due to the limitations of the pseudo-hash implementation, you must use +Due to the limitations of the implementation, you must use base I<before> you declare any of your own fields. diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm index 0d1a7e2e6ef..7445aade042 100644 --- a/gnu/usr.bin/perl/lib/diagnostics.pm +++ b/gnu/usr.bin/perl/lib/diagnostics.pm @@ -2,13 +2,11 @@ package diagnostics; =head1 NAME -diagnostics - Perl compiler pragma to force verbose warning diagnostics - -splain - filter to produce verbose descriptions of perl warning diagnostics +diagnostics, splain - produce verbose warning diagnostics =head1 SYNOPSIS -As a pragma: +Using the C<diagnostics> pragma: use diagnostics; use diagnostics -verbose; @@ -16,12 +14,11 @@ As a pragma: enable diagnostics; disable diagnostics; -As a program: +Using the C<splain> standalone filter program: perl program 2>diag.out splain [-v] [-p] diag.out - =head1 DESCRIPTION =head2 The C<diagnostics> Pragma @@ -171,7 +168,7 @@ use strict; use 5.006; use Carp; -our $VERSION = 1.11; +our $VERSION = 1.12; our $DEBUG; our $VERBOSE; our $PRETTY; diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl index 580a70dcf27..3674d0372c4 100644 --- a/gnu/usr.bin/perl/lib/perl5db.pl +++ b/gnu/usr.bin/perl/lib/perl5db.pl @@ -492,7 +492,8 @@ package DB; use IO::Handle; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.22; +$VERSION = 1.23; + $header = "perl5db.pl version $VERSION"; =head1 DEBUGGER ROUTINES @@ -678,7 +679,10 @@ sub eval { # (for subroutines defined outside of the package DB). In fact the same is # true if $deep is not defined. # -# $Log: perldb.pl,v $ +# $Log: perl5db.pl,v $ +# Revision 1.7 2003/12/03 03:02:36 millert +# Resolve conflicts for perl 5.8.2, remove old files, and add OpenBSD-specific scaffolding +# # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -899,6 +903,8 @@ sub eval { # + Includes cleanup by Robin Barker and Jarkko Hietaniemi. # Changes: 1.22 Jun 09, 2003 Alex Vandiver <alexmv@MIT.EDU> # + Flush stdout/stderr before the debugger prompt is printed. +# Changes: 1.23: Dec 21, 2003 Dominique Quatravaux +# + Fix a side-effect of bug #24674 in the perl debugger ("odd taint bug") #################################################################### @@ -1344,6 +1350,9 @@ if (not defined &get_fork_TTY # no routine exists, elsif ($^O eq 'os2') { # If this is OS/2, *get_fork_TTY = \&os2_get_fork_TTY; # use the OS/2 version } +# untaint $^O, which may have been tainted by the last statement. +# see bug [perl #24674] +$^O =~ m/^(.*)\z/; $^O = $1; # "Here begin the unreadable code. It needs fixing." diff --git a/gnu/usr.bin/perl/mg.c b/gnu/usr.bin/perl/mg.c index 66b7ff136f1..6ee5f571799 100644 --- a/gnu/usr.bin/perl/mg.c +++ b/gnu/usr.bin/perl/mg.c @@ -379,7 +379,7 @@ Perl_mg_free(pTHX_ SV *sv) if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { - if (mg->mg_len > 0) + if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8) Safefree(mg->mg_ptr); else if (mg->mg_len == HEf_SVKEY) SvREFCNT_dec((SV*)mg->mg_ptr); @@ -392,10 +392,7 @@ Perl_mg_free(pTHX_ SV *sv) return 0; } - -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> -#endif U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) @@ -618,8 +615,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) SetLastError(dwErr); } #else - sv_setnv(sv, (NV)errno); - sv_setpv(sv, errno ? Strerror(errno) : ""); + { + int saveerrno = errno; + sv_setnv(sv, (NV)errno); + sv_setpv(sv, errno ? Strerror(errno) : ""); + errno = saveerrno; + } #endif #endif #endif @@ -1527,6 +1528,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg) call_method("CLEAR", G_SCALAR|G_DISCARD); POPSTACK; LEAVE; + return 0; } @@ -1561,6 +1563,41 @@ Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg) return magic_methpack(sv,mg,"EXISTS"); } +SV * +Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) +{ + dSP; + SV *retval = &PL_sv_undef; + SV *tied = SvTIED_obj((SV*)hv, mg); + HV *pkg = SvSTASH((SV*)SvRV(tied)); + + if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { + SV *key; + if (HvEITER(hv)) + /* we are in an iteration so the hash cannot be empty */ + return &PL_sv_yes; + /* no xhv_eiter so now use FIRSTKEY */ + key = sv_newmortal(); + magic_nextpack((SV*)hv, mg, key); + HvEITER(hv) = NULL; /* need to reset iterator */ + return SvOK(key) ? &PL_sv_yes : &PL_sv_no; + } + + /* there is a SCALAR method that we can call */ + ENTER; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP, 1); + PUSHs(tied); + PUTBACK; + + if (call_method("SCALAR", G_SCALAR)) + retval = *PL_stack_sp--; + POPSTACK; + LEAVE; + return retval; +} + int Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) { @@ -2075,7 +2112,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\020': /* ^P */ PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); - if (PL_perldb && !PL_DBsingle) + if ((PERLDB_SUB || PERLDB_LINE || PERLDB_SUBLINE) + && !PL_DBsingle) init_debugger(); break; case '\024': /* ^T */ diff --git a/gnu/usr.bin/perl/op.c b/gnu/usr.bin/perl/op.c index 2c4ae5cce08..25e7f8961d7 100644 --- a/gnu/usr.bin/perl/op.c +++ b/gnu/usr.bin/perl/op.c @@ -1877,6 +1877,7 @@ Perl_newPROG(pTHX_ OP *o) if (o->op_type == OP_STUB) { PL_comppad_name = 0; PL_compcv = 0; + FreeOp(o); return; } PL_main_root = scope(sawparens(scalarvoid(o))); @@ -4299,6 +4300,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) mod(scalarseq(block), OP_LEAVESUBLV)); } else { + /* This makes sub {}; work as expected. */ + if (block->op_type == OP_STUB) { + op_free(block); + block = newSTATEOP(0, Nullch, 0); + } CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); } CvROOT(cv)->op_private |= OPpREFCOUNTED; @@ -4797,7 +4803,8 @@ OP * Perl_ck_concat(pTHX_ OP *o) { OP *kid = cUNOPo->op_first; - if (kid->op_type == OP_CONCAT && !(kUNOP->op_first->op_flags & OPf_MOD)) + if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) && + !(kUNOP->op_first->op_flags & OPf_MOD)) o->op_flags |= OPf_STACKED; return o; } @@ -5329,8 +5336,7 @@ Perl_ck_fun(pTHX_ OP *o) } if (tmpstr) { - name = savepv(SvPVX(tmpstr)); - len = strlen(name); + name = SvPV(tmpstr, len); sv_2mortal(tmpstr); } } @@ -6369,17 +6375,6 @@ Perl_peep(pTHX_ register OP *o) o->op_seq = PL_op_seqmax++; break; case OP_STUB: - if(!oldop && - o->op_next && - o->op_next->op_type == OP_LEAVESUB) { - OP* newop = newSTATEOP(0, Nullch, 0); - newop->op_next = o->op_next; - o->op_next = 0; - op_free(o); - o = newop; - ((UNOP*)o->op_next)->op_first = newop; - CvSTART(PL_compcv) = newop; - } if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) { o->op_seq = PL_op_seqmax++; break; /* Scalar stub must produce undef. List stub is noop */ diff --git a/gnu/usr.bin/perl/os2/Changes b/gnu/usr.bin/perl/os2/Changes index 4c54a28d5cb..3bd33a56c57 100644 --- a/gnu/usr.bin/perl/os2/Changes +++ b/gnu/usr.bin/perl/os2/Changes @@ -489,9 +489,333 @@ After @14577: necessary run-time dynalinking. After @15047: - makes PerlIO preserve the binary/text mode of filehandles chosen by CRT library. (However, TTY handles still are not clean, since switching them to TERMIO mode and back changes the NL translation law at runtime, and PerlIO level does not know this.) + +After @18156: + mkdir() rmdir() tolerate trailing slashes. + "localized" morphing to PM when already morphed would unmorph at end. + Convert \n to \r\n in REXX commands (Classic REXX would allow \r and + \r\n, but not \n as line-ends). + +After @19053: + Better detection of OS/2 in Configure scripts (if c:/ is not readable). + Better Configure support for \\ inside cpp-emited # lineno "filename". + Export pthread-support functions from threaded DLL. + [older change] If perl5.def file is present, the new perl5.def has + compatible ordinals. + OS/2 code compiles with threads enabled; much more robust pthreads + emulation (but some statics still present); survives fork(). + New attributes supported with [f]stat() and chmod() + archived is 0x1000000 = 0100000000 + hidden is 0x2000000 = 0200000000 + system is 0x4000000 = 0400000000 + If extra flag 0x8000000 = 01000000000 is missing during + chmod(), these 3 flags are ignored; this extra flag + is set in the result of stat() [this provides backward + compatibility, as well as transparency of stat()/ + chmod() supporting DOSISH]. + OS/2-specific modules use XSLoader now. + Remove DLLs manually after failing build (link386 would not?!). + Special-case stat()ing "/dev/nul" and "/dev/null" too. + Update dlopen() and friends: preserve i387 flags, better error messages, + support name==NULL (load for "this" DLL); + OS2::DLL does not eval() generated functions, uses closes instead; + new method wrapper_REXX() for DLL objects. + +After @19774: + Use common typemap for OS2:: modules. + New test file os2/perlrexx.cmd (should be run manually; does not it + exit too early???). + Export fork_with_resources(), croak_with_os2error() from DLL. + usleep() availability put in %Config{}. + Combine most (but not all!) statics into one struct. + New load-on-demand C functions + Dos32QueryHeaderInfo + DosTmrQueryFreq + DosTmrQueryTime + WinQueryActiveDesktopPathname + WinInvalidateRect + WinCreateFrameControl + WinQueryClipbrdFmtInfo + WinQueryClipbrdOwner + WinQueryClipbrdViewer + WinQueryClipbrdData + WinOpenClipbrd + WinCloseClipbrd + WinSetClipbrdData + WinSetClipbrdOwner + WinSetClipbrdViewer + WinEnumClipbrdFmts + WinEmptyClipbrd + WinAddAtom + WinFindAtom + WinDeleteAtom + WinQueryAtomUsage + WinQueryAtomName + WinQueryAtomLength + WinQuerySystemAtomTable + WinCreateAtomTable + WinDestroyAtomTable + WinOpenWindowDC + DevOpenDC + DevQueryCaps + DevCloseDC + WinMessageBox + WinMessageBox2 + WinQuerySysValue + WinSetSysValue + WinAlarm + WinFlashWindow + WinLoadPointer + WinQuerySysPointer + Check "\\SEM32\\PMDRAG.SEM" before loading PM-specific DLLs. + Handling of system {realname} was not correct in presence of + exe-type deduction, #!-emulation etc. + Use optimized PUSHTARG etc. XSUB convention. + $^E stringification contains PMERR_INVALID_HWND, PMERR_INVALID_HMQ, + PMERR_CALL_FROM_WRONG_THREAD, PMERR_NO_MSG_QUEUE, + PMERR_NOT_IN_A_PM_SESSION if these errors are not in .MSG file + (at least on Warp3fp42). + PERLLIB_PREFIX augmented by PERLLIB_582_PREFIX, PERLLIB_58_PREFIX, + PERLLIB_5_PREFIX (example for 5.8.2, the first one present is + considered). + New flag bit 0x2 for OS2::MorphPM(): immediately unmorph after creation + of message queue. + (De)Registring MQ preserves i386 flags. + When die()ing inside OS2:: API, include $^E in the message. + New function OS2::Timer(): returns Tmr-timer ticks (about 1MHz) since + start of OS/2, converted to number of seconds (keep in mind + that this timer uses a different crystal than the real-time + clock; thus these values have only weak relationship to the + wall clock time; behaviour with APM on is not defined). + New function OS2::DevCap() [XXX Wrong usage message!!!] + Usage: OS2::DevCap([WHAT, [HOW=0]]); the default for WHAT is + the memory device context, WHAT should be a device context + (as integer) if HOW==0 and a window handle (as integer) if + HOW==1. Returns a hash with keys + FAMILY IO_CAPS TECHNOLOGY DRIVER_VERSION WIDTH HEIGHT + WIDTH_IN_CHARS HEIGHT_IN_CHARS HORIZONTAL_RESOLUTION + VERTICAL_RESOLUTION CHAR_WIDTH CHAR_HEIGHT + SMALL_CHAR_WIDTH SMALL_CHAR_HEIGHT COLORS COLOR_PLANES + COLOR_BITCOUNT COLOR_TABLE_SUPPORT MOUSE_BUTTONS + FOREGROUND_MIX_SUPPORT BACKGROUND_MIX_SUPPORT + VIO_LOADABLE_FONTS WINDOW_BYTE_ALIGNMENT BITMAP_FORMATS + RASTER_CAPS MARKER_HEIGHT MARKER_WIDTH DEVICE_FONTS + GRAPHICS_SUBSET GRAPHICS_VERSION GRAPHICS_VECTOR_SUBSET + DEVICE_WINDOWING ADDITIONAL_GRAPHICS PHYS_COLORS + COLOR_INDEX GRAPHICS_CHAR_WIDTH GRAPHICS_CHAR_HEIGHT + HORIZONTAL_FONT_RES VERTICAL_FONT_RES DEVICE_FONT_SIM + LINEWIDTH_THICK DEVICE_POLYSET_POINTS + New function OS2::SysValues(which = -1, hwndDesktop = HWND_DESKTOP). + If which != -1, returns the correspondg SysValue. Otherwise + returns a hash with keys: + SWAPBUTTON DBLCLKTIME CXDBLCLK CYDBLCLK + CXSIZEBORDER CYSIZEBORDER ALARM 7 8 CURSORRATE + FIRSTSCROLLRATE SCROLLRATE NUMBEREDLISTS WARNINGFREQ + NOTEFREQ ERRORFREQ WARNINGDURATION NOTEDURATION + ERRORDURATION 19 CXSCREEN CYSCREEN CXVSCROLL CYHSCROLL + CYVSCROLLARROW CXHSCROLLARROW CXBORDER CYBORDER + CXDLGFRAME CYDLGFRAME CYTITLEBAR CYVSLIDER CXHSLIDER + CXMINMAXBUTTON CYMINMAXBUTTON CYMENU + CXFULLSCREEN CYFULLSCREEN CXICON CYICON + CXPOINTER CYPOINTER DEBUG CPOINTERBUTTONS POINTERLEVEL + CURSORLEVEL TRACKRECTLEVEL CTIMERS MOUSEPRESENT + CXALIGN CYALIGN + DESKTOPWORKAREAYTOP DESKTOPWORKAREAYBOTTOM + DESKTOPWORKAREAXRIGHT DESKTOPWORKAREAXLEFT 55 + NOTRESERVED EXTRAKEYBEEP SETLIGHTS INSERTMODE 60 61 62 63 + MENUROLLDOWNDELAY MENUROLLUPDELAY ALTMNEMONIC + TASKLISTMOUSEACCESS CXICONTEXTWIDTH CICONTEXTLINES + CHORDTIME CXCHORD CYCHORD CXMOTIONSTART CYMOTIONSTART + BEGINDRAG ENDDRAG SINGLESELECT OPEN CONTEXTMENU CONTEXTHELP + TEXTEDIT BEGINSELECT ENDSELECT BEGINDRAGKB ENDDRAGKB + SELECTKB OPENKB CONTEXTMENUKB CONTEXTHELPKB TEXTEDITKB + BEGINSELECTKB ENDSELECTKB ANIMATION ANIMATIONSPEED + MONOICONS KBDALTERED PRINTSCREEN /* 97, the last one on one of the DDK header */ + LOCKSTARTINPUT DYNAMICDRAG 100 101 102 103 104 105 106 107 + New function OS2::SysValues_set(which, val, hwndDesktop = HWND_DESKTOP). + Support new keys NUMPROCESSORS MAXHPRMEM MAXHSHMEM MAXPROCESSES + VIRTUALADDRESSLIMIT INT10ENABLE from OS2::SysInfo(); support + up to 10 unnamed values after the last named one. + New function OS2::SysInfoFor(id[,count=1]). [Wrong usage message!!!] + New function OS2::Beep(freq = 440, ms = 100). + New flags mod_name_C_function = 0x100, mod_name_HMODULE = 0x200 in + addition to old mod_name_handle = 0, mod_name_shortname = 1, + mod_name_full = 2 for OS2::DLLname(flag, cv); use an address + (as integer) or module handle instead of cv. + New function OS2::_headerInfo(req,size[,handle,[offset]]). + New function OS2::libPath(); returns the value of LIBPATH. + New function OS2::mytype(which=0) to query current process type: + 0: type immediately after startup or last fork(); + 1: type immediately after startup; + 2: type before the first morphing; + 3: type as set now in the header. + New function OS2::mytype_set(type); + New function OS2::incrMaxFHandles(delta = 0); returns updated value + for the possible number of open file descriptors. + Make check_emx_runtime() thread-safe. + Fix float-to-string conversion in the range .0001..0.1 (would return + in exponential notation, per gcvt()). + Make fork(): a) preserve i387 flags; + b) preverve the dynamically loaded (system) DLLs; + c) preserve morphed status; + Make sleep() work with time > 0xffffffff/1000. + Implement usleep() via _sleep2(); make select() with num_files==0 + thread-safe (via calling DosSleep()). + OS2::Process::Const() manages (MB|MBID|CF|CFI|SPTR)_.* constants too. + New (exported) functions from OS2::Process (some undocumented???): + process_codepage_set + TopLevel + FocusWindow_set_keep_Zorder + ActiveDesktopPathname + InvalidateRect + CreateFrameControl + ClipbrdFmtInfo + ClipbrdOwner + ClipbrdViewer + ClipbrdData + OpenClipbrd + CloseClipbrd + ClipbrdData_set + ClipbrdOwner_set + ClipbrdViewer_set + EnumClipbrdFmts + EmptyClipbrd + AddAtom + FindAtom + DeleteAtom + AtomUsage + AtomName + AtomLength + SystemAtomTable + CreateAtomTable + DestroyAtomTable + _ClipbrdData_set + ClipbrdText + ClipbrdText_set + _MessageBox + MessageBox + _MessageBox2 + MessageBox2 + LoadPointer + SysPointer + Alarm + FlashWindow + Do not use AUTOLOAD in OS2::DLL; moved to OS2::DLL::dll. + New method OS2::DLL->module() (to replace botched ->new() method). + New functions call20(), call20_p(), call20_rp3(), call20_rp3_p(), + call20_Dos(), call20_Win(), call20_Win_0OK(), + call20_Win_0OK_survive() in OS2::DLL to call C functions via + pointers. + +After @20218: + select() workaround broke build of x2p. + New OS2::Process (exported, undocumented) functions: + kbdChar + kbdhChar + kbdStatus + _kbdStatus_set + kbdhStatus + kbdhStatus_set + vioConfig + viohConfig + vioMode + viohMode + viohMode_set + _vioMode_set + _vioState + _vioState_set + vioFont + vioFont_set + Make CheckOS2Error() macro return the error code. + New dynaloaded entry point DosReplaceModule(). + New function OS2::replaceModule(target [, source [, backup]]). + +After @21211: + Make Cwd::sys_abspath() default to '.' and taint the result. + Fix os2_process*.t to work if the default for VIO windows is maximized. + Fix to avoid non-existing PIDs for get_sysinfo() broke pid==0. + Restore default mode for pipes to be TEXT mode. + +After @21379: + New OS2::Process functions: __term_mirror_screen() __term_mirror() + io_term(). + Fix a.out build: special-case thread::shared, pick up all the build + static libraries, not only those for top-level modules. + Fix DLLname() test to work with the static build too. + New dynaloaded entry point RexxRegisterSubcomExe(); make OS2::REXX use + it so it is not linked with REXX*.DLLs any more. + If system "./foo", and empty "./foo" and "./foo.exe" exist, + argv[0] would be set to junk. + Make perl2cmd convert .pl files and keep the command-line switches. + Make XSLoader and Perl-specific parts of DynaLoader to die with static + builds (new variable $OS2::is_static used); + Move perlmain.obj to the DLL; export main() as dll_perlmain(); create + a library libperl_dllmain to translate the exported symbol + back to main(); link the executables with this library instead + of perlmain.obj. + Add /li to link386's options (line number info in the .map file). + Another break from fix to avoid non-existing PIDs for get_sysinfo(). + +After @21574: + Update import libraries when perl version changes (e.g., due to rsync). + New exported symbols dup() and dup2() [the wrappers have workaround + for off-by-one error + double fault in the pre-Nov2003 kernels + when a (wrong) filedescriptor which is limit+1 is dup()ed]. + Enable disabling fd via a FILE* (to avoid close() during fclose()). + New dynaloaded entry point DosPerfSysCall(). + New function OS2::perfSysCall(cmd = CMD_KI_RDCNT, ulParm1= 0, + ulParm2= 0, ulParm3= 0); when called + with cmd == CMD_KI_RDCNT = 0x63 and no other parameters, + returns: in the scalar context: the tick count of processor 1; + in the list context: 4 tick counts per processor: + total/idle/busy/interrupt-time. + with cmd == CMD_KI_GETQTY == 0x41 and no other parameters, + returns the CPU count. Currently in other cases the return + is void. + New executables perl___<number> generated with decreased stack size + (good when virtual memory is low; e.g. floppy boot). + +After 5.8.2 (@21668): + Fixes to installperl scripts to avoid junk output, allow overwrite + of existing files (File::Copy::copy is mapped to DosCopy() + with flags which would not overwrite). + Disable DynaLoading of Perl modules with AOUT build (will core anyway). + For AOUT build: Quick hack to construct directories necessary for + /*/% stuff [maybe better do it from hints/os2.sh?]. + AOUT build: do -D__ST_MT_ERRNO__ to simplify linking with -Zmtd + (e.g., to test GD: gd.dll linked with -Zmtd). + MANIFEST.SKIP was read without a drive part of the filename. + Rename Cwd::extLibpath*() to OS2::... (old names still preserved). + Install perl.lib and perl.a too. + New methods libPath_find(),has_f32(),handle(),fullname() for OS2::DLL. + Enable quad support using long long. + New C exported functions os2_execname(), async_mssleep(), msCounter(), + InfoTable(), dir_subst(), Perl_OS2_handler_install(), + fill_extLibpath(). + async_mssleep() uses some undocumented features which allow usage of + highest possible resolution of sleep() while preserving low + priority (raise of resolution may be not available before + Warp3fp40; resolution is 8ms/CLOCK_SCALE). + usleep() and select(undef,undef,undef,$t) are using this + interface for time up to 0.5sec. + New convenience macros os2win_croak_0OK(rc,msg), os2win_croak(rc,msg), + os2cp_croak(rc,msg). + Supports ~installprefix, ~exe, ~dll in PERLLIB_PREFIX etc (actual + directories are substituted). + New functions OS2::msCounter(), OS2::ms_sleep(), OS2::_InfoTable(). + Checks stack when fixing EMX being under-initialized (-Zomf -Zsys + produces 32K stack???). + New environment variables PERL_BEGINLIBPATH, PERL_PRE_BEGINLIBPATH, + PERL_POST_BEGINLIBPATH, PERL_ENDLIBPATH, + PERL_PRE_ENDLIBPATH PERL_POST_ENDLIBPATH (~-enabled); + PERL_EMXLOAD_SECS. + Better handling of FIRST_MAKEFILE (propagate to subdirs during test, + do not require Makefile.PL present). + perl2cmd converter: do not rewrite if no change. + README.os2 updated with info on building binary distributions and + custom perl executables (but not much else). diff --git a/gnu/usr.bin/perl/os2/Makefile.SHs b/gnu/usr.bin/perl/os2/Makefile.SHs index 2a098c95bc7..ad688b8f374 100644 --- a/gnu/usr.bin/perl/os2/Makefile.SHs +++ b/gnu/usr.bin/perl/os2/Makefile.SHs @@ -288,7 +288,7 @@ aout_clean: aout_install: perl_ aout_install.perl aout_install.perl: perl_ installperl - ./perl_ installperl + ./perl_ installperl --destdir="$(DESTDIR)" perlrexx: $(PERLREXX_DLL) @sh -c true diff --git a/gnu/usr.bin/perl/os2/os2.c b/gnu/usr.bin/perl/os2/os2.c index e8e10d97b7e..776031d17b7 100644 --- a/gnu/usr.bin/perl/os2/os2.c +++ b/gnu/usr.bin/perl/os2/os2.c @@ -12,6 +12,7 @@ #include <os2.h> #include "dlfcn.h" #include <emx/syscalls.h> +#include <sys/emxload.h> #include <sys/uflags.h> @@ -32,6 +33,14 @@ #include "EXTERN.h" #include "perl.h" +enum module_name_how { mod_name_handle, mod_name_shortname, mod_name_full, + mod_name_C_function = 0x100, mod_name_HMODULE = 0x200}; + +/* Find module name to which *this* subroutine is compiled */ +#define module_name(how) module_name_at(&module_name_at, how) + +static SV* module_name_at(void *pp, enum module_name_how how); + void croak_with_os2error(char *s) { @@ -118,6 +127,7 @@ static struct perlos2_state_t { int po2__my_pwent; /* = -1; */ int po2_DOS_harderr_state; /* = -1; */ signed char po2_DOS_suppression_state; /* = -1; */ + PFN po2_ExtFCN[ORD_NENTRIES]; /* Labeled by ord ORD_*. */ /* struct PMWIN_entries_t po2_PMWIN_entries; */ @@ -153,7 +163,10 @@ static struct perlos2_state_t { int po2_emx_runtime_init; /* If 1, we need to manually init it */ int po2_emx_exception_init; /* If 1, we need to manually set it */ int po2_emx_runtime_secondary; - + char* (*po2_perllib_mangle_installed)(char *s, unsigned int l); + char* po2_perl_sh_installed; + PGINFOSEG po2_gTable; + PLINFOSEG po2_lTable; } perlos2_state = { -1, /* po2__my_pwent */ -1, /* po2_DOS_harderr_state */ @@ -195,10 +208,13 @@ static struct perlos2_state_t { #define emx_runtime_init (Perl_po2()->po2_emx_runtime_init) #define emx_exception_init (Perl_po2()->po2_emx_exception_init) #define emx_runtime_secondary (Perl_po2()->po2_emx_runtime_secondary) +#define perllib_mangle_installed (Perl_po2()->po2_perllib_mangle_installed) +#define perl_sh_installed (Perl_po2()->po2_perl_sh_installed) +#define gTable (Perl_po2()->po2_gTable) +#define lTable (Perl_po2()->po2_lTable) const Perl_PFN * const pExtFCN = (Perl_po2()->po2_ExtFCN); - #if defined(USE_5005THREADS) || defined(USE_ITHREADS) typedef void (*emx_startroutine)(void *); @@ -966,7 +982,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) { int trueflag = flag; int rc, pass = 1; - char *real_name; + char *real_name = NULL; /* Shut down the warning */ char const * args[4]; static const char * const fargs[4] = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; @@ -2100,34 +2116,50 @@ void CroakWinError(int die, char *name) { FillWinError; - if (die && Perl_rc) { - dTHX; + if (die && Perl_rc) + croak_with_os2error(name ? name : "Win* API call"); +} - Perl_croak(aTHX_ "%s: %s", (name ? name : "Win* API call"), os2error(Perl_rc)); - } +static char * +dllname2buffer(pTHX_ char *buf, STRLEN l) +{ + char *o; + STRLEN ll; + SV *dll = Nullsv; + + dll = module_name(mod_name_full); + o = SvPV(dll, ll); + if (ll < l) + memcpy(buf,o,ll); + SvREFCNT_dec(dll); + return (ll >= l ? "???" : buf); } -char * -os2_execname(pTHX) +static char * +execname2buffer(char *buf, STRLEN l, char *oname) { - char buf[300], *p, *o = PL_origargv[0], ok = 1; + char *p, *orig = oname, ok = oname != NULL; - if (_execname(buf, sizeof buf) != 0) - return o; + if (_execname(buf, l) != 0) { + if (!oname || strlen(oname) >= l) + return oname; + strcpy(buf, oname); + ok = 0; + } p = buf; while (*p) { if (*p == '\\') *p = '/'; if (*p == '/') { - if (ok && *o != '/' && *o != '\\') + if (ok && *oname != '/' && *oname != '\\') ok = 0; - } else if (ok && tolower(*o) != tolower(*p)) + } else if (ok && tolower(*oname) != tolower(*p)) ok = 0; p++; - o++; + oname++; } - if (ok) { /* PL_origargv[0] matches the real name. Use PL_origargv[0]: */ - strcpy(buf, PL_origargv[0]); /* _execname() is always uppercased */ + if (ok) { /* orig matches the real name. Use orig: */ + strcpy(buf, orig); /* _execname() is always uppercased */ p = buf; while (*p) { if (*p == '\\') @@ -2135,61 +2167,238 @@ os2_execname(pTHX) p++; } } - p = savepv(buf); + return buf; +} + +char * +os2_execname(pTHX) +{ + char buf[300], *p = execname2buffer(buf, sizeof buf, PL_origargv[0]); + + p = savepv(p); SAVEFREEPV(p); return p; } +int +Perl_OS2_handler_install(void *handler, enum Perlos2_handler how) +{ + char *s, b[300]; + + switch (how) { + case Perlos2_handler_mangle: + perllib_mangle_installed = (char *(*)(char *s, unsigned int l))handler; + return 1; + case Perlos2_handler_perl_sh: + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perl_sh"); + perl_sh_installed = savepv(s); + return 1; + case Perlos2_handler_perllib_from: + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_from"); + oldl = strlen(s); + oldp = savepv(s); + return 1; + case Perlos2_handler_perllib_to: + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_to"); + newl = strlen(s); + newp = savepv(s); + strcpy(mangle_ret, newp); + s = mangle_ret - 1; + while (*++s) + if (*s == '\\') + *s = '/'; + return 1; + default: + return 0; + } +} + +/* Returns a malloc()ed copy */ +char * +dir_subst(char *s, unsigned int l, char *b, unsigned int bl, enum dir_subst_e flags, char *msg) +{ + char *from, *to = b, *e = b; /* `to' assignment: shut down the warning */ + STRLEN froml = 0, tol = 0, rest = 0; /* froml: likewise */ + + if (l >= 2 && s[0] == '~') { + switch (s[1]) { + case 'i': case 'I': + from = "installprefix"; break; + case 'd': case 'D': + from = "dll"; break; + case 'e': case 'E': + from = "exe"; break; + default: + from = NULL; + froml = l + 1; /* Will not match */ + break; + } + if (from) + froml = strlen(from) + 1; + if (l >= froml && strnicmp(s + 2, from + 1, froml - 2) == 0) { + int strip = 1; + + switch (s[1]) { + case 'i': case 'I': + strip = 0; + tol = strlen(INSTALL_PREFIX); + if (tol >= bl) { + if (flags & dir_subst_fatal) + Perl_croak_nocontext("INSTALL_PREFIX too long: `%s'", INSTALL_PREFIX); + else + return NULL; + } + memcpy(b, INSTALL_PREFIX, tol + 1); + to = b; + e = b + tol; + break; + case 'd': case 'D': + if (flags & dir_subst_fatal) { + dTHX; + + to = dllname2buffer(aTHX_ b, bl); + } else { /* No Perl present yet */ + HMODULE self = find_myself(); + APIRET rc = DosQueryModuleName(self, bl, b); + + if (rc) + return 0; + to = b - 1; + while (*++to) + if (*to == '\\') + *to = '/'; + to = b; + } + break; + case 'e': case 'E': + if (flags & dir_subst_fatal) { + dTHX; + + to = execname2buffer(b, bl, PL_origargv[0]); + } else + to = execname2buffer(b, bl, NULL); + break; + } + if (!to) + return NULL; + if (strip) { + e = strrchr(to, '/'); + if (!e && (flags & dir_subst_fatal)) + Perl_croak_nocontext("%s: Can't parse EXE/DLL name: '%s'", msg, to); + else if (!e) + return NULL; + *e = 0; + } + s += froml; l -= froml; + if (!l) + return to; + if (!tol) + tol = strlen(to); + + while (l >= 3 && (s[0] == '/' || s[0] == '\\') + && s[1] == '.' && s[2] == '.' + && (l == 3 || s[3] == '/' || s[3] == '\\' || s[3] == ';')) { + e = strrchr(b, '/'); + if (!e && (flags & dir_subst_fatal)) + Perl_croak_nocontext("%s: Error stripping dirs from EXE/DLL/INSTALLDIR name", msg); + else if (!e) + return NULL; + *e = 0; + l -= 3; s += 3; + } + if (l && s[0] != '/' && s[0] != '\\' && s[0] != ';') + *e++ = '/'; + } + } /* Else: copy as is */ + if (l && (flags & dir_subst_pathlike)) { + STRLEN i = 0; + + while ( i < l - 2 && s[i] != ';') /* May have ~char after `;' */ + i++; + if (i < l - 2) { /* Found */ + rest = l - i - 1; + l = i + 1; + } + } + if (e + l >= b + bl) { + if (flags & dir_subst_fatal) + Perl_croak_nocontext("%s: name `%s%s' too long", msg, b, s); + else + return NULL; + } + memcpy(e, s, l); + if (rest) { + e = dir_subst(s + l, rest, e + l, bl - (e + l - b), flags, msg); + return e ? b : e; + } + e[l] = 0; + return b; +} + +char * +perllib_mangle_with(char *s, unsigned int l, char *from, unsigned int froml, char *to, unsigned int tol) +{ + if (!to) + return s; + if (l == 0) + l = strlen(s); + if (l < froml || strnicmp(from, s, froml) != 0) + return s; + if (l + tol - froml > STATIC_FILE_LENGTH || tol > STATIC_FILE_LENGTH) + Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); + if (to && to != mangle_ret) + memcpy(mangle_ret, to, tol); + strcpy(mangle_ret + tol, s + froml); + return mangle_ret; +} + char * perllib_mangle(char *s, unsigned int l) { + char *name; + + if (perllib_mangle_installed && (name = perllib_mangle_installed(s,l))) + return name; if (!newp && !notfound) { - newp = getenv("PERLLIB_" STRINGIFY(PERL_REVISION) + newp = getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) STRINGIFY(PERL_VERSION) STRINGIFY(PERL_SUBVERSION) "_PREFIX"); if (!newp) - newp = getenv("PERLLIB_" STRINGIFY(PERL_REVISION) + newp = getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) STRINGIFY(PERL_VERSION) "_PREFIX"); if (!newp) - newp = getenv("PERLLIB_" STRINGIFY(PERL_REVISION) "_PREFIX"); + newp = getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) "_PREFIX"); if (!newp) - newp = getenv("PERLLIB_PREFIX"); + newp = getenv(name = "PERLLIB_PREFIX"); if (newp) { - char *s; + char *s, b[300]; oldp = newp; - while (*newp && !isSPACE(*newp) && *newp != ';') { - newp++; oldl++; /* Skip digits. */ - } - while (*newp && (isSPACE(*newp) || *newp == ';')) { + while (*newp && !isSPACE(*newp) && *newp != ';') + newp++; /* Skip old name. */ + oldl = newp - oldp; + s = dir_subst(oldp, oldl, b, sizeof b, dir_subst_fatal, name); + oldp = savepv(s); + oldl = strlen(s); + while (*newp && (isSPACE(*newp) || *newp == ';')) newp++; /* Skip whitespace. */ - } - newl = strlen(newp); - if (newl == 0 || oldl == 0) { - Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); - } - strcpy(mangle_ret, newp); - s = mangle_ret; - while (*s) { - if (*s == '\\') *s = '/'; - s++; - } - } else { + Perl_OS2_handler_install((void *)newp, Perlos2_handler_perllib_to); + if (newl == 0 || oldl == 0) + Perl_croak_nocontext("Malformed %s", name); + } else notfound = 1; - } } - if (!newp) { + if (!newp) return s; - } - if (l == 0) { + if (l == 0) l = strlen(s); - } - if (l < oldl || strnicmp(oldp, s, oldl) != 0) { + if (l < oldl || strnicmp(oldp, s, oldl) != 0) return s; - } - if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) { + if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); - } strcpy(mangle_ret + newl, s + oldl); return mangle_ret; } @@ -2394,6 +2603,105 @@ XS(XS_OS2_Errors2Drive) XSRETURN(1); } +int +async_mssleep(ULONG ms, int switch_priority) { + /* This is similar to DosSleep(), but has 8ms granularity in time-critical + threads even on Warp3. */ + HEV hevEvent1 = 0; /* Event semaphore handle */ + HTIMER htimerEvent1 = 0; /* Timer handle */ + APIRET rc = NO_ERROR; /* Return code */ + int ret = 1; + ULONG priority = 0, nesting; /* Shut down the warnings */ + PPIB pib; + PTIB tib; + char *e = NULL; + APIRET badrc; + + if (!(_emx_env & 0x200)) /* DOS */ + return !_sleep2(ms); + + os2cp_croak(DosCreateEventSem(NULL, /* Unnamed */ + &hevEvent1, /* Handle of semaphore returned */ + DC_SEM_SHARED, /* Shared needed for DosAsyncTimer */ + FALSE), /* Semaphore is in RESET state */ + "DosCreateEventSem"); + + if (ms >= switch_priority) + switch_priority = 0; + if (switch_priority) { + if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) + switch_priority = 0; + else { + /* In Warp3, to switch scheduling to 8ms step, one needs to do + DosAsyncTimer() in time-critical thread. On laters versions, + more and more cases of wait-for-something are covered. + + It turns out that on Warp3fp42 it is the priority at the time + of DosAsyncTimer() which matters. Let's hope that this works + with later versions too... XXXX + */ + priority = (tib->tib_ptib2->tib2_ulpri); + if ((priority & 0xFF00) == 0x0300) /* already time-critical */ + switch_priority = 0; + /* Make us time-critical. Just modifying TIB is not enough... */ + /* tib->tib_ptib2->tib2_ulpri = 0x0300;*/ + /* We do not want to run at high priority if a signal causes us + to longjmp() out of this section... */ + if (DosEnterMustComplete(&nesting)) + switch_priority = 0; + else + DosSetPriority(PRTYS_THREAD, PRTYC_TIMECRITICAL, 0, 0); + } + } + + if ((badrc = DosAsyncTimer(ms, + (HSEM) hevEvent1, /* Semaphore to post */ + &htimerEvent1))) /* Timer handler (returned) */ + e = "DosAsyncTimer"; + + if (switch_priority && tib->tib_ptib2->tib2_ulpri == 0x0300) { + /* Nobody switched priority while we slept... Ignore errors... */ + /* tib->tib_ptib2->tib2_ulpri = priority; */ /* Get back... */ + if (!(rc = DosSetPriority(PRTYS_THREAD, (priority>>8) & 0xFF, 0, 0))) + rc = DosSetPriority(PRTYS_THREAD, 0, priority & 0xFF, 0); + } + if (switch_priority) + rc = DosExitMustComplete(&nesting); /* Ignore errors */ + + /* The actual blocking call is made with "normal" priority. This way we + should not bother with DosSleep(0) etc. to compensate for us interrupting + higher-priority threads. The goal is to prohibit the system spending too + much time halt()ing, not to run us "no matter what". */ + if (!e) /* Wait for AsyncTimer event */ + badrc = DosWaitEventSem(hevEvent1, SEM_INDEFINITE_WAIT); + + if (e) ; /* Do nothing */ + else if (badrc == ERROR_INTERRUPT) + ret = 0; + else if (badrc) + e = "DosWaitEventSem"; + if ((rc = DosCloseEventSem(hevEvent1)) && !e) { /* Get rid of semaphore */ + e = "DosCloseEventSem"; + badrc = rc; + } + if (e) + os2cp_croak(badrc, e); + return ret; +} + +XS(XS_OS2_ms_sleep) /* for testing only... */ +{ + dXSARGS; + ULONG ms, lim; + + if (items > 2 || items < 1) + Perl_croak_nocontext("Usage: OS2::ms_sleep(wait_ms [, high_priority_limit])"); + ms = SvUV(ST(0)); + lim = items > 1 ? SvUV(ST(1)) : ms + 1; + async_mssleep(ms, lim); + XSRETURN_EMPTY; +} + ULONG (*pDosTmrQueryFreq) (PULONG); ULONG (*pDosTmrQueryTime) (unsigned long long *); @@ -2425,6 +2733,37 @@ XS(XS_OS2_Timer) XSRETURN(1); } +XS(XS_OS2_msCounter) +{ + dXSARGS; + + if (items != 0) + Perl_croak_nocontext("Usage: OS2::msCounter()"); + { + dXSTARG; + + XSprePUSH; PUSHu(msCounter()); + } + XSRETURN(1); +} + +XS(XS_OS2__InfoTable) +{ + dXSARGS; + int is_local = 0; + + if (items > 1) + Perl_croak_nocontext("Usage: OS2::_infoTable([isLocal])"); + if (items == 1) + is_local = (int)SvIV(ST(0)); + { + dXSTARG; + + XSprePUSH; PUSHu(InfoTable(is_local)); + } + XSRETURN(1); +} + static const char * const dc_fields[] = { "FAMILY", "IO_CAPS", @@ -3219,11 +3558,13 @@ typedef APIRET (*PELP)(PSZ path, ULONG type); #endif APIRET -ExtLIBPATH(ULONG ord, PSZ path, IV type) +ExtLIBPATH(ULONG ord, PSZ path, IV type, int fatal) { ULONG what; - PFN f = loadByOrdinal(ord, 1); /* Guarantied to load or die! */ + PFN f = loadByOrdinal(ord, fatal); /* if fatal: load or die! */ + if (!f) /* Impossible with fatal */ + return Perl_rc; if (type > 0) what = END_LIBPATH; else if (type == 0) @@ -3233,23 +3574,35 @@ ExtLIBPATH(ULONG ord, PSZ path, IV type) return (*(PELP)f)(path, what); } -#define extLibpath(to,type) \ - (CheckOSError(ExtLIBPATH(ORD_DosQueryExtLibpath, (to), (type))) ? NULL : (to) ) +#define extLibpath(to,type, fatal) \ + (CheckOSError(ExtLIBPATH(ORD_DosQueryExtLibpath, (to), (type), fatal)) ? NULL : (to) ) + +#define extLibpath_set(p,type, fatal) \ + (!CheckOSError(ExtLIBPATH(ORD_DosSetExtLibpath, (p), (type), fatal))) -#define extLibpath_set(p,type) \ - (!CheckOSError(ExtLIBPATH(ORD_DosSetExtLibpath, (p), (type)))) +static void +early_error(char *msg1, char *msg2, char *msg3) +{ /* Buffer overflow detected; there is very little we can do... */ + ULONG rc; + + DosWrite(2, msg1, strlen(msg1), &rc); + DosWrite(2, msg2, strlen(msg2), &rc); + DosWrite(2, msg3, strlen(msg3), &rc); + DosExit(EXIT_PROCESS, 2); +} XS(XS_Cwd_extLibpath) { dXSARGS; if (items < 0 || items > 1) - Perl_croak_nocontext("Usage: Cwd::extLibpath(type = 0)"); + Perl_croak_nocontext("Usage: OS2::extLibpath(type = 0)"); { IV type; char to[1024]; U32 rc; char * RETVAL; dXSTARG; + STRLEN l; if (items < 1) type = 0; @@ -3258,9 +3611,13 @@ XS(XS_Cwd_extLibpath) } to[0] = 1; to[1] = 0; /* Sometimes no error reported */ - RETVAL = extLibpath(to, type); + RETVAL = extLibpath(to, type, 1); /* Make errors fatal */ if (RETVAL && RETVAL[0] == 1 && RETVAL[1] == 0) - Perl_croak_nocontext("panic Cwd::extLibpath parameter"); + Perl_croak_nocontext("panic OS2::extLibpath parameter"); + l = strlen(to); + if (l >= sizeof(to)) + early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", + to, "'\r\n"); /* Will not return */ sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; } @@ -3271,7 +3628,7 @@ XS(XS_Cwd_extLibpath_set) { dXSARGS; if (items < 1 || items > 2) - Perl_croak_nocontext("Usage: Cwd::extLibpath_set(s, type = 0)"); + Perl_croak_nocontext("Usage: OS2::extLibpath_set(s, type = 0)"); { STRLEN n_a; char * s = (char *)SvPV(ST(0),n_a); @@ -3285,13 +3642,74 @@ XS(XS_Cwd_extLibpath_set) type = SvIV(ST(1)); } - RETVAL = extLibpath_set(s, type); + RETVAL = extLibpath_set(s, type, 1); /* Make errors fatal */ ST(0) = boolSV(RETVAL); if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } +ULONG +fill_extLibpath(int type, char *pre, char *post, int replace, char *msg) +{ + char buf[2048], *to = buf, buf1[300], *s; + STRLEN l; + ULONG rc; + + if (!pre && !post) + return 0; + if (pre) { + pre = dir_subst(pre, strlen(pre), buf1, sizeof buf1, dir_subst_pathlike, msg); + if (!pre) + return ERROR_INVALID_PARAMETER; + l = strlen(pre); + if (l >= sizeof(buf)/2) + return ERROR_BUFFER_OVERFLOW; + s = pre - 1; + while (*++s) + if (*s == '/') + *s = '\\'; /* Be extra causious */ + memcpy(to, pre, l); + if (!l || to[l-1] != ';') + to[l++] = ';'; + to += l; + } + + if (!replace) { + to[0] = 1; to[1] = 0; /* Sometimes no error reported */ + rc = ExtLIBPATH(ORD_DosQueryExtLibpath, to, type, 0); /* Do not croak */ + if (rc) + return rc; + if (to[0] == 1 && to[1] == 0) + return ERROR_INVALID_PARAMETER; + to += strlen(to); + if (buf + sizeof(buf) - 1 <= to) /* Buffer overflow */ + early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", + buf, "'\r\n"); /* Will not return */ + if (to > buf && to[-1] != ';') + *to++ = ';'; + } + if (post) { + post = dir_subst(post, strlen(post), buf1, sizeof buf1, dir_subst_pathlike, msg); + if (!post) + return ERROR_INVALID_PARAMETER; + l = strlen(post); + if (l + to - buf >= sizeof(buf) - 1) + return ERROR_BUFFER_OVERFLOW; + s = post - 1; + while (*++s) + if (*s == '/') + *s = '\\'; /* Be extra causious */ + memcpy(to, post, l); + if (!l || to[l-1] != ';') + to[l++] = ';'; + to += l; + } + *to = 0; + rc = ExtLIBPATH(ORD_DosSetExtLibpath, buf, type, 0); /* Do not croak */ + return rc; +} + /* Input: Address, BufLen APIRET APIENTRY DosQueryModFromEIP (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf, @@ -3303,9 +3721,6 @@ DeclOSFuncByORD(APIRET, _DosQueryModFromEIP,ORD_DosQueryModFromEIP, ULONG * Offset, ULONG Address), (hmod, obj, BufLen, Buf, Offset, Address)) -enum module_name_how { mod_name_handle, mod_name_shortname, mod_name_full, - mod_name_C_function = 0x100, mod_name_HMODULE = 0x200}; - static SV* module_name_at(void *pp, enum module_name_how how) { @@ -3351,9 +3766,6 @@ module_name_of_cv(SV *cv, enum module_name_how how) return module_name_at(CvXSUB(SvRV(cv)), how); } -/* Find module name to which *this* subroutine is compiled */ -#define module_name(how) module_name_at(&module_name_at, how) - XS(XS_OS2_DLLname) { dXSARGS; @@ -3589,6 +4001,8 @@ Xs_OS2_init(pTHX) newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file); newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file); + newXS("OS2::extLibpath", XS_Cwd_extLibpath, file); + newXS("OS2::extLibpath_set", XS_Cwd_extLibpath_set, file); } newXS("OS2::Error", XS_OS2_Error, file); newXS("OS2::Errors2Drive", XS_OS2_Errors2Drive, file); @@ -3620,6 +4034,9 @@ Xs_OS2_init(pTHX) newXSproto("OS2::_headerInfo", XS_OS2__headerInfo, file, "$$;$$"); newXSproto("OS2::libPath", XS_OS2_libPath, file, ""); newXSproto("OS2::Timer", XS_OS2_Timer, file, ""); + newXSproto("OS2::msCounter", XS_OS2_msCounter, file, ""); + newXSproto("OS2::ms_sleep", XS_OS2_ms_sleep, file, "$;$"); + newXSproto("OS2::_InfoTable", XS_OS2__InfoTable, file, ";$"); newXSproto("OS2::incrMaxFHandles", XS_OS2_incrMaxFHandles, file, ";$"); newXSproto("OS2::SysValues", XS_OS2_SysValues, file, ";$$"); newXSproto("OS2::SysValues_set", XS_OS2_SysValues_set, file, "$$;$"); @@ -3741,6 +4158,12 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) oldstack = tib->tib_pstack; oldstackend = tib->tib_pstacklimit; + if ( (char*)&s < (char*)oldstack + 4*1024 + || (char *)oldstackend < (char*)oldstack + 52*1024 ) + early_error("It is a lunacy to try to run EMX Perl ", + "with less than 64K of stack;\r\n", + " at least with non-EMX starter...\r\n"); + /* Minimize the damage to the stack via reducing the size of argv. */ if (flags & FORCE_EMX_INIT_CONTRACT_ARGV) { pib->pib_pchcmd = "\0\0"; /* Need 3 concatenated strings */ @@ -3863,7 +4286,7 @@ extern ULONG __os_version(); /* See system.doc */ void check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg) { - ULONG v_crt, v_emx, count = 0, rc, rc1, maybe_inited = 0; + ULONG v_crt, v_emx, count = 0, rc = NO_ERROR, rc1, maybe_inited = 0; static HMTX hmtx_emx_init = NULLHANDLE; static int emx_init_done = 0; @@ -4000,7 +4423,8 @@ Perl_OS2_init(char **env) void Perl_OS2_init3(char **env, void **preg, int flags) { - char *shell; + char *shell, *s; + ULONG rc; _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY); MALLOC_INIT; @@ -4009,15 +4433,20 @@ Perl_OS2_init3(char **env, void **preg, int flags) settmppath(); OS2_Perl_data.xs_init = &Xs_OS2_init; - if ( (shell = getenv("PERL_SH_DRIVE")) ) { + if (perl_sh_installed) { + int l = strlen(perl_sh_installed); + + New(1304, PL_sh_path, l + 1, char); + memcpy(PL_sh_path, perl_sh_installed, l + 1); + } else if ( (shell = getenv("PERL_SH_DRIVE")) ) { New(1304, PL_sh_path, strlen(SH_PATH) + 1, char); strcpy(PL_sh_path, SH_PATH); PL_sh_path[0] = shell[0]; } else if ( (shell = getenv("PERL_SH_DIR")) ) { int l = strlen(shell), i; - if (shell[l-1] == '/' || shell[l-1] == '\\') { + + while (l && (shell[l-1] == '/' || shell[l-1] == '\\')) l--; - } New(1304, PL_sh_path, l + 8, char); strncpy(PL_sh_path, shell, l); strcpy(PL_sh_path + l, "/sh.exe"); @@ -4032,6 +4461,29 @@ Perl_OS2_init3(char **env, void **preg, int flags) os2_mytype = my_type(); /* Do it before morphing. Needed? */ os2_mytype_ini = os2_mytype; Perl_os2_initial_mode = -1; /* Uninit */ + + s = getenv("PERL_BEGINLIBPATH"); + if (s) + rc = fill_extLibpath(0, s, NULL, 1, "PERL_BEGINLIBPATH"); + else + rc = fill_extLibpath(0, getenv("PERL_PRE_BEGINLIBPATH"), getenv("PERL_POST_BEGINLIBPATH"), 0, "PERL_(PRE/POST)_BEGINLIBPATH"); + if (!rc) { + s = getenv("PERL_ENDLIBPATH"); + if (s) + rc = fill_extLibpath(1, s, NULL, 1, "PERL_ENDLIBPATH"); + else + rc = fill_extLibpath(1, getenv("PERL_PRE_ENDLIBPATH"), getenv("PERL_POST_ENDLIBPATH"), 0, "PERL_(PRE/POST)_ENDLIBPATH"); + } + if (rc) { + char buf[1024]; + + snprintf(buf, sizeof buf, "Error setting BEGIN/ENDLIBPATH: %s\n", + os2error(rc)); + DosWrite(2, buf, strlen(buf), &rc); + exit(2); + } + + _emxload_env("PERL_EMXLOAD_SECS"); /* Some DLLs reset FP flags on load. We may have been linked with them */ _control87(MCW_EM, MCW_EM); } @@ -4460,3 +4912,52 @@ int fork_with_resources() return rc; } +/* APIRET APIENTRY DosGetInfoSeg(PSEL pselGlobal, PSEL pselLocal); */ + +ULONG _THUNK_FUNCTION(Dos16GetInfoSeg)(USHORT *pGlobal, USHORT *pLocal); + +APIRET APIENTRY +myDosGetInfoSeg(PGINFOSEG *pGlobal, PLINFOSEG *pLocal) +{ + APIRET rc; + USHORT gSel, lSel; /* Will not cross 64K boundary */ + + rc = ((USHORT) + (_THUNK_PROLOG (4+4); + _THUNK_FLAT (&gSel); + _THUNK_FLAT (&lSel); + _THUNK_CALL (Dos16GetInfoSeg))); + if (rc) + return rc; + *pGlobal = MAKEPGINFOSEG(gSel); + *pLocal = MAKEPLINFOSEG(lSel); + return rc; +} + +static void +GetInfoTables(void) +{ + ULONG rc = 0; + + MUTEX_LOCK(&perlos2_state_mutex); + if (!gTable) + rc = myDosGetInfoSeg(&gTable, &lTable); + MUTEX_UNLOCK(&perlos2_state_mutex); + os2cp_croak(rc, "Dos16GetInfoSeg"); +} + +ULONG +msCounter(void) +{ /* XXXX Is not lTable thread-specific? */ + if (!gTable) + GetInfoTables(); + return gTable->SIS_MsCount; +} + +ULONG +InfoTable(int local) +{ + if (!gTable) + GetInfoTables(); + return local ? (ULONG)lTable : (ULONG)gTable; +} diff --git a/gnu/usr.bin/perl/os2/os2ish.h b/gnu/usr.bin/perl/os2/os2ish.h index dbd5d94c876..7b9fabf376c 100644 --- a/gnu/usr.bin/perl/os2/os2ish.h +++ b/gnu/usr.bin/perl/os2/os2ish.h @@ -320,6 +320,11 @@ void my_setpwent (void); void my_endpwent (void); char *gcvt_os2(double value, int digits, char *buffer); +extern int async_mssleep(unsigned long ms, int switch_priority); +extern unsigned long msCounter(void); +extern unsigned long InfoTable(int local); +extern unsigned long find_myself(void); + #define MAX_SLEEP (((1<30) / (1000/4))-1) /* 1<32 msec */ static __inline__ unsigned @@ -360,7 +365,7 @@ struct passwd *my_getpwnam (__const__ char *); #define strtoll _strtoll #define strtoull _strtoull -#define usleep(usec) ((void)_sleep2(((usec)+500)/1000)) +#define usleep(usec) ((void)async_mssleep(((usec)+500)/1000, 500)) /* @@ -751,6 +756,21 @@ enum entries_ordinals { void ResetWinError(void); void CroakWinError(int die, char *name); +enum Perlos2_handler { + Perlos2_handler_mangle = 1, + Perlos2_handler_perl_sh, + Perlos2_handler_perllib_from, + Perlos2_handler_perllib_to, +}; +enum dir_subst_e { + dir_subst_fatal = 1, + dir_subst_pathlike = 2 +}; + +extern int Perl_OS2_handler_install(void *handler, enum Perlos2_handler how); +extern char *dir_subst(char *s, unsigned int l, char *b, unsigned int bl, enum dir_subst_e flags, char *msg); +extern unsigned long fill_extLibpath(int type, char *pre, char *post, int replace, char *msg); + #define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n)) char *perllib_mangle(char *, unsigned int); @@ -761,7 +781,7 @@ static __inline__ int my_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timeval *timeout) { if (nfds == 0 && timeout && (_emx_env & 0x200)) { - if (DosSleep(1000 * timeout->tv_sec + (timeout->tv_usec + 500)/1000) == 0) + if (async_mssleep(1000 * timeout->tv_sec + (timeout->tv_usec + 500)/1000, 500)) return 0; errno = EINTR; return -1; @@ -784,6 +804,18 @@ int getpriority(int which /* ignored */, int pid); void croak_with_os2error(char *s) __attribute__((noreturn)); +/* void return value */ +#define os2cp_croak(rc,msg) (CheckOSError(rc) && (croak_with_os2error(msg),0)) + +/* propagates rc */ +#define os2win_croak(rc,msg) \ + SaveCroakWinError((expr), 1 /* die */, /* no prefix */, (msg)) + +/* propagates rc; use with functions which may return 0 on success */ +#define os2win_croak_0OK(rc,msg) \ + SaveCroakWinError((ResetWinError, (expr)), \ + 1 /* die */, /* no prefix */, (msg)) + #ifdef PERL_CORE int os2_do_spawn(pTHX_ char *cmd); int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp); @@ -853,6 +885,192 @@ int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp); #endif +/* ************************************************* */ +#ifndef MAKEPLINFOSEG + +/* From $DDK\base32\rel\os2c\include\base\os2\16bit\infoseg.h + typedefs */ + +/* + * The structure below defines the content and organization of the system + * information segment (InfoSeg). The actual table is statically defined in + * SDATA.ASM. Ring 0, read/write access is obtained by the clock device + * driver using the DevHlp GetDOSVar function. (GetDOSVar returns a ring 0, + * read-only selector to all other requestors.) + * + * In order to prevent an errant process from destroying the infoseg, two + * identical global infosegs are maintained. One is in the tiled shared + * arena and is accessible in user mode (and therefore can potentially be + * overwritten from ring 2), and the other is in the system arena and is + * accessible only in kernel mode. All kernel code (except the clock driver) + * is responsible for updating BOTH copies of the infoseg. The copy kept + * in the system arena is addressable as DOSGROUP:SISData, and the copy + * in the shared arena is addressable via a system arena alias. 16:16 and + * 0:32 pointers to the alias are stored in _Sis2. + */ + +typedef struct InfoSegGDT { + +/* Time (offset 0x00) */ + +unsigned long SIS_BigTime; /* Time from 1-1-1970 in seconds */ +unsigned long SIS_MsCount; /* Freerunning milliseconds counter */ +unsigned char SIS_HrsTime; /* Hours */ +unsigned char SIS_MinTime; /* Minutes */ +unsigned char SIS_SecTime; /* Seconds */ +unsigned char SIS_HunTime; /* Hundredths of seconds */ +unsigned short SIS_TimeZone; /* Timezone in min from GMT (Set to EST) */ +unsigned short SIS_ClkIntrvl; /* Timer interval (units=0.0001 secs) */ + +/* Date (offset 0x10) */ + +unsigned char SIS_DayDate; /* Day-of-month (1-31) */ +unsigned char SIS_MonDate; /* Month (1-12) */ +unsigned short SIS_YrsDate; /* Year (>= 1980) */ +unsigned char SIS_DOWDate; /* Day-of-week (1-1-80 = Tues = 3) */ + +/* Version (offset 0x15) */ + +unsigned char SIS_VerMajor; /* Major version number */ +unsigned char SIS_VerMinor; /* Minor version number */ +unsigned char SIS_RevLettr; /* Revision letter */ + +/* System Status (offset 0x18) */ + +unsigned char SIS_CurScrnGrp; /* Fgnd screen group # */ +unsigned char SIS_MaxScrnGrp; /* Maximum number of screen groups */ +unsigned char SIS_HugeShfCnt; /* Shift count for huge segments */ +unsigned char SIS_ProtMdOnly; /* Protect-mode-only indicator */ +unsigned short SIS_FgndPID; /* Foreground process ID */ + +/* Scheduler Parms (offset 0x1E) */ + +unsigned char SIS_Dynamic; /* Dynamic variation flag (1=enabled) */ +unsigned char SIS_MaxWait; /* Maxwait (seconds) */ +unsigned short SIS_MinSlice; /* Minimum timeslice (milliseconds) */ +unsigned short SIS_MaxSlice; /* Maximum timeslice (milliseconds) */ + +/* Boot Drive (offset 0x24) */ + +unsigned short SIS_BootDrv; /* Drive from which system was booted */ + +/* RAS Major Event Code Table (offset 0x26) */ + +unsigned char SIS_mec_table[32]; /* Table of RAS Major Event Codes (MECs) */ + +/* Additional Session Data (offset 0x46) */ + +unsigned char SIS_MaxVioWinSG; /* Max. no. of VIO windowable SG's */ +unsigned char SIS_MaxPresMgrSG; /* Max. no. of Presentation Manager SG's */ + +/* Error logging Information (offset 0x48) */ + +unsigned short SIS_SysLog; /* Error Logging Status */ + +/* Additional RAS Information (offset 0x4A) */ + +unsigned short SIS_MMIOBase; /* Memory mapped I/O selector */ +unsigned long SIS_MMIOAddr; /* Memory mapped I/O address */ + +/* Additional 2.0 Data (offset 0x50) */ + +unsigned char SIS_MaxVDMs; /* Max. no. of Virtual DOS machines */ +unsigned char SIS_Reserved; + +unsigned char SIS_perf_mec_table[32]; /* varga 6/5/97 Table of Perfomance Major Event Codes (MECS) varga*/ +} GINFOSEG, *PGINFOSEG; + +#define SIS_LEN sizeof(struct InfoSegGDT) + +/* + * InfoSeg LDT Data Segment Structure + * + * The structure below defines the content and organization of the system + * information in a special per-process segment to be accessible by the + * process through the LDT (read-only). + * + * As in the global infoseg, two copies of the current processes local + * infoseg exist, one accessible in both user and kernel mode, the other + * only in kernel mode. Kernel code is responsible for updating BOTH copies. + * Pointers to the local infoseg copy are stored in _Lis2. + * + * Note that only the currently running process has an extra copy of the + * local infoseg. The copy is done at context switch time. + */ + +typedef struct InfoSegLDT { +unsigned short LIS_CurProcID; /* Current process ID */ +unsigned short LIS_ParProcID; /* Process ID of parent */ +unsigned short LIS_CurThrdPri; /* Current thread priority */ +unsigned short LIS_CurThrdID; /* Current thread ID */ +unsigned short LIS_CurScrnGrp; /* Screengroup */ +unsigned char LIS_ProcStatus; /* Process status bits */ +unsigned char LIS_fillbyte1; /* filler byte */ +unsigned short LIS_Fgnd; /* Current process is in foreground */ +unsigned char LIS_ProcType; /* Current process type */ +unsigned char LIS_fillbyte2; /* filler byte */ + +unsigned short LIS_AX; /* @@V1 Environment selector */ +unsigned short LIS_BX; /* @@V1 Offset of command line start */ +unsigned short LIS_CX; /* @@V1 Length of Data Segment */ +unsigned short LIS_DX; /* @@V1 STACKSIZE from the .EXE file */ +unsigned short LIS_SI; /* @@V1 HEAPSIZE from the .EXE file */ +unsigned short LIS_DI; /* @@V1 Module handle of the application */ +unsigned short LIS_DS; /* @@V1 Data Segment Handle of application */ + +unsigned short LIS_PackSel; /* First tiled selector in this EXE */ +unsigned short LIS_PackShrSel; /* First selector above shared arena */ +unsigned short LIS_PackPckSel; /* First selector above packed arena */ +/* #ifdef SMP */ +unsigned long LIS_pTIB; /* Pointer to TIB */ +unsigned long LIS_pPIB; /* Pointer to PIB */ +/* #endif */ +} LINFOSEG, *PLINFOSEG; + +#define LIS_LEN sizeof(struct InfoSegLDT) + + +/* + * Process Type codes + * + * These are the definitons for the codes stored + * in the LIS_ProcType field in the local infoseg. + */ + +#define LIS_PT_FULLSCRN 0 /* Full screen app. */ +#define LIS_PT_REALMODE 1 /* Real mode process */ +#define LIS_PT_VIOWIN 2 /* VIO windowable app. */ +#define LIS_PT_PRESMGR 3 /* Presentation Manager app. */ +#define LIS_PT_DETACHED 4 /* Detached app. */ + + +/* + * + * Process Status Bit Definitions + * + */ + +#define LIS_PS_EXITLIST 0x01 /* In exitlist handler */ + + +/* + * Flags equates for the Global Info Segment + * SIS_SysLog WORD in Global Info Segment + * + * xxxx xxxx xxxx xxx0 Error Logging Disabled + * xxxx xxxx xxxx xxx1 Error Logging Enabled + * + * xxxx xxxx xxxx xx0x Error Logging not available + * xxxx xxxx xxxx xx1x Error Logging available + */ + +#define LF_LOGENABLE 0x0001 /* Logging enabled */ +#define LF_LOGAVAILABLE 0x0002 /* Logging available */ + +#define MAKEPGINFOSEG(sel) ((PGINFOSEG)MAKEP(sel, 0)) +#define MAKEPLINFOSEG(sel) ((PLINFOSEG)MAKEP(sel, 0)) + +#endif /* ndef(MAKEPLINFOSEG) */ + /* ************************************************************ */ #define Dos32QuerySysState DosQuerySysState #define QuerySysState(flags, pid, buf, bufsz) \ diff --git a/gnu/usr.bin/perl/os2/perl2cmd.pl b/gnu/usr.bin/perl/os2/perl2cmd.pl index 4db40a0a313..07529ad8e82 100644 --- a/gnu/usr.bin/perl/os2/perl2cmd.pl +++ b/gnu/usr.bin/perl/os2/perl2cmd.pl @@ -2,6 +2,7 @@ # Note that we cannot put hashbang to be extproc to make Configure work. use Config; +use File::Compare; $dir = shift; $dir =~ s|/|\\|g ; @@ -26,9 +27,11 @@ foreach $file (<$idir/*>) { $base =~ s|\.pl$||; #$file =~ s|/|\\|g ; warn "Clashing output name for $file, skipping" if $seen{$base}++; - print "Processing $file => $dir\\$base.cmd\n"; + my $new = (-f "$dir/$base.cmd" ? '' : ' (new file)'); + print "Processing $file => $dir/$base.cmd$new\n"; + my $ext = ($new ? '.cmd' : '.tcm'); open IN, '<', $file or warn, next; - open OUT, '>', "$dir/$base.cmd" or warn, next; + open OUT, '>', "$dir/$base$ext" or warn, next; my $firstline = <IN>; my $flags = ''; $flags = $2 if $firstline =~ /^#!\s*(\S+)\s+-([^#]+?)\s*(#|$)/; @@ -36,5 +39,16 @@ foreach $file (<$idir/*>) { print OUT $_ while <IN>; close IN or warn, next; close OUT or warn, next; + chmod 0444, "$dir/$base$ext"; + next if $new; + if (compare "$dir/$base$ext", "$dir/$base.cmd") { # different + chmod 0666, "$dir/$base.cmd"; + unlink "$dir/$base.cmd"; + rename "$dir/$base$ext", "$dir/$base.cmd"; + } else { + chmod 0666, "$dir/$base$ext"; + unlink "$dir/$base$ext"; + print "...unchanged...\n"; + } } diff --git a/gnu/usr.bin/perl/patchlevel.h b/gnu/usr.bin/perl/patchlevel.h index ba1979b4670..b1b9cc69fd3 100644 --- a/gnu/usr.bin/perl/patchlevel.h +++ b/gnu/usr.bin/perl/patchlevel.h @@ -15,7 +15,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 8 /* epoch */ -#define PERL_SUBVERSION 2 /* generation */ +#define PERL_SUBVERSION 3 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API diff --git a/gnu/usr.bin/perl/perl.c b/gnu/usr.bin/perl/perl.c index 89715c90d03..aeb819fef9b 100644 --- a/gnu/usr.bin/perl/perl.c +++ b/gnu/usr.bin/perl/perl.c @@ -921,9 +921,6 @@ perl_destruct(pTHXx) SvREFCNT(&PL_sv_undef) = 0; SvREADONLY_off(&PL_sv_undef); - SvREFCNT(&PL_sv_placeholder) = 0; - SvREADONLY_off(&PL_sv_placeholder); - Safefree(PL_origfilename); PL_origfilename = Nullch; Safefree(PL_reg_start_tmp); diff --git a/gnu/usr.bin/perl/perl.h b/gnu/usr.bin/perl/perl.h index b070bd636eb..a111047337c 100644 --- a/gnu/usr.bin/perl/perl.h +++ b/gnu/usr.bin/perl/perl.h @@ -1318,6 +1318,7 @@ typedef NVTYPE NV; # define Perl_atan2 atan2l # define Perl_pow powl # define Perl_floor floorl +# define Perl_ceil ceill # define Perl_fmod fmodl # endif /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ @@ -1388,6 +1389,7 @@ long double modfl(long double, long double *); # define Perl_atan2 atan2 # define Perl_pow pow # define Perl_floor floor +# define Perl_ceil ceil # define Perl_fmod fmod # define Perl_modf(x,y) modf(x,y) # define Perl_frexp(x,y) frexp(x,y) diff --git a/gnu/usr.bin/perl/perly.c b/gnu/usr.bin/perl/perly.c index cba0e74daee..542eb128e90 100644 --- a/gnu/usr.bin/perl/perly.c +++ b/gnu/usr.bin/perl/perly.c @@ -1395,7 +1395,7 @@ static char *yyrule[] = { #define YYMAXDEPTH 500 #endif #endif -#line 793 "perly.y" +#line 794 "perly.y" /* PROGRAM */ /* more stuff added to make perly_c.diff easier to apply */ @@ -1998,185 +1998,186 @@ case 88: break; case 91: #line 480 "perly.y" -{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); } +{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); + PL_expect = XOPERATOR; } break; case 92: -#line 482 "perly.y" +#line 483 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 93: -#line 484 "perly.y" +#line 485 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 94: -#line 488 "perly.y" +#line 489 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 95: -#line 492 "perly.y" +#line 493 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 96: -#line 495 "perly.y" +#line 496 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 97: -#line 500 "perly.y" +#line 501 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 98: -#line 505 "perly.y" +#line 506 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-3].opval))); } break; case 99: -#line 508 "perly.y" +#line 509 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-4].opval)))); } break; case 100: -#line 513 "perly.y" +#line 514 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-3].opval)))); } break; case 101: -#line 517 "perly.y" +#line 518 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-2].opval))); } break; case 102: -#line 523 "perly.y" +#line 524 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 103: -#line 525 "perly.y" +#line 526 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 104: -#line 527 "perly.y" +#line 528 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; case 105: -#line 531 "perly.y" +#line 532 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 106: -#line 533 "perly.y" +#line 534 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 107: -#line 535 "perly.y" +#line 536 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 108: -#line 537 "perly.y" +#line 538 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 109: -#line 539 "perly.y" +#line 540 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 110: -#line 541 "perly.y" +#line 542 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 111: -#line 543 "perly.y" +#line 544 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 112: -#line 545 "perly.y" +#line 546 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 113: -#line 547 "perly.y" +#line 548 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 114: -#line 549 "perly.y" +#line 550 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 115: -#line 554 "perly.y" +#line 555 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 116: -#line 556 "perly.y" +#line 557 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: -#line 558 "perly.y" +#line 559 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 118: -#line 560 "perly.y" +#line 561 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 119: -#line 562 "perly.y" +#line 563 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 120: -#line 565 "perly.y" +#line 566 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 121: -#line 568 "perly.y" +#line 569 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 122: -#line 571 "perly.y" +#line 572 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 123: -#line 578 "perly.y" +#line 579 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 124: -#line 580 "perly.y" +#line 581 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 125: -#line 582 "perly.y" +#line 583 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 126: -#line 584 "perly.y" +#line 585 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 127: -#line 586 "perly.y" +#line 587 "perly.y" { yyval.opval = newANONATTRSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 128: -#line 592 "perly.y" +#line 593 "perly.y" { yyval.opval = dofile(yyvsp[0].opval); } break; case 129: -#line 594 "perly.y" +#line 595 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 130: -#line 596 "perly.y" +#line 597 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -2186,7 +2187,7 @@ case 130: )),Nullop)); dep();} break; case 131: -#line 604 "perly.y" +#line 605 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -2197,76 +2198,76 @@ case 131: )))); dep();} break; case 132: -#line 613 "perly.y" +#line 614 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 133: -#line 617 "perly.y" +#line 618 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 138: -#line 629 "perly.y" +#line 630 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 139: -#line 631 "perly.y" +#line 632 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 140: -#line 633 "perly.y" +#line 634 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 141: -#line 635 "perly.y" +#line 636 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 142: -#line 637 "perly.y" +#line 638 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 143: -#line 639 "perly.y" +#line 640 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 144: -#line 641 "perly.y" +#line 642 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 145: -#line 643 "perly.y" +#line 644 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 146: -#line 645 "perly.y" +#line 646 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 147: -#line 647 "perly.y" +#line 648 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 148: -#line 649 "perly.y" +#line 650 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 149: -#line 651 "perly.y" +#line 652 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 150: -#line 653 "perly.y" +#line 654 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 151: -#line 655 "perly.y" +#line 656 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 152: -#line 657 "perly.y" +#line 658 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -2274,7 +2275,7 @@ case 152: ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 153: -#line 663 "perly.y" +#line 664 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -2283,179 +2284,179 @@ case 153: PL_expect = XOPERATOR; } break; case 154: -#line 670 "perly.y" +#line 671 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 155: -#line 672 "perly.y" +#line 673 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 156: -#line 674 "perly.y" +#line 675 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 157: -#line 676 "perly.y" +#line 677 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 158: -#line 679 "perly.y" +#line 680 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 159: -#line 682 "perly.y" +#line 683 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 160: -#line 685 "perly.y" +#line 686 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 161: -#line 687 "perly.y" +#line 688 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 162: -#line 689 "perly.y" +#line 690 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 163: -#line 691 "perly.y" +#line 692 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 164: -#line 693 "perly.y" +#line 694 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 165: -#line 695 "perly.y" +#line 696 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 166: -#line 698 "perly.y" +#line 699 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 167: -#line 700 "perly.y" +#line 701 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 168: -#line 702 "perly.y" +#line 703 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[0].opval)); } break; case 169: -#line 705 "perly.y" +#line 706 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 170: -#line 707 "perly.y" +#line 708 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 171: -#line 709 "perly.y" +#line 710 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 172: -#line 711 "perly.y" +#line 712 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 175: -#line 718 "perly.y" +#line 719 "perly.y" { yyval.opval = my_attrs(yyvsp[-1].opval,yyvsp[0].opval); } break; case 176: -#line 720 "perly.y" +#line 721 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 177: -#line 725 "perly.y" +#line 726 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 178: -#line 727 "perly.y" +#line 728 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 179: -#line 729 "perly.y" +#line 730 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 180: -#line 731 "perly.y" +#line 732 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 181: -#line 733 "perly.y" +#line 734 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 182: -#line 738 "perly.y" +#line 739 "perly.y" { yyval.opval = Nullop; } break; case 183: -#line 740 "perly.y" +#line 741 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 184: -#line 744 "perly.y" +#line 745 "perly.y" { yyval.opval = Nullop; } break; case 185: -#line 746 "perly.y" +#line 747 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 186: -#line 748 "perly.y" +#line 749 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 187: -#line 754 "perly.y" +#line 755 "perly.y" { PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 188: -#line 758 "perly.y" +#line 759 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 189: -#line 762 "perly.y" +#line 763 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 190: -#line 766 "perly.y" +#line 767 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 191: -#line 770 "perly.y" +#line 771 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 192: -#line 774 "perly.y" +#line 775 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 193: -#line 778 "perly.y" +#line 779 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 194: -#line 783 "perly.y" +#line 784 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 195: -#line 785 "perly.y" +#line 786 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 196: -#line 787 "perly.y" +#line 788 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 197: -#line 790 "perly.y" +#line 791 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2459 "perly.c" +#line 2460 "perly.c" } yyssp -= yym; yystate = *yyssp; diff --git a/gnu/usr.bin/perl/perly.y b/gnu/usr.bin/perl/perly.y index f87f5815646..3325e5e24b3 100644 --- a/gnu/usr.bin/perl/perly.y +++ b/gnu/usr.bin/perl/perly.y @@ -477,7 +477,8 @@ method : METHOD subscripted: star '{' expr ';' '}' /* *main::{something} */ /* In this and all the hash accessors, ';' is * provided by the tokeniser */ - { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); } + { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); + PL_expect = XOPERATOR; } | scalar '[' expr ']' /* $array[$element] */ { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); } | term ARROW '[' expr ']' /* somearef->[$element] */ diff --git a/gnu/usr.bin/perl/plan9/config.plan9 b/gnu/usr.bin/perl/plan9/config.plan9 index b717735c1d3..ef629ff49f4 100644 --- a/gnu/usr.bin/perl/plan9/config.plan9 +++ b/gnu/usr.bin/perl/plan9/config.plan9 @@ -3357,8 +3357,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/sys/lib/perl/5.8.2" /**/ -#define PRIVLIB_EXP "/sys/lib/perl/5.8.2" /**/ +#define PRIVLIB "/sys/lib/perl/5.8.3" /**/ +#define PRIVLIB_EXP "/sys/lib/perl/5.8.3" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -3485,9 +3485,9 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/sys/lib/perl/5.8.2/site_perl" /**/ -#define SITELIB_EXP "/sys/lib/perl/5.8.2/site_perl" /**/ -#define SITELIB_STEM "/sys/lib/perl/5.8.2/site_perl" /**/ +#define SITELIB "/sys/lib/perl/5.8.3/site_perl" /**/ +#define SITELIB_EXP "/sys/lib/perl/5.8.3/site_perl" /**/ +#define SITELIB_STEM "/sys/lib/perl/5.8.3/site_perl" /**/ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. diff --git a/gnu/usr.bin/perl/plan9/plan9ish.h b/gnu/usr.bin/perl/plan9/plan9ish.h index 5c922cf0ba5..c3ae06790ab 100644 --- a/gnu/usr.bin/perl/plan9/plan9ish.h +++ b/gnu/usr.bin/perl/plan9/plan9ish.h @@ -93,9 +93,7 @@ */ /* #define ALTERNATE_SHEBANG "#!" / **/ -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) -# include <signal.h> -#endif +#include <signal.h> #ifndef SIGABRT # define SIGABRT SIGILL diff --git a/gnu/usr.bin/perl/pod/buildtoc b/gnu/usr.bin/perl/pod/buildtoc index 4f9e6849b46..86d5ba7ebf7 100644 --- a/gnu/usr.bin/perl/pod/buildtoc +++ b/gnu/usr.bin/perl/pod/buildtoc @@ -2,7 +2,8 @@ use strict; use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore - @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules); + @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules + %Copies); use File::Spec; use File::Find; use FindBin; @@ -80,17 +81,19 @@ chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!"; open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!"; +my ($delta_source, $delta_target); + foreach (<MASTER>) { next if /^\#/; # At least one upper case letter somewhere in the first group - if (/^(\S+)\s(.*)/ && $1 =~ tr/A-Z//) { + if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) { # it's a heading my $flags = $1; + $flags =~ tr/h//d; my %flags = (header => 1); - $flags{toc_omit} = 1 if $flags =~ tr/O//d; - $flags{include} = 1 if $flags =~ tr/I//d; - $flags{aux} = 1 if $flags =~ tr/A//d; + $flags{toc_omit} = 1 if $flags =~ tr/o//d; + $flags{aux} = 1 if $flags =~ tr/a//d; die "$0: Unknown flag found in heading line: $_" if length $flags; push @Master, [\%flags, $2]; @@ -100,8 +103,18 @@ foreach (<MASTER>) { my %flags = (indent => 0); $flags{indent} = $1 if $flags =~ s/(\d+)//; - $flags{toc_omit} = 1 if $flags =~ tr/o//d; + $flags{toc_omit} = 1 if $flags =~ tr/o//d; $flags{aux} = 1 if $flags =~ tr/a//d; + + if ($flags =~ tr/D//d) { + $flags{perlpod_omit} = 1; + $delta_source = "$filename.pod"; + } + if ($flags =~ tr/d//d) { + $flags{manifest_omit} = 1; + $delta_target = "$filename.pod"; + } + if ($flags =~ tr/r//d) { my $readme = $filename; $readme =~ s/^perl//; @@ -120,6 +133,19 @@ foreach (<MASTER>) { die "$0: Malformed line: $_" if $1 =~ tr/A-Z//; } } +if (defined $delta_source) { + if (defined $delta_target) { + # This way round so that keys can act as a MANIFEST skip list + # Targets will aways be in the pod directory. Currently we can only cope + # with sources being in the same directory. Fix this and do perlvms.pod + # with this? + $Copies{$delta_target} = $delta_source; + } else { + die "$0: delta source defined but not target"; + } +} elsif (defined $delta_target) { + die "$0: delta target defined but not target"; +} close MASTER; @@ -130,6 +156,7 @@ close MASTER; my (@manireadmes, %manireadmes); my (@perlpods, %perlpods); my (%our_pods); + my (%sources); # Convert these to a list of filenames. foreach (keys %Pods, keys %Readmepods) { @@ -140,6 +167,10 @@ close MASTER; @disk_pods = glob("*.pod"); @disk_pods{@disk_pods} = @disk_pods; + # Things we copy from won't be in perl.pod + # Things we copy to won't be in MANIFEST + @sources{values %Copies} = (); + open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!"; while (<MANI>) { if (m!^pod/([^.]+\.pod)\s+!i) { @@ -170,9 +201,9 @@ close MASTER; warn "$0: $i exists but is unknown by buildtoc\n" unless $our_pods{$i}; warn "$0: $i exists but is unknown by ../MANIFEST\n" - if !$manipods{$i} && !$manireadmes{$i}; + if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i}; warn "$0: $i exists but is unknown by perl.pod\n" - unless $perlpods{$i}; + if !$perlpods{$i} && !exists $sources{$i}; } foreach my $i (sort keys %our_pods) { warn "$0: $i is known by buildtoc but does not exist\n" @@ -259,7 +290,7 @@ sub output ($); sub output_perltoc { open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!"; - $/ = ''; + local $/ = ''; ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_); @@ -453,6 +484,7 @@ sub generate_perlpod { foreach (@Master) { my $flags = $_->[0]; next if $flags->{aux}; + next if $flags->{perlpod_omit}; if (@$_ == 2) { # Heading @@ -486,7 +518,8 @@ sub generate_manifest { map {s/ \t/\t\t/g; $_} @temp; } sub generate_manifest_pod { - generate_manifest map {["pod/$_.pod", $Pods{$_}]} sort keys %Pods; + generate_manifest map {["pod/$_.pod", $Pods{$_}]} + grep {!$Copies{"$_.pod"}} sort keys %Pods; } sub generate_manifest_readme { generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes; @@ -522,8 +555,10 @@ SNIP } sub generate_nmake_1 { - map {sprintf "\tcopy ..\\README.%-8s .\\perl$_.pod\n", $_} - sort keys %Readmes; + # XXX Fix this with File::Spec + (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_} + sort keys %Readmes), + (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies); } # This doesn't have a trailing newline @@ -531,7 +566,8 @@ sub generate_nmake_2 { # Spot the special case local $Text::Wrap::columns = 76; my $line = wrap ("\t ", "\t ", - join " ", sort map {"perl$_.pod"} "vms", keys %Readmes); + join " ", sort keys %Copies, + map {"perl$_.pod"} "vms", keys %Readmes); $line =~ s/$/ \\/mg; $line; } @@ -568,9 +604,11 @@ sub do_nmake { my $sections = () = $makefile =~ m/\0+/g; die "$0: $name contains no README copies" if $sections < 1; die "$0: $name contains discontiguous README copies" if $sections > 1; - $makefile =~ s/\0+/join "", &generate_nmake_1/se; + # Now remove the other copies that follow + 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm; + $makefile =~ s/\0+/join ("", &generate_nmake_1)/se; - $makefile =~ s{(cd \$\(PODDIR\) && del /f [^\n]+).*?(pod2html)} + $makefile =~ s{(del /f [^\n]+checkpods[^\n]+).*?(pod2html)} {"$1\n" . &generate_nmake_2."\n\t $2"}se; $makefile; } @@ -597,7 +635,7 @@ sub do_perlpod { sub do_podmak { my $name = shift; my $body = join '', @_; - foreach my $variable qw(pod man html tex) { + foreach my $variable (qw(pod man html tex)) { die "$0: could not find $variable in $name" unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*} {"\n" . generate_pod_mak ($variable)}se; @@ -642,7 +680,9 @@ while (my ($target, $name) = each %Targets) { next unless $Build{$target}; $built++; if ($target eq "toc") { + print "Now processing $name\n" if $Verbose; &output_perltoc; + print "Finished\n" if $Verbose; next; } print "Now processing $name\n" if $Verbose; diff --git a/gnu/usr.bin/perl/pod/perl.pod b/gnu/usr.bin/perl/pod/perl.pod index b79f13670f8..5a24950c4e4 100644 --- a/gnu/usr.bin/perl/pod/perl.pod +++ b/gnu/usr.bin/perl/pod/perl.pod @@ -132,6 +132,7 @@ For ease of access, the Perl manual has been split up into several sections. perlhist Perl history records perldelta Perl changes since previous version + perl582delta Perl changes in version 5.8.2 perl581delta Perl changes in version 5.8.1 perl58delta Perl changes in version 5.8.0 perl573delta Perl changes in version 5.7.3 diff --git a/gnu/usr.bin/perl/pod/perl58delta.pod b/gnu/usr.bin/perl/pod/perl58delta.pod index 1b73be89e31..dbdac4345af 100644 --- a/gnu/usr.bin/perl/pod/perl58delta.pod +++ b/gnu/usr.bin/perl/pod/perl58delta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what is new for perl v5.8.0 +perl58delta - what is new for perl v5.8.0 =head1 DESCRIPTION diff --git a/gnu/usr.bin/perl/pod/perlbot.pod b/gnu/usr.bin/perl/pod/perlbot.pod index dc632ea4dab..91723b70d78 100644 --- a/gnu/usr.bin/perl/pod/perlbot.pod +++ b/gnu/usr.bin/perl/pod/perlbot.pod @@ -243,6 +243,9 @@ where that method is defined. $foo->goo; $foo->google; +Note that C<SUPER> refers to the superclasses of the current package +(C<Foo>), not to the superclasses of C<$self>. + =head1 USING RELATIONSHIP WITH SDBM diff --git a/gnu/usr.bin/perl/pod/perldelta.pod b/gnu/usr.bin/perl/pod/perldelta.pod deleted file mode 100644 index bf9f5fecec5..00000000000 --- a/gnu/usr.bin/perl/pod/perldelta.pod +++ /dev/null @@ -1,162 +0,0 @@ -=head1 NAME - -perldelta - what is new for perl v5.8.2 - -=head1 DESCRIPTION - -This document describes differences between the 5.8.1 release and -the 5.8.2 release. - -If you are upgrading from an earlier release such as 5.6.1, first read -the L<perl58delta>, which describes differences between 5.6.0 and -5.8.0, and the L<perl581delta>, which describes differences between -5.8.0 and 5.8.1. - -=head1 Incompatible Changes - -For threaded builds for modules calling certain re-entrant system calls, -binary compatibility was accidentally lost between 5.8.0 and 5.8.1. -Binary compatibility with 5.8.0 has been restored in 5.8.2, which -necessitates breaking compatibility with 5.8.1. We see this as the -lesser of two evils. - -This will only affect people who have a threaded perl 5.8.1, and compiled -modules which use these calls, and now attempt to run the compiled modules -with 5.8.2. The fix is to re-compile and re-install the modules using 5.8.2. - -=head1 Core Enhancements - -=head2 Hash Randomisation - -The hash randomisation introduced with 5.8.1 has been amended. It -transpired that although the implementation introduced in 5.8.1 was source -compatible with 5.8.0, it was not binary compatible in certain cases. 5.8.2 -contains an improved implementation which is both source and binary -compatible with both 5.8.0 and 5.8.1, and remains robust against the form of -attack which prompted the change for 5.8.1. - -We are grateful to the Debian project for their input in this area. -See L<perlsec/"Algorithmic Complexity Attacks"> for the original -rationale behind this change. - -=head2 Threading - -Several memory leaks associated with variables shared between threads -have been fixed. - -=head1 Modules and Pragmata - -=head2 Updated Modules And Pragmata - -The following modules and pragmata have been updated since Perl 5.8.1: - -=over 4 - -=item Devel::PPPort - -=item Digest::MD5 - -=item I18N::LangTags - -=item libnet - -=item MIME::Base64 - -=item Pod::Perldoc - -=item strict - -Documentation improved - -=item Tie::Hash - -Documentation improved - -=item Time::HiRes - -=item Unicode::Collate - -=item Unicode::Normalize - -=item UNIVERSAL - -Documentation improved - -=back - -=head1 Selected Bug Fixes - -Some syntax errors involving unrecognized filetest operators are now handled -correctly by the parser. - -=head1 Changed Internals - -Interpreter initialization is more complete when -DMULTIPLICITY is off. -This should resolve problems with initializing and destroying the Perl -interpreter more than once in a single process. - -=head1 Platform Specific Problems - -Dynamic linker flags have been tweaked for Solaris and OS X, which should -solve problems seen while building some XS modules. - -Bugs in OS/2 sockets and tmpfile have been fixed. - -In OS X C<setreuid> and friends are troublesome - perl will now work -around their problems as best possible. - -=head1 Future Directions - -Starting with 5.8.3 we intend to make more frequent maintenance releases, -with a smaller number of changes in each. The intent is to propagate -bug fixes out to stable releases more rapidly and make upgrading stable -releases less of an upheaval. This should give end users more -flexibility in their choice of upgrade timing, and allow them easier -assessment of the impact of upgrades. The current plan is for code freezes -as follows - -=over 4 - -=item * - -5.8.3 23:59:59 GMT, Wednesday December 31st 2003 - -=item * - -5.8.4 23:59:59 GMT, Wednesday March 31st 2004 - -=item * - -5.8.5 23:59:59 GMT, Wednesday June 30th 2004 - -=back - -with the release following soon after, when testing is complete. - -See L<perl581delta/"Future Directions"> for more soothsaying. - -=head1 Reporting Bugs - -If you find what you think is a bug, you might check the articles -recently posted to the comp.lang.perl.misc newsgroup and the perl -bug database at http://bugs.perl.org/. There may also be -information at http://www.perl.com/, the Perl Home Page. - -If you believe you have an unreported bug, please run the B<perlbug> -program included with your release. Be sure to trim your bug down -to a tiny but sufficient test case. Your bug report, along with the -output of C<perl -V>, will be sent off to perlbug@perl.org to be -analysed by the Perl porting team. You can browse and search -the Perl 5 bugs at http://bugs.perl.org/ - -=head1 SEE ALSO - -The F<Changes> file for exhaustive details on what changed. - -The F<INSTALL> file for how to build Perl. - -The F<README> file for general stuff. - -The F<Artistic> and F<Copying> files for copyright information. - -=cut diff --git a/gnu/usr.bin/perl/pod/perldiag.pod b/gnu/usr.bin/perl/pod/perldiag.pod index c9f90c51b17..1097be9eaf8 100644 --- a/gnu/usr.bin/perl/pod/perldiag.pod +++ b/gnu/usr.bin/perl/pod/perldiag.pod @@ -1298,6 +1298,12 @@ there are neither package declarations nor a C<$VERSION>. long for Perl to handle. You have to be seriously twisted to write code that triggers this error. +=item DESTROY created new reference to dead object '%s' + +(F) A DESTROY() method created a new reference to the object which is +just being DESTROYed. Perl is confused, and prefers to abort rather than +to create a dangling reference. + =item Did not produce a valid header See Server error. diff --git a/gnu/usr.bin/perl/pod/perlembed.pod b/gnu/usr.bin/perl/pod/perlembed.pod index 05feccd1bc2..2a31500237b 100644 --- a/gnu/usr.bin/perl/pod/perlembed.pod +++ b/gnu/usr.bin/perl/pod/perlembed.pod @@ -506,7 +506,16 @@ been wrapped here): PL_exit_flags |= PERL_EXIT_DESTRUCT_END; text = NEWSV(1099,0); - sv_setpv(text, "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*. He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount. The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH"); + sv_setpv(text, "When he is at a convenience store and the " + "bill comes to some amount like 76 cents, Maynard is " + "aware that there is something he *should* do, something " + "that will enable him to get back a quarter, but he has " + "no idea *what*. He fumbles through his red squeezey " + "changepurse and gives the boy three extra pennies with " + "his dollar, hoping that he might luck into the correct " + "amount. The boy gives him back two of his own pennies " + "and then the big shiny quarter that is his prize. " + "-RICHH"); if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/ printf("match: Text contains the word 'quarter'.\n\n"); diff --git a/gnu/usr.bin/perl/pod/perlfaq1.pod b/gnu/usr.bin/perl/pod/perlfaq1.pod index 13f8f421dd2..e868e2e7600 100644 --- a/gnu/usr.bin/perl/pod/perlfaq1.pod +++ b/gnu/usr.bin/perl/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.12 $, $Date: 2003/07/09 15:47:28 $) +perlfaq1 - General Questions About Perl ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -60,7 +60,7 @@ You should definitely use version 5. Version 4 is old, limited, and no longer maintained; its last patch (4.036) was in 1992, long ago and far away. Sure, it's stable, but so is anything that's dead; in fact, perl4 had been called a dead, flea-bitten camel carcass. The most -recent production release is 5.8.1 (although 5.005_03 and 5.6.1 are +recent production release is 5.8.2 (although 5.005_03 and 5.6.2 are still supported). The most cutting-edge development release is 5.9. Further references to the Perl language in this document refer to the production release unless otherwise specified. There may be one or @@ -102,6 +102,8 @@ will be used for Ponie, and there will be no language level differences between perl5 and ponie. Ponie is not a complete rewrite of perl5. +For more details, see http://www.poniecode.org/ + =head2 What is perl6? At The Second O'Reilly Open Source Software Convention, Larry Wall @@ -307,9 +309,11 @@ for any given task. Also mention that the difference between version (Well, OK, maybe it's not quite that distinct, but you get the idea.) If you want support and a reasonable guarantee that what you're developing will continue to work in the future, then you have to run -the supported version. As of October 2003 that means running either -5.8.1 (released in September 2003), or one of the older releases like -5.6.1 (released in April 2001) or 5.005_03 (released in March 1999), +the supported version. As of December 2003 that means running either +5.8.2 (released in November 2003), or one of the older releases like +5.6.2 (also released in November 2003; a maintenance release to let perl +5.6 compile on newer systems as 5.6.1 was released in April 2001) or +5.005_03 (released in March 1999), although 5.004_05 isn't that bad if you B<absolutely> need such an old version (released in April 1999) for stability reasons. Anything older than 5.004_05 shouldn't be used. diff --git a/gnu/usr.bin/perl/pod/perlfaq2.pod b/gnu/usr.bin/perl/pod/perlfaq2.pod index 8649ca8882d..929a8b64a92 100644 --- a/gnu/usr.bin/perl/pod/perlfaq2.pod +++ b/gnu/usr.bin/perl/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.20 $, $Date: 2003/01/26 17:50:56 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -407,10 +407,9 @@ 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 expressions, and networking, and sponsors the Obfuscated Perl Contest -and the Perl Poetry Contests. As of mid-2001, the dead tree version -of TPJ will be published as a quarterly supplement of SysAdmin -magazine ( http://www.sysadminmag.com/ ) For more details on TPJ, -see http://www.tpj.com/ +and the Perl Poetry Contests. Beginning in November 2002, TPJ moved to a +reader-supported monthly e-zine format in which subscribers can download +issues as PDF documents. For more details on TPJ, see http://www.tpj.com/ Beyond this, magazines that frequently carry quality articles on Perl are I<The Perl Review> ( http://www.theperlreview.com ), diff --git a/gnu/usr.bin/perl/pod/perlfaq3.pod b/gnu/usr.bin/perl/pod/perlfaq3.pod index 8fd484fea28..26c7b4c9843 100644 --- a/gnu/usr.bin/perl/pod/perlfaq3.pod +++ b/gnu/usr.bin/perl/pod/perlfaq3.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq3 - Programming Tools ($Revision: 1.35 $, $Date: 2003/08/24 05:26:59 $) +perlfaq3 - Programming Tools ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -65,7 +65,7 @@ You can use the ExtUtils::Installed module to show all installed distributions, although it can take awhile to do its magic. The standard library which comes with Perl just shows up as "Perl" (although you can get those with -Mod::CoreList). +Module::CoreList). use ExtUtils::Installed; diff --git a/gnu/usr.bin/perl/pod/perlfaq4.pod b/gnu/usr.bin/perl/pod/perlfaq4.pod index 61503b6c57b..2ff7c7110ef 100644 --- a/gnu/usr.bin/perl/pod/perlfaq4.pod +++ b/gnu/usr.bin/perl/pod/perlfaq4.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq4 - Data Manipulation ($Revision: 1.52 $, $Date: 2003/10/02 04:44:33 $) +perlfaq4 - Data Manipulation ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -362,9 +362,20 @@ pseudorandom generator than comes with your operating system, look at =head2 How do I get a random number between X and Y? -Use the following simple function. It selects a random integer between -(and possibly including!) the two given integers, e.g., -C<random_int_in(50,120)> +C<rand($x)> returns a number such that +C<< 0 <= rand($x) < $x >>. Thus what you want to have perl +figure out is a random number in the range from 0 to the +difference between your I<X> and I<Y>. + +That is, to get a number between 10 and 15, inclusive, you +want a random number between 0 and 5 that you can then add +to 10. + + my $number = 10 + int rand( 15-10+1 ); + +Hence you derive the following simple function to abstract +that. It selects a random integer between the two given +integers (inclusive), For example: C<random_int_in(50,120)>. sub random_int_in ($$) { my($min, $max) = @_; @@ -415,14 +426,6 @@ Use the following simple functions: return 1+int((((localtime(shift || time))[5] + 1899))/1000); } -You can also use the POSIX strftime() function which may be a bit -slower but is easier to read and maintain. - - use POSIX qw/strftime/; - - my $week_of_the_year = strftime "%W", localtime; - my $day_of_the_year = strftime "%j", localtime; - On some systems, the POSIX module's strftime() function has been extended in a non-standard way to use a C<%C> format, which they sometimes claim is the "century". It isn't, @@ -1489,16 +1492,11 @@ the hash is to be modified. Use the rand() function (see L<perlfunc/rand>): - # at the top of the program: - srand; # not needed for 5.004 and later - - # then later on $index = rand @array; $element = $array[$index]; -Make sure you I<only call srand once per program, if then>. -If you are calling it more than once (such as before each -call to rand), you're almost certainly doing something wrong. +Or, simply: + my $element = $array[ rand @array ]; =head2 How do I permute N elements of a list? diff --git a/gnu/usr.bin/perl/pod/perlfaq5.pod b/gnu/usr.bin/perl/pod/perlfaq5.pod index cad896d71f8..ccc8ebeb130 100644 --- a/gnu/usr.bin/perl/pod/perlfaq5.pod +++ b/gnu/usr.bin/perl/pod/perlfaq5.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq5 - Files and Formats ($Revision: 1.28 $, $Date: 2003/01/26 17:45:46 $) +perlfaq5 - Files and Formats ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -153,8 +153,10 @@ temporary files in one process, use a counter: =head2 How can I manipulate fixed-record-length files? -The most efficient way is using pack() and unpack(). This is faster than -using substr() when taking many, many strings. It is slower for just a few. +The most efficient way is using L<pack()|perlfunc/"pack"> and +L<unpack()|perlfunc/"unpack">. This is faster than using +L<substr()|perlfunc/"substr"> when taking many, many strings. It is +slower for just a few. Here is a sample chunk of code to break up and put back together again some fixed-format input lines, in this case from the output of a normal, @@ -162,22 +164,23 @@ Berkeley-style ps: # sample input line: # 15158 p5 T 0:00 perl /home/tchrist/scripts/now-what - $PS_T = 'A6 A4 A7 A5 A*'; - open(PS, "ps|"); - print scalar <PS>; - while (<PS>) { - ($pid, $tt, $stat, $time, $command) = unpack($PS_T, $_); - for $var (qw!pid tt stat time command!) { - print "$var: <$$var>\n"; + my $PS_T = 'A6 A4 A7 A5 A*'; + open my $ps, '-|', 'ps'; + print scalar <$ps>; + my @fields = qw( pid tt stat time command ); + while (<$ps>) { + my %process; + @process{@fields} = unpack($PS_T, $_); + for my $field ( @fields ) { + print "$field: <$process{$field}>\n"; } - print 'line=', pack($PS_T, $pid, $tt, $stat, $time, $command), - "\n"; + print 'line=', pack($PS_T, @process{@fields} ), "\n"; } -We've used C<$$var> in a way that forbidden by C<use strict 'refs'>. -That is, we've promoted a string to a scalar variable reference using -symbolic references. This is okay in small programs, but doesn't scale -well. It also only works on global variables, not lexicals. +We've used a hash slice in order to easily handle the fields of each row. +Storing the keys in an array means it's easy to operate on them as a +group or loop over them with for. It also avoids polluting the program +with global variables and using symbolic references. =head2 How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles? diff --git a/gnu/usr.bin/perl/pod/perlfunc.pod b/gnu/usr.bin/perl/pod/perlfunc.pod index 4f7b9a8e734..66194e66011 100644 --- a/gnu/usr.bin/perl/pod/perlfunc.pod +++ b/gnu/usr.bin/perl/pod/perlfunc.pod @@ -1033,8 +1033,18 @@ In the case of an array, if the array elements happen to be at the end, the size of the array will shrink to the highest element that tests true for exists() (or 0 if no such element exists). -Returns each element so deleted or the undefined value if there was no such -element. Deleting from C<$ENV{}> modifies the environment. Deleting from +Returns a list with the same number of elements as the number of elements +for which deletion was attempted. Each element of that list consists of +either the value of the element deleted, or the undefined value. In scalar +context, this means that you get the value of the last element deleted (or +the undefined value if that element did not exist). + + %hash = (foo => 11, bar => 22, baz => 33); + $scalar = delete $hash{foo}; # $scalar is 11 + $scalar = delete @hash{qw(foo bar)}; # $scalar is 22 + @array = delete @hash{qw(foo bar baz)}; # @array is (undef,undef,33) + +Deleting from C<%ENV> modifies the environment. Deleting from a hash tied to a DBM file deletes the entry from the DBM file. Deleting from a C<tie>d hash or array may not necessarily return anything. @@ -2328,7 +2338,8 @@ Perl for security reasons (see L<perlsec/"Algorithmic Complexity Attacks">). As a side effect, calling keys() resets the HASH's internal iterator, -see L</each>. +see L</each>. (In particular, calling keys() in void context resets +the iterator with no other overhead.) Here is yet another way to print your environment: @@ -5875,6 +5886,7 @@ A class implementing a hash should have the following methods: EXISTS this, key FIRSTKEY this NEXTKEY this, lastkey + SCALAR this DESTROY this UNTIE this @@ -6295,7 +6307,8 @@ function would produce on the same (unmodified) hash. Since Perl for security reasons (see L<perlsec/"Algorithmic Complexity Attacks">). As a side effect, calling values() resets the HASH's internal iterator, -see L</each>. +see L</each>. (In particular, calling values() in void context resets +the iterator with no other overhead.) Note that the values are not copied, which means modifying them will modify the contents of the hash: diff --git a/gnu/usr.bin/perl/pod/perlguts.pod b/gnu/usr.bin/perl/pod/perlguts.pod index 4b571b788a8..6fab812e8ee 100644 --- a/gnu/usr.bin/perl/pod/perlguts.pod +++ b/gnu/usr.bin/perl/pod/perlguts.pod @@ -1762,10 +1762,10 @@ are subject to the same restrictions as in the pass 2. =head2 Pluggable runops The compile tree is executed in a runops function. There are two runops -functions in F<run.c>. C<Perl_runops_debug> is used with DEBUGGING and -C<Perl_runops_standard> is used otherwise. For fine control over the -execution of the compile tree it is possible to provide your own runops -function. +functions, in F<run.c> and in F<dump.c>. C<Perl_runops_debug> is used +with DEBUGGING and C<Perl_runops_standard> is used otherwise. For fine +control over the execution of the compile tree it is possible to provide +your own runops function. It's probably best to copy one of the existing runops functions and change it to suit your needs. Then, in the BOOT section of your XS diff --git a/gnu/usr.bin/perl/pod/perlhist.pod b/gnu/usr.bin/perl/pod/perlhist.pod index d1efa16fab3..a114e497ba3 100644 --- a/gnu/usr.bin/perl/pod/perlhist.pod +++ b/gnu/usr.bin/perl/pod/perlhist.pod @@ -24,7 +24,8 @@ Perl history in brief, by Larry Wall: Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy -Sarathy, Graham Barr, Jarkko Hietaniemi. +Sarathy, Graham Barr, Jarkko Hietaniemi, Hugo van der Sanden, +Michael Schwern, Rafael Garcia-Suarez, Nicholas Clark, Richard Clamp. =head2 PUMPKIN? @@ -66,6 +67,7 @@ the strings?). 1.001..10 1988-Jan-30 1.011..14 1988-Feb-02 Schwern 1.0.15 2002-Dec-18 Modernization + Richard 1.0.16 2003-Dec-18 Larry 2.000 1988-Jun-05 @@ -346,7 +348,8 @@ the strings?). 5.6.1-TRIAL3 2001-Mar-19 5.6.1-foolish 2001-Apr-01 The "fools-gold" release. 5.6.1 2001-Apr-08 - Rafael 5.6.2 2003-???-?? + Rafael 5.6.2-RC1 2003-Nov-08 + 5.6.2 2003-Nov-15 Fix new build issues Jarkko 5.7.0 2000-Sep-02 The 5.7 track: Development. 5.7.1 2001-Apr-09 @@ -365,6 +368,8 @@ the strings?). Nicholas 5.8.2-RC1 2003-Oct-27 5.8.2-RC2 2003-Nov-03 5.8.2 2003-Nov-05 + 5.8.3-RC1 2004-Jan-07 + 5.8.3 2004-Jan-14 Hugo 5.9.0 2003-Oct-27 diff --git a/gnu/usr.bin/perl/pod/perlmod.pod b/gnu/usr.bin/perl/pod/perlmod.pod index c03862d64d7..084aef2f025 100644 --- a/gnu/usr.bin/perl/pod/perlmod.pod +++ b/gnu/usr.bin/perl/pod/perlmod.pod @@ -253,22 +253,34 @@ rather than: This also has implications for the use of the SUPER:: qualifier (see L<perlobj>). -=head2 Package Constructors and Destructors - -Four special subroutines act as package constructors and destructors. -These are the C<BEGIN>, C<CHECK>, C<INIT>, and C<END> routines. The -C<sub> is optional for these routines. - -A C<BEGIN> subroutine is executed as soon as possible, that is, the moment -it is completely defined, even before the rest of the containing file -is parsed. You may have multiple C<BEGIN> blocks within a file--they -will execute in order of definition. Because a C<BEGIN> block executes -immediately, it can pull in definitions of subroutines and such from other -files in time to be visible to the rest of the file. Once a C<BEGIN> -has run, it is immediately undefined and any code it used is returned to -Perl's memory pool. This means you can't ever explicitly call a C<BEGIN>. - -An C<END> subroutine is executed as late as possible, that is, after +=head2 BEGIN, CHECK, INIT and END + +Four specially named code blocks are executed at the beginning and at the end +of a running Perl program. These are the C<BEGIN>, C<CHECK>, C<INIT>, and +C<END> blocks. + +These code blocks can be prefixed with C<sub> to give the appearance of a +subroutine (although this is not considered good style). One should note +that these code blocks don't really exist as named subroutines (despite +their appearance). The thing that gives this away is the fact that you can +have B<more than one> of these code blocks in a program, and they will get +B<all> executed at the appropriate moment. So you can't execute any of +these code blocks by name. + +A C<BEGIN> code block is executed as soon as possible, that is, the moment +it is completely defined, even before the rest of the containing file (or +string) is parsed. You may have multiple C<BEGIN> blocks within a file (or +eval'ed string) -- they will execute in order of definition. Because a C<BEGIN> +code block executes immediately, it can pull in definitions of subroutines +and such from other files in time to be visible to the rest of the compile +and run time. Once a C<BEGIN> has run, it is immediately undefined and any +code it used is returned to Perl's memory pool. + +It should be noted that C<BEGIN> code blocks B<are> executed inside string +C<eval()>'s. The C<CHECK> and C<INIT> code blocks are B<not> executed inside +a string eval, which e.g. can be a problem in a mod_perl environment. + +An C<END> code block is executed as late as possible, that is, after perl has finished running the program and just before the interpreter is being exited, even if it is exiting as a result of a die() function. (But not if it's polymorphing into another program via C<exec>, or @@ -278,17 +290,22 @@ will execute in reverse order of definition; that is: last in, first out (LIFO). C<END> blocks are not executed when you run perl with the C<-c> switch, or if compilation fails. -Inside an C<END> subroutine, C<$?> contains the value that the program is +Note that C<END> code blocks are B<not> executed at the end of a string +C<eval()>: if any C<END> code blocks are created in a string C<eval()>, +they will be executed just as any other C<END> code block of that package +in LIFO order just before the interpreter is being exited. + +Inside an C<END> code block, C<$?> contains the value that the program is going to pass to C<exit()>. You can modify C<$?> to change the exit value of the program. Beware of changing C<$?> by accident (e.g. by running something via C<system>). -C<CHECK> and C<INIT> blocks are useful to catch the transition between +C<CHECK> and C<INIT> code blocks are useful to catch the transition between the compilation phase and the execution phase of the main program. -C<CHECK> blocks are run just after the Perl compile phase ends and before -the run time begins, in LIFO order. C<CHECK> blocks are used in -the Perl compiler suite to save the compiled state of the program. +C<CHECK> code blocks are run just after the B<initial> Perl compile phase ends +and before the run time begins, in LIFO order. C<CHECK> code blocks are used +in the Perl compiler suite to save the compiled state of the program. C<INIT> blocks are run just before the Perl runtime begins execution, in "first in, first out" (FIFO) order. For example, the code generators @@ -301,6 +318,35 @@ Both C<BEGIN> and C<CHECK> blocks are run when you use the B<-c> switch for a compile-only syntax check, although your main code is not. +The B<begincheck> program makes it all clear, eventually: + + #!/usr/bin/perl + + # begincheck + + print " 8. Ordinary code runs at runtime.\n"; + + END { print "14. So this is the end of the tale.\n" } + INIT { print " 5. INIT blocks run FIFO just before runtime.\n" } + CHECK { print " 4. So this is the fourth line.\n" } + + print " 9. It runs in order, of course.\n"; + + BEGIN { print " 1. BEGIN blocks run FIFO during compilation.\n" } + END { print "13. Read perlmod for the rest of the story.\n" } + CHECK { print " 3. CHECK blocks run LIFO at compilation's end.\n" } + INIT { print " 6. Run this again, using Perl's -c switch.\n" } + + print "10. This is anti-obfuscated code.\n"; + + END { print "12. END blocks run LIFO at quitting time.\n" } + BEGIN { print " 2. So this line comes out second.\n" } + INIT { print " 7. You'll see the difference right away.\n" } + + print "11. It merely _looks_ like it should be confusing.\n"; + + __END__ + =head2 Perl Classes There is no special class syntax in Perl, but a package may act @@ -337,7 +383,7 @@ create a file called F<Some/Module.pm> and start with this template: # set the version for version checking $VERSION = 1.00; # if using RCS/CVS, this may be preferred - $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g; + $VERSION = sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)/g; @ISA = qw(Exporter); @EXPORT = qw(&func1 &func2 &func4); diff --git a/gnu/usr.bin/perl/pod/perlmodlib.pod b/gnu/usr.bin/perl/pod/perlmodlib.pod index 22343d7a758..12ff6b43c12 100644 --- a/gnu/usr.bin/perl/pod/perlmodlib.pod +++ b/gnu/usr.bin/perl/pod/perlmodlib.pod @@ -93,7 +93,7 @@ Declare constants =item diagnostics -Perl compiler pragma to force verbose warning diagnostics +Produce verbose warning diagnostics =item encoding @@ -401,6 +401,10 @@ Modules that calculate message digests Perl interface to the MD5 Algorithm +=item Digest::base + +Digest base class + =item DirHandle Supply object methods for directory handles @@ -623,11 +627,11 @@ Writing a module with MakeMaker =item ExtUtils::MakeMaker::bytes -Version agnostic bytes.pm +Version-agnostic bytes.pm =item ExtUtils::MakeMaker::vmsish -Platform agnostic vmsish.pm +Platform-agnostic vmsish.pm =item ExtUtils::Manifest @@ -901,10 +905,6 @@ Arbitrary size integer math package Pure Perl module to support Math::BigInt -=item Math::BigInt::Scalar - -Pure Perl module to test Math::BigInt with scalars - =item Math::BigRat Arbitrarily big rationals @@ -1235,7 +1235,7 @@ Backend for building test libraries =item Test::Harness -Run perl standard test scripts with statistics +Run Perl standard test scripts with statistics =item Test::Harness::Assert diff --git a/gnu/usr.bin/perl/pod/perlobj.pod b/gnu/usr.bin/perl/pod/perlobj.pod index 73b67dee9ad..156a0b85067 100644 --- a/gnu/usr.bin/perl/pod/perlobj.pod +++ b/gnu/usr.bin/perl/pod/perlobj.pod @@ -275,6 +275,16 @@ current class's C<@ISA> list. $self->SUPER::display("Name", @args); } +It is important to note that C<SUPER> refers to the superclass(es) of the +I<current package> and not to the superclass(es) of the object. Also, the +C<SUPER> pseudo-class can only currently be used as a modifier to a method +name, but not in any of the other ways that class names are normally used, +eg: + + something->SUPER::method(...); # OK + SUPER::method(...); # WRONG + SUPER->method(...); # WRONG + Instead of a class name or an object reference, you can also use any expression that returns either of those on the left side of the arrow. So the following statement is valid: diff --git a/gnu/usr.bin/perl/pod/perlop.pod b/gnu/usr.bin/perl/pod/perlop.pod index c5a6ebd6ccb..352deddf7e1 100644 --- a/gnu/usr.bin/perl/pod/perlop.pod +++ b/gnu/usr.bin/perl/pod/perlop.pod @@ -786,6 +786,9 @@ and in transliterations. \c[ control char (ESC) \N{name} named Unicode character +B<NOTE>: Unlike C and other languages, Perl has no \v escape sequence for +the vertical tab (VT - ASCII 11). + The following escape sequences are available in constructs that interpolate but not in transliterations. diff --git a/gnu/usr.bin/perl/pod/perlre.pod b/gnu/usr.bin/perl/pod/perlre.pod index 87c46c19cf0..85dc1f2d448 100644 --- a/gnu/usr.bin/perl/pod/perlre.pod +++ b/gnu/usr.bin/perl/pod/perlre.pod @@ -580,6 +580,10 @@ track of the number of nested parentheses. For example: /the (\S+)(?{ $color = $^N }) (\S+)(?{ $animal = $^N })/i; print "color = $color, animal = $animal\n"; +Inside the C<(?{...})> block, C<$_> refers to the string the regular +expression is matching against. You can also use C<pos()> to know what is +the current position of matching withing this string. + The C<code> is properly scoped in the following sense: If the assertion is backtracked (compare L<"Backtracking">), all changes introduced after C<local>ization are undone, so that diff --git a/gnu/usr.bin/perl/pod/perlrun.pod b/gnu/usr.bin/perl/pod/perlrun.pod index 6447c7e1558..9f8164ddbaa 100644 --- a/gnu/usr.bin/perl/pod/perlrun.pod +++ b/gnu/usr.bin/perl/pod/perlrun.pod @@ -595,7 +595,8 @@ Note that the lines are not printed by default. See B<-p> to have lines printed. If a file named by an argument cannot be opened for some reason, Perl warns you about it and moves on to the next file. -Here is an efficient way to delete all files older than a week: +Here is an efficient way to delete all files that haven't been modifed for +at least a week: find . -mtime +7 -print | perl -nle unlink @@ -928,7 +929,7 @@ IO in order to load them!. See L<"open pragma"|open> for how to add external encodings as defaults. The layers that it makes sense to include in the PERLIO environment -variable are summarised below. For more details see L<PerlIO>. +variable are briefly summarised below. For more details see L<PerlIO>. =over 8 @@ -940,51 +941,27 @@ You perhaps were thinking of C<:crlf:bytes> or C<:perlio:bytes>. =item :crlf -A layer that implements DOS/Windows like CRLF line endings. On read -converts pairs of CR,LF to a single "\n" newline character. On write -converts each "\n" to a CR,LF pair. Note that this layer likes to be -one of its kind: it silently ignores attempts to be pushed into the -layer stack more than once. - -(Gory details follow) To be more exact what happens is this: after -pushing itself to the stack, the C<:crlf> layer checks all the layers -below itself to find the first layer that is capable of being a CRLF -layer but is not yet enabled to be a CRLF layer. If it finds such a -layer, it enables the CRLFness of that other deeper layer, and then -pops itself off the stack. If not, fine, use the one we just pushed. - -The end result is that a C<:crlf> means "please enable the first CRLF -layer you can find, and if you can't find one, here would be a good -spot to place a new one." - -Based on the C<:perlio> layer. +A layer which does CRLF to "\n" translation distinguishing "text" and +"binary" files in the manner of MS-DOS and similar operating systems. +(It currently does I<not> mimic MS-DOS as far as treating of Control-Z +as being an end-of-file marker.) =item :mmap A layer which implements "reading" of files by using C<mmap()> to make (whole) file appear in the process's address space, and then -using that as PerlIO's "buffer". This I<may> be faster in certain -circumstances for large files, and may result in less physical memory -use when multiple processes are reading the same file. - -Files which are not C<mmap()>-able revert to behaving like the C<:perlio> -layer. Writes also behave like C<:perlio> layer as C<mmap()> for write -needs extra house-keeping (to extend the file) which negates any advantage. - -The C<:mmap> layer will not exist if platform does not support C<mmap()>. +using that as PerlIO's "buffer". =item :perlio -A from scratch implementation of buffering for PerlIO. Provides fast -access to the buffer for C<sv_gets> which implements perl's readline/E<lt>E<gt> -and in general attempts to minimize data copying. - -C<:perlio> will insert a C<:unix> layer below itself to do low level IO. +This is a re-implementation of "stdio-like" buffering written as a +PerlIO "layer". As such it will call whatever layer is below it for +its operations (typically C<:unix>). =item :pop An experimental pseudolayer that removes the topmost layer. -Use with the same care as is reserved for nitroglyserin. +Use with the same care as is reserved for nitroglycerin. =item :raw @@ -993,16 +970,9 @@ layer is equivalent to calling C<binmode($fh)>. It makes the stream pass each byte as-is without any translation. In particular CRLF translation, and/or :utf8 intuited from locale are disabled. -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 (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. +Unlike in the earlier versions of Perl C<:raw> is I<not> +just the inverse of C<:crlf> - other layers which would affect the +binary nature of the stream are also removed or disabled. =item :stdio @@ -1014,19 +984,15 @@ to do that. =item :unix -Lowest level layer which provides basic PerlIO operations in terms of -UNIX/POSIX numeric file descriptor calls -C<open(), read(), write(), lseek(), close()> +Low level layer which calls C<read>, C<write> and C<lseek> etc. =item :utf8 A pseudolayer that turns on a flag on the layer below to tell perl -that data sent to the stream should be converted to perl internal -"utf8" form and that data from the stream should be considered as so -encoded. On ASCII based platforms the encoding is UTF-8 and on EBCDIC -platforms UTF-EBCDIC. May be useful in PERLIO environment variable to -make UTF-8 the default. (To turn off that behaviour use C<:bytes> -layer.) +that output should be in utf8 and that input should be regarded as +already in utf8 form. May be useful in PERLIO environment +variable to make UTF-8 the default. (To turn off that behaviour +use C<:bytes> layer.) =item :win32 @@ -1052,8 +1018,8 @@ buffering. This release uses C<unix> as the bottom layer on Win32 and so still uses C compiler's numeric file descriptor routines. There is an experimental native -C<win32> layer which is expected to be enhanced and should eventually replace -the C<unix> layer. +C<win32> layer which is expected to be enhanced and should eventually be +the default under Win32. =item PERLIO_DEBUG diff --git a/gnu/usr.bin/perl/pod/perlsec.pod b/gnu/usr.bin/perl/pod/perlsec.pod index 41f96691aca..5a09e32d8ec 100644 --- a/gnu/usr.bin/perl/pod/perlsec.pod +++ b/gnu/usr.bin/perl/pod/perlsec.pod @@ -65,12 +65,14 @@ in which case they are able to run arbitrary external code. =back -The value of an expression containing tainted data will itself be -tainted, even if it is logically impossible for the tainted data to -affect the value. +For efficiency reasons, Perl takes a conservative view of +whether data is tainted. If an expression contains tainted data, +any subexpression may be considered tainted, even if the value +of the subexpression is not itself affected by the tainted data. Because taintedness is associated with each scalar value, some -elements of an array can be tainted and others not. +elements of an array or hash can be tainted and others not. +The keys of a hash are never tainted. For example: @@ -133,7 +135,7 @@ To test whether a variable contains tainted data, and whose use would thus trigger an "Insecure dependency" message, you can use the tainted() function of the Scalar::Util module, available in your nearby CPAN mirror, and included in Perl starting from the release 5.8.0. -Or you may be able to use the following I<is_tainted()> function. +Or you may be able to use the following C<is_tainted()> function. sub is_tainted { return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 }; @@ -147,7 +149,8 @@ approach is used that if any tainted value has been accessed within the same expression, the whole expression is considered tainted. But testing for taintedness gets you only so far. Sometimes you have just -to clear your data's taintedness. The only way to bypass the tainting +to clear your data's taintedness. Values may be untainted by using them +as keys in a hash; otherwise the only way to bypass the tainting mechanism is by referencing subpatterns from a regular expression match. Perl presumes that if you reference a substring using $1, $2, etc., that you knew what you were doing when you wrote the pattern. That means using @@ -195,6 +198,26 @@ line, so you may need to use something like C<-wU> instead of C<-w -U> under such systems. (This issue should arise only in Unix or Unix-like environments that support #! and setuid or setgid scripts.) +=head2 Taint mode and @INC + +When the taint mode (C<-T>) is in effect, the "." directory is removed +from C<@INC>, and the environment variables C<PERL5LIB> and C<PERLLIB> +are ignored by Perl. You can still adjust C<@INC> from outside the +program by using the C<-I> command line option as explained in +L<perlrun>. The two environment variables are ignored because +they are obscured, and a user running a program could be unaware that +they are set, whereas the C<-I> option is clearly visible and +therefore permitted. + +Another way to modify C<@INC> without modifying the program, is to use +the C<lib> pragma, e.g.: + + perl -Mlib=/foo program + +The benefit of using C<-Mlib=/foo> over C<-I/foo>, is that the former +will automagically remove any duplicated directories, while the later +will not. + =head2 Cleaning Up Your Path For "Insecure C<$ENV{PATH}>" messages, you need to set C<$ENV{'PATH'}> to a diff --git a/gnu/usr.bin/perl/pod/perlsub.pod b/gnu/usr.bin/perl/pod/perlsub.pod index 58b21fe389a..ba95db6a0ed 100644 --- a/gnu/usr.bin/perl/pod/perlsub.pod +++ b/gnu/usr.bin/perl/pod/perlsub.pod @@ -202,13 +202,17 @@ disables any prototype checking on arguments you do provide. This is partly for historical reasons, and partly for having a convenient way to cheat if you know what you're doing. See L<Prototypes> below. -Functions whose names are in all upper case are reserved to the Perl -core, as are modules whose names are in all lower case. A -function in all capitals is a loosely-held convention meaning it -will be called indirectly by the run-time system itself, usually -due to a triggered event. Functions that do special, pre-defined -things include C<BEGIN>, C<CHECK>, C<INIT>, C<END>, C<AUTOLOAD>, -C<CLONE> and C<DESTROY>--plus all functions mentioned in L<perltie>. +Subroutines whose names are in all upper case are reserved to the Perl +core, as are modules whose names are in all lower case. A subroutine in +all capitals is a loosely-held convention meaning it will be called +indirectly by the run-time system itself, usually due to a triggered event. +Subroutines that do special, pre-defined things include C<AUTOLOAD>, C<CLONE>, +C<DESTROY> plus all functions mentioned in L<perltie> and L<PerlIO::via>. + +The C<BEGIN>, C<CHECK>, C<INIT> and C<END> subroutines are not so much +subroutines as named special code blocks, of which you can have more +than one in a package, and which you can B<not> call explicitely. See +L<perlmod/"BEGIN, CHECK, INIT and END"> =head2 Private Variables via my() @@ -440,18 +444,18 @@ via C<require> or C<use>, then this is probably just fine. If it's all in the main program, you'll need to arrange for the C<my> to be executed early, either by putting the whole block above your main program, or more likely, placing merely a C<BEGIN> -sub around it to make sure it gets executed before your program +code block around it to make sure it gets executed before your program starts to run: - sub BEGIN { + BEGIN { my $secret_val = 0; sub gimme_another { return ++$secret_val; } } -See L<perlmod/"Package Constructors and Destructors"> about the -special triggered functions, C<BEGIN>, C<CHECK>, C<INIT> and C<END>. +See L<perlmod/"BEGIN, CHECK, INIT and END"> about the +special triggered code blocks, C<BEGIN>, C<CHECK>, C<INIT> and C<END>. If declared at the outermost scope (the file scope), then lexicals work somewhat like C's file statics. They are available to all diff --git a/gnu/usr.bin/perl/pod/perltie.pod b/gnu/usr.bin/perl/pod/perltie.pod index b81a51b4643..30a0b1df202 100644 --- a/gnu/usr.bin/perl/pod/perltie.pod +++ b/gnu/usr.bin/perl/pod/perltie.pod @@ -474,7 +474,8 @@ the constructor. FETCH and STORE access the key and value pairs. EXISTS reports whether a key is present in the hash, and DELETE deletes one. CLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY implement the keys() and each() functions to iterate over all -the keys. UNTIE is called when C<untie> happens, and DESTROY is called when +the keys. SCALAR is triggered when the tied hash is evaluated in scalar +context. UNTIE is called when C<untie> happens, and DESTROY is called when the tied variable is garbage collected. If this seems like a lot, then feel free to inherit from merely the @@ -757,6 +758,31 @@ thing, but we'll have to go through the LIST field indirectly. return each %{ $self->{LIST} } } +=item SCALAR this + +This is called when the hash is evaluated in scalar context. In order +to mimic the behaviour of untied hashes, this method should return a +false value when the tied hash is considered empty. If this method does +not exist, perl will make some educated guesses and return true when +the hash is inside an iteration. If this isn't the case, FIRSTKEY is +called, and the result will be a false value if FIRSTKEY returns the empty +list, true otherwise. + +However, you should B<not> blindly rely on perl always doing the right +thing. Particularly, perl will mistakenly return true when you clear the +hash by repeatedly calling DELETE until it is empty. You are therefore +advised to supply your own SCALAR method when you want to be absolutely +sure that your hash behaves nicely in scalar context. + +In our example we can just call C<scalar> on the underlying hash +referenced by C<$self-E<gt>{LIST}>: + + sub SCALAR { + carp &whowasi if $DEBUG; + my $self = shift; + return scalar %{ $self->{LIST} } + } + =item UNTIE this This is called when C<untie> occurs. See L<The C<untie> Gotcha> below. @@ -1107,4 +1133,6 @@ TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F< UNTIE by Nick Ing-Simmons <F<nick@ing-simmons.net>> +SCALAR by Tassilo von Parseval <F<tassilo.von.parseval@rwth-aachen.de>> + Tying Arrays by Casey West <F<casey@geeknest.com>> diff --git a/gnu/usr.bin/perl/pod/perltoc.pod b/gnu/usr.bin/perl/pod/perltoc.pod index c3acd9f8963..44f27cb0ab8 100644 --- a/gnu/usr.bin/perl/pod/perltoc.pod +++ b/gnu/usr.bin/perl/pod/perltoc.pod @@ -829,7 +829,7 @@ Interaction, perlfaq9 - Networking =back -=head2 perlfaq1 - General Questions About Perl ($Revision: 1.7 $, $Date: +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.8 $, $Date: 2003/07/09 15:47:28 $) =over 4 @@ -878,8 +878,8 @@ Scheme, or Tcl? =back -=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.7 $, -$Date: 2003/12/03 03:02:46 $) +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.8 $, +$Date: 2004/04/07 21:33:09 $) =over 4 @@ -934,7 +934,7 @@ References, Tutorials, Task-Oriented, Special Topics =back -=head2 perlfaq3 - Programming Tools ($Revision: 1.7 $, $Date: 2003/08/24 +=head2 perlfaq3 - Programming Tools ($Revision: 1.8 $, $Date: 2003/08/24 05:26:59 $) =over 4 @@ -1021,7 +1021,7 @@ my C program; what am I doing wrong? =back -=head2 perlfaq4 - Data Manipulation ($Revision: 1.7 $, $Date: 2003/10/02 +=head2 perlfaq4 - Data Manipulation ($Revision: 1.8 $, $Date: 2003/10/02 04:44:33 $) =over 4 @@ -1240,7 +1240,7 @@ array of hashes or arrays? =back -=head2 perlfaq5 - Files and Formats ($Revision: 1.7 $, $Date: 2003/01/26 +=head2 perlfaq5 - Files and Formats ($Revision: 1.8 $, $Date: 2003/01/26 17:45:46 $) =over 4 @@ -1336,7 +1336,7 @@ protected files? Isn't this a bug in Perl? =back -=head2 perlfaq6 - Regular Expressions ($Revision: 1.7 $, $Date: 2003/01/03 +=head2 perlfaq6 - Regular Expressions ($Revision: 1.8 $, $Date: 2003/01/03 20:05:28 $) =over 4 @@ -1403,7 +1403,7 @@ file? =back -=head2 perlfaq7 - General Perl Language Issues ($Revision: 1.7 $, $Date: +=head2 perlfaq7 - General Perl Language Issues ($Revision: 1.8 $, $Date: 2003/07/24 02:17:21 $) =over 4 @@ -1485,7 +1485,7 @@ methods? =back -=head2 perlfaq8 - System Interaction ($Revision: 1.7 $, $Date: 2003/01/26 +=head2 perlfaq8 - System Interaction ($Revision: 1.8 $, $Date: 2003/01/26 17:44:04 $) =over 4 @@ -1613,7 +1613,7 @@ search path? =back -=head2 perlfaq9 - Networking ($Revision: 1.7 $, $Date: 2003/01/31 17:36:57 +=head2 perlfaq9 - Networking ($Revision: 1.8 $, $Date: 2003/01/31 17:36:57 $) =over 4 @@ -2262,9 +2262,9 @@ B<-X>, B<-x> I<directory> HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLIO, :bytes, :crlf, :mmap, :perlio, :pop, :raw, :stdio, :unix, :utf8, :win32, PERLIO_DEBUG, PERLLIB, PERL5DB, PERL5SHELL (specific to the Win32 port), PERL_DEBUG_MSTATS, -PERL_DESTRUCT_LEVEL, PERL_ENCODING, PERL_HASH_SEED, PERL_HASH_SEED_DEBUG, -PERL_ROOT (specific to the VMS port), PERL_SIGNALS, PERL_UNICODE, SYS$LOGIN -(specific to the VMS port) +PERL_DESTRUCT_LEVEL, PERL_DL_NONLAZY, PERL_ENCODING, PERL_HASH_SEED, +PERL_HASH_SEED_DEBUG, PERL_ROOT (specific to the VMS port), PERL_SIGNALS, +PERL_UNICODE, SYS$LOGIN (specific to the VMS port) =back @@ -2624,7 +2624,7 @@ this USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key, STORE this, key, value, DELETE this, key, CLEAR this, EXISTS this, key, FIRSTKEY -this, NEXTKEY this, lastkey, UNTIE this, DESTROY this +this, NEXTKEY this, lastkey, SCALAR this, UNTIE this, DESTROY this =item Tying FileHandles @@ -3138,22 +3138,21 @@ http://testers.cpan.org/ =item Alphabetical Listing of Perl Functions --I<X> FILEHANDLE, -I<X> EXPR, -I<X>, alarm SECONDS, alarm, binmode -FILEHANDLE, chmod LIST, chown LIST, chroot FILENAME, chroot, crypt -PLAINTEXT,SALT, dbmclose HASH, dbmopen HASH,DBNAME,MODE, dump LABEL, exec -LIST, exit EXPR, exit, fcntl FILEHANDLE,FUNCTION,SCALAR, flock -FILEHANDLE,OPERATION, fork, getlogin, getpgrp PID, getppid, getpriority -WHICH,WHO, getpwnam NAME, getgrnam NAME, getnetbyname NAME, getpwuid UID, -getgrgid GID, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER, -getservbyport PORT,PROTO, getpwent, getgrent, gethostbyname, gethostent, -getnetent, getprotoent, getservent, sethostent STAYOPEN, setnetent -STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent, -endhostent, endnetent, endprotoent, endservent, getsockopt -SOCKET,LEVEL,OPTNAME, glob EXPR, glob, ioctl FILEHANDLE,FUNCTION,SCALAR, -kill SIGNAL, LIST, link OLDFILE,NEWFILE, lstat FILEHANDLE, lstat EXPR, -lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd ID,MSG,FLAGS, msgrcv -ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, open FILEHANDLE, pipe -READHANDLE,WRITEHANDLE, readlink EXPR, readlink, select +-I<X> FILEHANDLE, -I<X> EXPR, -I<X>, binmode FILEHANDLE, chmod LIST, chown +LIST, chroot FILENAME, chroot, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen +HASH,DBNAME,MODE, dump LABEL, exec LIST, exit EXPR, exit, fcntl +FILEHANDLE,FUNCTION,SCALAR, flock FILEHANDLE,OPERATION, fork, getlogin, +getpgrp PID, getppid, getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, +getnetbyname NAME, getpwuid UID, getgrgid GID, getnetbyaddr ADDR,ADDRTYPE, +getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, getgrent, +gethostbyname, gethostent, getnetent, getprotoent, getservent, sethostent +STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, +endpwent, endgrent, endhostent, endnetent, endprotoent, endservent, +getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, ioctl +FILEHANDLE,FUNCTION,SCALAR, kill SIGNAL, LIST, link OLDFILE,NEWFILE, lstat +FILEHANDLE, lstat EXPR, lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd +ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, open +FILEHANDLE, pipe READHANDLE,WRITEHANDLE, readlink EXPR, readlink, select RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, setgrent, setpgrp PID,PGRP, setpriority WHICH,WHO,PRIORITY, setpwent, setsockopt @@ -3341,7 +3340,8 @@ LC_NUMERIC, LC_TIME, LANG =item Important Caveats Input and Output Layers, Regular Expressions, C<use utf8> still needed to -enable UTF-8/UTF-EBCDIC in scripts +enable UTF-8/UTF-EBCDIC in scripts, C<use encoding> needed to upgrade +non-Latin-1 byte strings =item Byte and Character Semantics @@ -3531,6 +3531,8 @@ chcp, dataset access, OS/390, z/OS iconv, locales =item Switches On the "#!" Line +=item Taint mode and @INC + =item Cleaning Up Your Path =item Security Bugs @@ -3559,7 +3561,7 @@ chcp, dataset access, OS/390, z/OS iconv, locales =item Symbol Tables -=item Package Constructors and Destructors +=item BEGIN, CHECK, INIT and END =item Perl Classes @@ -3598,10 +3600,10 @@ CGI::Cookie, CGI::Fast, CGI::Pretty, CGI::Push, CGI::Switch, CGI::Util, CPAN, CPAN::FirstTime, CPAN::Nox, Carp, Carp::Heavy, Class::ISA, Class::Struct, Config, Cwd, DB, DB_File, Data::Dumper, Devel::DProf, Devel::PPPort, Devel::Peek, Devel::SelfStubber, Digest, Digest::MD5, -DirHandle, Dumpvalue, DynaLoader, Encode, Encode::Alias, Encode::Byte, -Encode::CJKConstants, Encode::CN, Encode::CN::HZ, Encode::Config, -Encode::EBCDIC, Encode::Encoder, Encode::Encoding, Encode::Guess, -Encode::JP, Encode::JP::H2Z, Encode::JP::JIS7, Encode::KR, +Digest::base, DirHandle, Dumpvalue, DynaLoader, Encode, Encode::Alias, +Encode::Byte, Encode::CJKConstants, Encode::CN, Encode::CN::HZ, +Encode::Config, Encode::EBCDIC, Encode::Encoder, Encode::Encoding, +Encode::Guess, Encode::JP, Encode::JP::H2Z, Encode::JP::JIS7, Encode::KR, Encode::KR::2022_KR, Encode::MIME::Header, Encode::PerlIO, Encode::Supported, Encode::Symbol, Encode::TW, Encode::Unicode, Encode::Unicode::UTF7, English, Env, Errno, Exporter, Exporter::Heavy, @@ -3628,16 +3630,16 @@ IPC::SysV::Semaphore, List::Util, Locale::Constants, Locale::Country, Locale::Currency, Locale::Language, Locale::Maketext, Locale::Maketext::TPJ13, Locale::Script, MIME::Base64, MIME::Base64::QuotedPrint, Math::BigFloat, Math::BigInt, -Math::BigInt::Calc, Math::BigInt::Scalar, Math::BigRat, Math::Complex, -Math::Trig, Memoize, Memoize::AnyDBM_File, Memoize::Expire, -Memoize::ExpireFile, Memoize::ExpireTest, Memoize::NDBM_File, -Memoize::SDBM_File, Memoize::Storable, NDBM_File, NEXT, Net::Cmd, -Net::Config, Net::Domain, Net::FTP, Net::NNTP, Net::Netrc, Net::POP3, -Net::Ping, Net::SMTP, Net::Time, Net::hostent, Net::libnetFAQ, Net::netent, -Net::protoent, Net::servent, O, ODBM_File, Opcode, POSIX, PerlIO, -PerlIO::encoding, PerlIO::scalar, PerlIO::via, PerlIO::via::QuotedPrint, -Pod::Checker, Pod::Find, Pod::Functions, Pod::Html, Pod::InputObjects, -Pod::LaTeX, Pod::Man, Pod::ParseLink, Pod::ParseUtils, Pod::Parser, +Math::BigInt::Calc, Math::BigRat, Math::Complex, Math::Trig, Memoize, +Memoize::AnyDBM_File, Memoize::Expire, Memoize::ExpireFile, +Memoize::ExpireTest, Memoize::NDBM_File, Memoize::SDBM_File, +Memoize::Storable, NDBM_File, NEXT, Net::Cmd, Net::Config, Net::Domain, +Net::FTP, Net::NNTP, Net::Netrc, Net::POP3, Net::Ping, Net::SMTP, +Net::Time, Net::hostent, Net::libnetFAQ, Net::netent, Net::protoent, +Net::servent, O, ODBM_File, Opcode, POSIX, PerlIO, PerlIO::encoding, +PerlIO::scalar, PerlIO::via, PerlIO::via::QuotedPrint, Pod::Checker, +Pod::Find, Pod::Functions, Pod::Html, Pod::InputObjects, Pod::LaTeX, +Pod::Man, Pod::ParseLink, Pod::ParseUtils, Pod::Parser, Pod::Perldoc::ToChecker, Pod::Perldoc::ToMan, Pod::Perldoc::ToNroff, Pod::Perldoc::ToPod, Pod::Perldoc::ToRtf, Pod::Perldoc::ToText, Pod::Perldoc::ToTk, Pod::Perldoc::ToXml, Pod::PlainText, Pod::Plainer, @@ -4470,7 +4472,7 @@ save_hptr(HV **hptr)> =item Internal Functions -A, p, d, s, n, r, f, M, o, j, x +A, p, d, s, n, r, f, M, o, x, m, X, E, b =over 4 @@ -4652,10 +4654,10 @@ HEf_SVKEY, Nullch, Nullsv =item Hash Manipulation Functions get_hv, HeHASH, HeKEY, HeKLEN, HePV, HeSVKEY, HeSVKEY_force, HeSVKEY_set, -HeVAL, HvNAME, hv_clear, hv_delete, hv_delete_ent, hv_exists, -hv_exists_ent, hv_fetch, hv_fetch_ent, hv_iterinit, hv_iterkey, +HeVAL, HvNAME, hv_clear, hv_clear_placeholders, hv_delete, hv_delete_ent, +hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext, hv_iternextsv, hv_iternext_flags, hv_iterval, -hv_magic, hv_store, hv_store_ent, hv_undef, newHV, Nullhv +hv_magic, hv_scalar, hv_store, hv_store_ent, hv_undef, newHV, Nullhv =item Magical Functions @@ -5480,7 +5482,7 @@ B<-V> =back -=head2 perldelta - what is new for perl v5.8.2 +=head2 perldelta - what is new for perl v5.8.3 =over 4 @@ -5492,11 +5494,57 @@ B<-V> =item Modules and Pragmata +CGI, Cwd, Digest, Digest::MD5, Encode, File::Spec, FindBin, List::Util, +Math::BigInt, PodParser, Pod::Perldoc, POSIX, Unicode::Collate, +Unicode::Normalize, Test::Harness, threads::shared + =item Utility Changes =item New Documentation -=item Performance Enhancements +=item Installation and Configuration Improvements + +=item Selected Bug Fixes + +=item New or Changed Diagnostics + +=item Changed Internals + +=item Configuration and Building + +=item Platform Specific Problems + +=item Known Problems + +=item Future Directions + +=item Obituary + +=item Reporting Bugs + +=item SEE ALSO + +=back + +=head2 perl583delta, perldelta - what is new for perl v5.8.3 + +=over 4 + +=item DESCRIPTION + +=item Incompatible Changes + +=item Core Enhancements + +=item Modules and Pragmata + +CGI, Cwd, Digest, Digest::MD5, Encode, File::Spec, FindBin, List::Util, +Math::BigInt, PodParser, Pod::Perldoc, POSIX, Unicode::Collate, +Unicode::Normalize, Test::Harness, threads::shared + +=item Utility Changes + +=item New Documentation =item Installation and Configuration Improvements @@ -5506,19 +5554,67 @@ B<-V> =item Changed Internals -=item New Tests +=item Configuration and Building + +=item Platform Specific Problems =item Known Problems +=item Future Directions + +=item Obituary + +=item Reporting Bugs + +=item SEE ALSO + +=back + +=head2 perl582delta - what is new for perl v5.8.2 + +=over 4 + +=item DESCRIPTION + +=item Incompatible Changes + +=item Core Enhancements + +=over 4 + +=item Hash Randomisation + +=item Threading + +=back + +=item Modules and Pragmata + +=over 4 + +=item Updated Modules And Pragmata + +Devel::PPPort, Digest::MD5, I18N::LangTags, libnet, MIME::Base64, +Pod::Perldoc, strict, Tie::Hash, Time::HiRes, Unicode::Collate, +Unicode::Normalize, UNIVERSAL + +=back + +=item Selected Bug Fixes + +=item Changed Internals + =item Platform Specific Problems +=item Future Directions + =item Reporting Bugs =item SEE ALSO =back -=head2 perl581delta, perldelta - what is new for perl v5.8.1 +=head2 perl581delta - what is new for perl v5.8.1 =over 4 @@ -5677,7 +5773,7 @@ Win32::GetOSVersion =back -=head2 perl58delta, perldelta - what is new for perl v5.8.0 +=head2 perl58delta - what is new for perl v5.8.0 =over 4 @@ -7645,6 +7741,34 @@ R4 x86, R4 PPC =back +=head2 perlce - Perl for WinCE + +=over 4 + +=item DESCRIPTION + +=item BUILD + +=over 4 + +=item Tools & SDK + +Microsoft Embedded Visual Tools, Microsoft Visual C++, Rainer Keuchel's +celib-sources, Rainer Keuchel's console-sources + +=item Make + +go to ./wince subdirectory, edit file compile.bat, run compile.bat, run + compile.bat dist + +=back + +=item ACKNOWLEDGEMENTS + +=item AUTHORS + +=back + =head2 perlcygwin, README.cygwin - Perl for Cygwin =over 4 @@ -7759,6 +7883,50 @@ Source, Compiled Module Source, Perl Modules/Scripts =back +=head2 perldos - Perl under DOS, W31, W95. + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Prerequisites for Compiling Perl on DOS + +DJGPP, Pthreads + +=item Shortcomings of Perl under DOS + +=item Building Perl on DOS + +=item Testing Perl on DOS + +=item Installation of Perl on DOS + +=back + +=item BUILDING AND INSTALLING MODULES ON DOS + +=over 4 + +=item Building Prerequisites for Perl on DOS + +=item Unpacking CPAN Modules on DOS + +=item Building Non-XS Modules on DOS + +=item Building XS Modules on DOS + +=back + +=item AUTHOR + +=item SEE ALSO + +=back + =head2 perlepoc, README.epoc - Perl for EPOC =over 4 @@ -8040,11 +8208,15 @@ public_html/feedback.cgi, src/perl-5.6.0-mpe =item AUTHOR -=item Name +=back + +=head2 perlnetware - Perl for NetWare -=item Description +=over 4 + +=item DESCRIPTION -=item Build +=item BUILD =over 4 @@ -8062,15 +8234,15 @@ SetNWBld.bat, Buildtype.bat =back -=item Install +=item INSTALL -=item Build new extensions +=item BUILD NEW EXTENSIONS -=item Acknowledgements +=item ACKNOWLEDGEMENTS -=item Authors +=item AUTHORS -=item Date +=item DATE =back @@ -8189,6 +8361,19 @@ F<op/stat.t> =back +=item Building a binary distribution + +=item Building custom F<.EXE> files + +=over 4 + +=item Making executables with a custom collection of statically loaded +extensions + +=item Making executables with a custom search-paths + +=back + =item Build FAQ =over 4 @@ -8765,6 +8950,53 @@ LIST, waitpid PID,FLAGS =back +=head2 perlwin32 - Perl under Windows + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Setting Up Perl on Win32 + +Make, Command Shell, Borland C++, Microsoft Visual C++, Microsoft Platform +SDK 64-bit Compiler, MinGW32 with gcc, MinGW release 1 + +=item Building + +=item Testing Perl on Win32 + +=item Installation of Perl on Win32 + +=item Usage Hints for Perl on Win32 + +Environment Variables, File Globbing, Using perl from the command line, +Building Extensions, Command-line Wildcard Expansion, Win32 Specific +Extensions, Notes on 64-bit Windows + +=item Running Perl Scripts + +Miscellaneous Things + +=back + +=item BUGS AND CAVEATS + +=item AUTHORS + +Gary Ng E<lt>71564.1743@CompuServe.COME<gt>, Gurusamy Sarathy +E<lt>gsar@activestate.comE<gt>, Nick Ing-Simmons +E<lt>nick@ing-simmons.netE<gt> + +=item SEE ALSO + +=item HISTORY + +=back + =head1 PRAGMA DOCUMENTATION =head2 attrs - set/get attributes of a subroutine (deprecated) @@ -8802,8 +9034,9 @@ data structures between threads =item FUNCTIONS -share VARIABLE, lock VARIABLE, cond_wait VARIABLE, cond_signal VARIABLE, -cond_broadcast VARIABLE +share VARIABLE, lock VARIABLE, cond_wait VARIABLE, cond_wait CONDVAR, +LOCKVAR, cond_timedwait VARIABLE, ABS_TIMEOUT, cond_timedwait CONDVAR, +ABS_TIMEOUT, LOCKVAR, cond_signal VARIABLE, cond_broadcast VARIABLE =item NOTES @@ -8837,7 +9070,8 @@ A thread exited while %d other threads were still running =item BUGS Parent-Child threads, Returning objects, Creating threads inside BEGIN -blocks, PERL_OLD_SIGNALS are not threadsafe, will not be +blocks, PERL_OLD_SIGNALS are not threadsafe, will not be, Detached threads +on Windows =item AUTHOR and COPYRIGHT @@ -8905,7 +9139,7 @@ FETCH_I<type>_ATTRIBUTES, MODIFY_I<type>_ATTRIBUTES =back -=head2 base - Establish IS-A relationship with base class at compile time +=head2 base - Establish IS-A relationship with base classes at compile time =over 4 @@ -9131,8 +9365,7 @@ escapes =back -=head2 diagnostics - Perl compiler pragma to force verbose warning -diagnostics +=head2 diagnostics, splain - produce verbose warning diagnostics =over 4 @@ -9172,6 +9405,8 @@ diagnostics =item PerlIO layers for C<STD(IN|OUT)> +=item Implicit upgrading for byte strings + =back =item FEATURES THAT REQUIRE 5.8.1 @@ -9527,8 +9762,9 @@ structures between threads =item FUNCTIONS -share VARIABLE, lock VARIABLE, cond_wait VARIABLE, cond_signal VARIABLE, -cond_broadcast VARIABLE +share VARIABLE, lock VARIABLE, cond_wait VARIABLE, cond_wait CONDVAR, +LOCKVAR, cond_timedwait VARIABLE, ABS_TIMEOUT, cond_timedwait CONDVAR, +ABS_TIMEOUT, LOCKVAR, cond_signal VARIABLE, cond_broadcast VARIABLE =item NOTES @@ -10513,8 +10749,8 @@ B<Accept()>, B<raw_cookie()>, B<user_agent()>, B<path_info()>, B<path_translated()>, B<remote_host()>, B<script_name()> Return the script name as a partial URL, for self-refering scripts, B<referer()>, B<auth_type ()>, B<server_name ()>, B<virtual_host ()>, B<server_port ()>, -B<server_software ()>, B<remote_user ()>, B<user_name ()>, -B<request_method()>, B<content_type()>, B<http()>, B<https()> +B<virtual_port ()>, B<server_software ()>, B<remote_user ()>, B<user_name +()>, B<request_method()>, B<content_type()>, B<http()>, B<https()> =item USING NPH SCRIPTS @@ -11653,7 +11889,7 @@ Dumper =back -=head2 Digest:: - Modules that calculate message digests +=head2 Digest - Modules that calculate message digests =over 4 @@ -11667,9 +11903,12 @@ I<binary>, I<hex>, I<base64> $ctx = Digest->XXX($arg,...), $ctx = Digest->new(XXX => $arg,...), $ctx = Digest::XXX->new($arg,...), $other_ctx = $ctx->clone, $ctx->reset, -$ctx->add($data,...), $ctx->addfile($io_handle), $ctx->digest, +$ctx->add( $data, ... ), $ctx->addfile( $io_handle ), $ctx->add_bits( +$data, $nbits ), $ctx->add_bits( $bitstring ), $ctx->digest, $ctx->hexdigest, $ctx->b64digest +=item Digest speed + =item SEE ALSO =item AUTHOR @@ -11691,7 +11930,8 @@ md5($data,...), md5_hex($data,...), md5_base64($data,...) =item METHODS $md5 = Digest::MD5->new, $md5->reset, $md5->clone, $md5->add($data,...), -$md5->addfile($io_handle), $md5->digest, $md5->hexdigest, $md5->b64digest +$md5->addfile($io_handle), $md5->add_bits($data, $nbits), +$md5->add_bits($bitstring), $md5->digest, $md5->hexdigest, $md5->b64digest =item EXAMPLES @@ -11703,6 +11943,18 @@ $md5->addfile($io_handle), $md5->digest, $md5->hexdigest, $md5->b64digest =back +=head2 Digest::base - Digest base class + +=over 4 + +=item SYNPOSIS + +=item DESCRIPTION + +=item SEE ALSO + +=back + =head2 DirHandle - supply object methods for directory handles =over 4 @@ -12503,6 +12755,8 @@ non-ascii or non-utf8 =item PerlIO layers for C<STD(IN|OUT)> +=item Implicit upgrading for byte strings + =back =item FEATURES THAT REQUIRE 5.8.1 @@ -12648,6 +12902,8 @@ C<use ModuleName;>, C<use ModuleName ();>, C<use ModuleName qw(...);> =item Exporting without using Exporter's import method +=item Exporting without inheriting from Exporter + =item Module Version Checking =item Managing Unknown Symbols @@ -12974,12 +13230,8 @@ all_target metafile_target -signature_target - metafile_addtomanifest_target -signature_addtomanifest_target - =over 4 =item Abstract methods @@ -13681,8 +13933,8 @@ OPTIMIZE, PERL, PERL_CORE, PERLMAINCC, PERL_ARCHLIB, PERL_LIB, PERL_MALLOC_OK, PERLPREFIX, PERLRUN, PERLRUNINST, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, PM, PMLIBDIRS, PM_FILTER, POLLUTE, PPM_INSTALL_EXEC, PPM_INSTALL_SCRIPT, PREFIX, PREREQ_FATAL, PREREQ_PM, PREREQ_PRINT, -PRINT_PREREQ, SITEPREFIX, SIGN, SKIP, TYPEMAPS, VENDORPREFIX, VERBINST, -VERSION, VERSION_FROM, VERSION_SYM, XS, XSOPT, XSPROTOARG, XS_VERSION +PRINT_PREREQ, SITEPREFIX, SKIP, TYPEMAPS, VENDORPREFIX, VERBINST, VERSION, +VERSION_FROM, VERSION_SYM, XS, XSOPT, XSPROTOARG, XS_VERSION =item Additional lowercase attributes @@ -14795,8 +15047,8 @@ supplied =back -=head2 Getopt::Std, getopt - Process single-character switches with switch -clustering +=head2 Getopt::Std, getopt, getopts - Process single-character switches +with switch clustering =over 4 @@ -16163,10 +16415,10 @@ Input, Output =item is_one()/is_zero()/is_nan()/is_inf() -=item is_positive()/is_negative() +=item is_pos()/is_neg() - $x->is_positive(); # true if >= 0 - $x->is_negative(); # true if < 0 + $x->is_pos(); # true if >= 0 + $x->is_neg(); # true if < 0 =item is_odd()/is_even()/is_int() @@ -16176,7 +16428,7 @@ Input, Output =item sign -=item bcmp +=item digit =item bneg @@ -16244,7 +16496,7 @@ Input, Output =item copy -=item as_number +=item as_int =item bsstr @@ -16320,9 +16572,9 @@ broot() does not work, Out of Memory!, Fails to load Calc on Perl prior =item CAVEATS -stringify, bstr(), bsstr() and 'cmp', int(), length, bdiv, infinity -handling, Modifying and =, bpow, Overloading -$x, Mixing different object -types, bsqrt(), brsft() +bstr(), bsstr() and 'cmp', int(), length, bdiv, infinity handling, +Modifying and =, bpow, Overloading -$x, Mixing different object types, +bsqrt(), brsft() =item LICENSE @@ -16358,8 +16610,7 @@ the same terms as Perl itself. =back -=head2 Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with -scalars +=head2 Math::BigInt::CalcEmu - Emulate low-level math with BigInt code =over 4 @@ -16367,13 +16618,15 @@ scalars =item DESCRIPTION +=item METHODS + =item LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. -=item AUTHOR +=item AUTHORS =item SEE ALSO @@ -17470,7 +17723,7 @@ name space =item DESCRIPTION -unix, stdio, perlio, crlf, utf8, bytes, raw, pop +:unix, :stdio, :perlio, :crlf, :mmap, :utf8, :bytes, :raw, :pop, :win32 =over 4 @@ -17553,6 +17806,8 @@ $obj->CLEARERR($fh), $obj->ERROR($fh), $obj->EOF($fh) =item DESCRIPTION +=item REQUIRED MODULES + =item SEE ALSO =item ACKNOWLEDGEMENTS @@ -17701,9 +17956,9 @@ C<-inc =E<gt> 1>, C<-dirs =E<gt> [ $dir1, $dir2, ... ]>, C<-verbose =E<gt> =item ARGUMENTS -backlink, cachedir, css, flush, header, help, htmldir, htmlroot, index, -infile, libpods, netscape, outfile, podpath, podroot, quiet, recurse, -title, verbose +backlink, cachedir, css, flush, header, help, hiddendirs, htmldir, +htmlroot, index, infile, libpods, netscape, outfile, podpath, podroot, +quiet, recurse, title, verbose =item EXAMPLE @@ -19462,7 +19717,13 @@ B<_my_exit> =back -=head2 Test::Harness - run perl standard test scripts with statistics +=head2 Test::Harness - Run Perl standard test scripts with statistics + +=over 4 + +=item VERSION + +=back =over 4 @@ -19482,7 +19743,7 @@ else> =item Configuration variables. -B<$Test::Harness::verbose>, B<$Test::Harness::switches> +B<$Test::Harness::Verbose>, B<$Test::Harness::switches> =item Failure @@ -19521,8 +19782,9 @@ C<All tests successful.\nFiles=%d, Tests=%d, %s>, C<FAILED tests =item ENVIRONMENT C<HARNESS_ACTIVE>, C<HARNESS_COLUMNS>, C<HARNESS_COMPILE_TEST>, -C<HARNESS_FILELEAK_IN_DIR>, C<HARNESS_IGNORE_EXITCODE>, C<HARNESS_NOTTY>, -C<HARNESS_OK_SLOW>, C<HARNESS_PERL_SWITCHES>, C<HARNESS_VERBOSE> +C<HARNESS_DEBUG>, C<HARNESS_FILELEAK_IN_DIR>, C<HARNESS_IGNORE_EXITCODE>, +C<HARNESS_NOTTY>, C<HARNESS_OK_SLOW>, C<HARNESS_PERL>, +C<HARNESS_PERL_SWITCHES>, C<HARNESS_VERBOSE> =item EXAMPLE @@ -19536,6 +19798,10 @@ C<HARNESS_OK_SLOW>, C<HARNESS_PERL_SWITCHES>, C<HARNESS_VERBOSE> =item BUGS +=item AUTHORS + +=item COPYRIGHT + =back =head2 Test::Harness::Assert - simple assert @@ -19546,11 +19812,11 @@ C<HARNESS_OK_SLOW>, C<HARNESS_PERL_SWITCHES>, C<HARNESS_VERBOSE> =item DESCRIPTION -=over 4 +=item FUNCTIONS -=item Functions +=over 4 -B<assert> +=item C<assert()> =back @@ -19572,6 +19838,14 @@ B<assert> =item DESCRIPTION +=over 4 + +=item new() + +=item next() + +=back + =back =head2 Test::Harness::Straps - detailed analysis of test results @@ -19624,12 +19898,30 @@ B<assert> =over 4 +=item C<_command_line( $file )> + +=back + +=over 4 + +=item C<_command> + +=back + +=over 4 + =item C<_switches> =back =over 4 +=item C<_cleaned_switches> + +=back + +=over 4 + =item C<_INC2PERL5LIB> =back @@ -20232,13 +20524,14 @@ tied hashes =item DESCRIPTION TIEHASH classname, LIST, STORE this, key, value, FETCH this, key, FIRSTKEY -this, NEXTKEY this, lastkey, EXISTS this, key, DELETE this, key, CLEAR this +this, NEXTKEY this, lastkey, EXISTS this, key, DELETE this, key, CLEAR +this, SCALAR this =item Inheriting from B<Tie::StdHash> =item Inheriting from B<Tie::ExtraHash> -=item C<UNTIE> and C<DESTROY> +=item C<SCALAR>, C<UNTIE> and C<DESTROY> =item MORE INFORMATION @@ -20528,7 +20821,7 @@ C<$may_be_composed_with_prev_char = isComp2nd($codepoint)> =item SEE ALSO -http://www.unicode.org/unicode/reports/tr15/, +http://www.unicode.org/reports/tr15/, http://www.unicode.org/Public/UNIDATA/DerivedNormalizationProps.txt, http://www.unicode.org/notes/tn5/ diff --git a/gnu/usr.bin/perl/pod/perltoot.pod b/gnu/usr.bin/perl/pod/perltoot.pod index 03372c7ae50..2497063877c 100644 --- a/gnu/usr.bin/perl/pod/perltoot.pod +++ b/gnu/usr.bin/perl/pod/perltoot.pod @@ -940,7 +940,8 @@ comes to the rescue here. This way it starts looking in my class's @ISA. This only makes sense from I<within> a method call, though. Don't try to access anything in SUPER:: from anywhere else, because it doesn't exist outside -an overridden method call. +an overridden method call. Note that C<SUPER> refers to the superclass of +the current package, I<not> to the superclass of C<$self>. Things are getting a bit complicated here. Have we done anything we shouldn't? As before, one way to test whether we're designing diff --git a/gnu/usr.bin/perl/pod/pod2usage.PL b/gnu/usr.bin/perl/pod/pod2usage.PL index f319ec068e4..b185e2ffaa5 100644 --- a/gnu/usr.bin/perl/pod/pod2usage.PL +++ b/gnu/usr.bin/perl/pod/pod2usage.PL @@ -125,6 +125,8 @@ L<Pod::Usage>, L<pod2text(1)> =head1 AUTHOR +Please report bugs using L<http://rt.cpan.org>. + Brad Appleton E<lt>bradapp@enteract.comE<gt> Based on code for B<pod2text(1)> written by diff --git a/gnu/usr.bin/perl/pp.c b/gnu/usr.bin/perl/pp.c index 4fec171ac97..1a304e454bd 100644 --- a/gnu/usr.bin/perl/pp.c +++ b/gnu/usr.bin/perl/pp.c @@ -106,12 +106,7 @@ PP(pp_padhv) RETURNOP(do_kv()); } else if (gimme == G_SCALAR) { - SV* sv = sv_newmortal(); - if (HvFILL((HV*)TARG)) - Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", - (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1); - else - sv_setiv(sv, 0); + SV* sv = Perl_hv_scalar(aTHX_ (HV*)TARG); SETs(sv); } RETURN; @@ -2796,8 +2791,7 @@ PP(pp_int) if (value > (NV)IV_MIN - 0.5) { SETi(I_V(value)); } else { - /* This is maint, and we don't have Perl_ceil in perl.h */ - SETn(-Perl_floor(-value)); + SETn(Perl_ceil(value)); } } } diff --git a/gnu/usr.bin/perl/pp_ctl.c b/gnu/usr.bin/perl/pp_ctl.c index 7621e65e6b8..a2e58ed210d 100644 --- a/gnu/usr.bin/perl/pp_ctl.c +++ b/gnu/usr.bin/perl/pp_ctl.c @@ -59,6 +59,7 @@ PP(pp_regcreset) /* XXXX Should store the old value to allow for tie/overload - and restore in regcomp, where marked with XXXX. */ PL_reginterp_cnt = 0; + TAINT_NOT; return NORMAL; } @@ -158,14 +159,11 @@ PP(pp_substcont) char *orig = cx->sb_orig; register REGEXP *rx = cx->sb_rx; SV *nsv = Nullsv; - - { - REGEXP *old = PM_GETRE(pm); - if(old != rx) { + REGEXP *old = PM_GETRE(pm); + if(old != rx) { if(old) - ReREFCNT_dec(old); + ReREFCNT_dec(old); PM_SETRE(pm,rx); - } } rxres_restore(&cx->sb_rxres, rx); @@ -251,7 +249,8 @@ PP(pp_substcont) sv_pos_b2u(sv, &i); mg->mg_len = i; } - ReREFCNT_inc(rx); + if (old != rx) + ReREFCNT_inc(rx); cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); rxres_save(&cx->sb_rxres, rx); RETURNOP(pm->op_pmreplstart); @@ -1005,6 +1004,16 @@ PP(pp_flip) } } +/* This code tries to decide if "$left .. $right" should use the + magical string increment, or if the range is numeric (we make + an exception for .."0" [#18165]). AMS 20021031. */ + +#define RANGE_IS_NUMERIC(left,right) ( \ + SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ + SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ + (looks_like_number(left) && SvPOKp(left) && *SvPVX(left) != '0' && \ + looks_like_number(right))) + PP(pp_flop) { dSP; @@ -1020,15 +1029,7 @@ PP(pp_flop) if (SvGMAGICAL(right)) mg_get(right); - /* This code tries to decide if "$left .. $right" should use the - magical string increment, or if the range is numeric (we make - an exception for .."0" [#18165]). AMS 20021031. */ - - if (SvNIOKp(left) || !SvPOKp(left) || - SvNIOKp(right) || !SvPOKp(right) || - (looks_like_number(left) && *SvPVX(left) != '0' && - looks_like_number(right))) - { + if (RANGE_IS_NUMERIC(left,right)) { if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX) DIE(aTHX_ "Range iterator outside integer range"); i = SvIV(left); @@ -1700,12 +1701,7 @@ PP(pp_enteriter) cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { dPOPss; - /* See comment in pp_flop() */ - if (SvNIOKp(sv) || !SvPOKp(sv) || - SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) || - (looks_like_number(sv) && *SvPVX(sv) != '0' && - looks_like_number((SV*)cx->blk_loop.iterary))) - { + if (RANGE_IS_NUMERIC(sv,(SV*)cx->blk_loop.iterary)) { if (SvNV(sv) < IV_MIN || SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) DIE(aTHX_ "Range iterator outside integer range"); @@ -3559,7 +3555,7 @@ S_doparseform(pTHX_ SV *sv) /* estimate the buffer size needed */ for (base = s; s <= send; s++) { - if (*s == '\n' || *s == '@' || *s == '^') + if (*s == '\n' || *s == '\0' || *s == '@' || *s == '^') maxops += 10; } s = base; diff --git a/gnu/usr.bin/perl/pp_hot.c b/gnu/usr.bin/perl/pp_hot.c index dcc2b68556e..803a8188de8 100644 --- a/gnu/usr.bin/perl/pp_hot.c +++ b/gnu/usr.bin/perl/pp_hot.c @@ -870,21 +870,10 @@ PP(pp_rv2hv) else if (gimme == G_SCALAR) { dTARGET; - /* 21394 adds this, but I'm not sure if it's safe in maint: - if (SvRMAGICAL(hv) && mg_find((SV *)hv, PERL_MAGIC_tied)) - Perl_croak(aTHX_ "Can't provide tied hash usage; " - "use keys(%%hash) to test if empty"); - */ - if (SvTYPE(hv) == SVt_PVAV) hv = avhv_keys((AV*)hv); - if (HvFILL(hv)) - Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, - (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); - else - sv_setiv(TARG, 0); - + TARG = Perl_hv_scalar(aTHX_ hv); SETTARG; } RETURN; @@ -994,8 +983,12 @@ PP(pp_aassign) HV *hash; I32 i; int magic; + int duplicates = 0; + SV **firsthashrelem = 0; /* "= 0" keeps gcc 2.95 quiet */ + PL_delaymagic = DM_DELAY; /* catch simultaneous items */ + gimme = GIMME_V; /* If there's a common identifier on both sides we have to take * special care that assigning the identifier on the left doesn't @@ -1062,6 +1055,7 @@ PP(pp_aassign) hash = (HV*)sv; magic = SvMAGICAL(hash) != 0; hv_clear(hash); + firsthashrelem = relem; while (relem < lastrelem) { /* gobble up all the rest */ HE *didstore; @@ -1073,6 +1067,9 @@ PP(pp_aassign) if (*relem) sv_setsv(tmpstr,*relem); /* value */ *(relem++) = tmpstr; + if (gimme != G_VOID && hv_exists_ent(hash, sv, 0)) + /* key overwrites an existing entry */ + duplicates += 2; didstore = hv_store_ent(hash,sv,tmpstr,0); if (magic) { if (SvSMAGICAL(tmpstr)) @@ -1173,17 +1170,26 @@ PP(pp_aassign) } PL_delaymagic = 0; - gimme = GIMME_V; if (gimme == G_VOID) SP = firstrelem - 1; else if (gimme == G_SCALAR) { dTARGET; SP = firstrelem; - SETi(lastrelem - firstrelem + 1); + SETi(lastrelem - firstrelem + 1 - duplicates); } else { - if (ary || hash) + if (ary) SP = lastrelem; + else if (hash) { + if (duplicates) { + /* Removes from the stack the entries which ended up as + * duplicated keys in the hash (fix for [perl #24380]) */ + Move(firsthashrelem + duplicates, + firsthashrelem, duplicates, SV**); + lastrelem -= duplicates; + } + SP = lastrelem; + } else SP = firstrelem + (lastlelem - firstlelem); lelem = firstlelem + (relem - firstrelem); @@ -1543,7 +1549,7 @@ Perl_do_readline(pTHX) sv_unref(sv); (void)SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ - if (!tmplen) + if (!tmplen && !SvREADONLY(sv)) Sv_Grow(sv, 80); /* try short-buffering it */ offset = 0; if (type == OP_RCATLINE && SvOK(sv)) { @@ -1574,7 +1580,9 @@ Perl_do_readline(pTHX) for (;;) { PUTBACK; if (!sv_gets(sv, fp, offset) - && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv))) + && (type == OP_GLOB + || SNARF_EOF(gimme, PL_rs, io, sv) + || PerlIO_error(fp))) { PerlIO_clearerr(fp); if (IoFLAGS(io) & IOf_ARGV) { diff --git a/gnu/usr.bin/perl/proto.h b/gnu/usr.bin/perl/proto.h index 00c8e40313b..69f202d911e 100644 --- a/gnu/usr.bin/perl/proto.h +++ b/gnu/usr.bin/perl/proto.h @@ -971,7 +971,6 @@ STATIC HEK* S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags STATIC void S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store); STATIC void S_unshare_hek_or_pvn(pTHX_ HEK* hek, const char* sv, I32 len, U32 hash); STATIC HEK* S_share_hek_flags(pTHX_ const char* sv, I32 len, U32 hash, int flags); -STATIC SV** S_hv_fetch_flags(pTHX_ HV* tb, const char* key, I32 klen, I32 lval, int flags); STATIC void S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const char *msg); #endif @@ -1353,5 +1352,14 @@ PERL_CALLCONV int Perl_get_debug_opts(pTHX_ char **s); -END_EXTERN_C +PERL_CALLCONV void Perl_hv_clear_placeholders(pTHX_ HV* hb); + +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash); +STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash); +#endif +PERL_CALLCONV SV* Perl_hv_scalar(pTHX_ HV* hv); +PERL_CALLCONV SV* Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg); + +END_EXTERN_C diff --git a/gnu/usr.bin/perl/shlib_version b/gnu/usr.bin/perl/shlib_version index 00604e64e7d..51876cfb75f 100644 --- a/gnu/usr.bin/perl/shlib_version +++ b/gnu/usr.bin/perl/shlib_version @@ -1,2 +1,2 @@ major=8 -minor=1 +minor=2 diff --git a/gnu/usr.bin/perl/sv.c b/gnu/usr.bin/perl/sv.c index fbab716430d..5875b5d9e32 100644 --- a/gnu/usr.bin/perl/sv.c +++ b/gnu/usr.bin/perl/sv.c @@ -4257,11 +4257,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) char *pvx = SvPVX(sv); STRLEN len = SvCUR(sv); U32 hash = SvUVX(sv); + SvFAKE_off(sv); + SvREADONLY_off(sv); SvGROW(sv, len + 1); Move(pvx,SvPVX(sv),len,char); *SvEND(sv) = '\0'; - SvFAKE_off(sv); - SvREADONLY_off(sv); unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash); } else if (IN_PERL_RUNTIME) @@ -4649,6 +4649,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam && how != PERL_MAGIC_bm && how != PERL_MAGIC_fm && how != PERL_MAGIC_sv + && how != PERL_MAGIC_backref ) { Perl_croak(aTHX_ PL_no_modify); @@ -5446,11 +5447,9 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offse bool found = FALSE; if (SvMAGICAL(sv) && !SvREADONLY(sv)) { - if (!*mgp) { - sv_magic(sv, 0, PERL_MAGIC_utf8, 0, 0); - *mgp = mg_find(sv, PERL_MAGIC_utf8); - } - assert(*mgp); + if (!*mgp) + *mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, &PL_vtbl_utf8, 0, 0); + assert(*mgp); if ((*mgp)->mg_ptr) *cachep = (STRLEN *) (*mgp)->mg_ptr; @@ -5543,6 +5542,12 @@ S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I (*cachep)[i] = (STRLEN)uoff; (*cachep)[i+1] = p - start; + /* Drop the stale "length" cache */ + if (i == 0) { + (*cachep)[2] = 0; + (*cachep)[3] = 0; + } + found = TRUE; } } @@ -5689,44 +5694,44 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) if ((I32)len < *offsetp) Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset"); else { - U8* send = s + *offsetp; - MAGIC* mg = NULL; - STRLEN *cache = NULL; + U8* send = s + *offsetp; + MAGIC* mg = NULL; + STRLEN *cache = NULL; - len = 0; + len = 0; - if (SvMAGICAL(sv) && !SvREADONLY(sv)) { - mg = mg_find(sv, PERL_MAGIC_utf8); - if (mg && mg->mg_ptr) { - cache = (STRLEN *) mg->mg_ptr; - if (cache[1] == (STRLEN)*offsetp) { - /* An exact match. */ - *offsetp = cache[0]; + if (SvMAGICAL(sv) && !SvREADONLY(sv)) { + mg = mg_find(sv, PERL_MAGIC_utf8); + if (mg && mg->mg_ptr) { + cache = (STRLEN *) mg->mg_ptr; + if (cache[1] == (STRLEN)*offsetp) { + /* An exact match. */ + *offsetp = cache[0]; - return; - } - else if (cache[1] < (STRLEN)*offsetp) { - /* We already know part of the way. */ - len = cache[0]; - s += cache[1]; - /* Let the below loop do the rest. */ - } - else { /* cache[1] > *offsetp */ - /* We already know all of the way, now we may - * be able to walk back. The same assumption - * is made as in S_utf8_mg_pos(), namely that - * walking backward is twice slower than - * walking forward. */ - STRLEN forw = *offsetp; - STRLEN backw = cache[1] - *offsetp; - - if (!(forw < 2 * backw)) { - U8 *p = s + cache[1]; - STRLEN ubackw = 0; + return; + } + else if (cache[1] < (STRLEN)*offsetp) { + /* We already know part of the way. */ + len = cache[0]; + s += cache[1]; + /* Let the below loop do the rest. */ + } + else { /* cache[1] > *offsetp */ + /* We already know all of the way, now we may + * be able to walk back. The same assumption + * is made as in S_utf8_mg_pos(), namely that + * walking backward is twice slower than + * walking forward. */ + STRLEN forw = *offsetp; + STRLEN backw = cache[1] - *offsetp; + + if (!(forw < 2 * backw)) { + U8 *p = s + cache[1]; + STRLEN ubackw = 0; - cache[1] -= backw; + cache[1] -= backw; - while (backw--) { + while (backw--) { p--; while (UTF8_IS_CONTINUATION(*p)) { p--; @@ -5744,39 +5749,39 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) ASSERT_UTF8_CACHE(cache); } - while (s < send) { - STRLEN n = 1; + while (s < send) { + STRLEN n = 1; - /* Call utf8n_to_uvchr() to validate the sequence - * (unless a simple non-UTF character) */ - if (!UTF8_IS_INVARIANT(*s)) - utf8n_to_uvchr(s, UTF8SKIP(s), &n, 0); - if (n > 0) { - s += n; - len++; - } - else - break; - } + /* Call utf8n_to_uvchr() to validate the sequence + * (unless a simple non-UTF character) */ + if (!UTF8_IS_INVARIANT(*s)) + utf8n_to_uvchr(s, UTF8SKIP(s), &n, 0); + if (n > 0) { + s += n; + len++; + } + else + break; + } - if (!SvREADONLY(sv)) { - if (!mg) { - sv_magic(sv, 0, PERL_MAGIC_utf8, 0, 0); - mg = mg_find(sv, PERL_MAGIC_utf8); - } - assert(mg); + if (!SvREADONLY(sv)) { + if (!mg) { + sv_magic(sv, 0, PERL_MAGIC_utf8, 0, 0); + mg = mg_find(sv, PERL_MAGIC_utf8); + } + assert(mg); - if (!mg->mg_ptr) { - Newz(0, cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN); - mg->mg_ptr = (char *) cache; - } - assert(cache); + if (!mg->mg_ptr) { + Newz(0, cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN); + mg->mg_ptr = (char *) cache; + } + assert(cache); - cache[0] = len; - cache[1] = *offsetp; - } + cache[0] = len; + cache[1] = *offsetp; + } - *offsetp = len; + *offsetp = len; } return; @@ -6097,7 +6102,13 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) I32 rspara = 0; I32 recsize; - SV_CHECK_THINKFIRST(sv); + if (SvTHINKFIRST(sv)) + sv_force_normal_flags(sv, append ? 0 : SV_COW_DROP_PV); + /* XXX. If you make this PVIV, then copy on write can copy scalars read + from <>. + However, perlbench says it's slower, because the existing swipe code + is faster than copy on write. + Swings and roundabouts. */ (void)SvUPGRADE(sv, SVt_PV); SvSCREAM_off(sv); @@ -8240,6 +8251,33 @@ S_expect_number(pTHX_ char** pattern) } #define EXPECT_NUMBER(pattern, var) (var = S_expect_number(aTHX_ &pattern)) +static char * +F0convert(NV nv, char *endbuf, STRLEN *len) +{ + int neg = nv < 0; + UV uv; + char *p = endbuf; + + if (neg) + nv = -nv; + if (nv < UV_MAX) { + nv += 0.5; + uv = (UV)nv; + if (uv & 1 && uv == nv) + uv--; /* Round to even */ + do { + unsigned dig = uv % 10; + *--p = '0' + dig; + } while (uv /= 10); + if (neg) + *--p = '-'; + *len = endbuf - p; + return p; + } + return Nullch; +} + + /* =for apidoc sv_vcatpvfn @@ -8267,6 +8305,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV bool has_utf8; /* has the result utf8? */ bool pat_utf8; /* the pattern is in utf8? */ SV *nsv = Nullsv; + /* Times 4: a decimal digit takes more than 3 binary digits. + * NV_DIG: mantissa takes than many decimal digits. + * Plus 32: Playing safe. */ + char ebuf[IV_DIG * 4 + NV_DIG + 32]; + /* large enough for "%#.#f" --chip */ + /* what about long double NVs? --jhi */ has_utf8 = pat_utf8 = DO_UTF8(sv); @@ -8302,6 +8346,48 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } +#ifndef USE_LONG_DOUBLE + /* special-case "%.<number>[gf]" */ + if ( patlen <= 5 && pat[0] == '%' && pat[1] == '.' + && (pat[patlen-1] == 'g' || pat[patlen-1] == 'f') ) { + unsigned digits = 0; + const char *pp; + + pp = pat + 2; + while (*pp >= '0' && *pp <= '9') + digits = 10 * digits + (*pp++ - '0'); + if (pp - pat == (int)patlen - 1) { + NV nv; + + if (args) + nv = (NV)va_arg(*args, double); + else if (svix < svmax) + nv = SvNV(*svargs); + else + return; + if (*pp == 'g') { + /* Add check for digits != 0 because it seems that some + gconverts are buggy in this case, and we don't yet have + a Configure test for this. */ + if (digits && digits < sizeof(ebuf) - NV_DIG - 10) { + /* 0, point, slack */ + Gconvert(nv, (int)digits, 0, ebuf); + sv_catpv(sv, ebuf); + if (*ebuf) /* May return an empty string for digits==0 */ + return; + } + } else if (!digits) { + STRLEN l; + + if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) { + sv_catpvn(sv, p, l); + return; + } + } + } + } +#endif /* !USE_LONG_DOUBLE */ + if (!args && svix < svmax && DO_UTF8(*svargs)) has_utf8 = TRUE; @@ -8333,13 +8419,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV char *eptr = Nullch; STRLEN elen = 0; - /* Times 4: a decimal digit takes more than 3 binary digits. - * NV_DIG: mantissa takes than many decimal digits. - * Plus 32: Playing safe. */ - char ebuf[IV_DIG * 4 + NV_DIG + 32]; - /* large enough for "%#.#f" --chip */ - /* what about long double NVs? --jhi */ - SV *vecsv = Nullsv; U8 *vecstr = Null(U8*); STRLEN veclen = 0; @@ -8688,23 +8767,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV else if (args) { switch (intsize) { case 'h': iv = (short)va_arg(*args, int); break; - default: iv = va_arg(*args, int); break; case 'l': iv = va_arg(*args, long); break; case 'V': iv = va_arg(*args, IV); break; + default: iv = va_arg(*args, int); break; #ifdef HAS_QUAD case 'q': iv = va_arg(*args, Quad_t); break; #endif } } else { - iv = SvIVx(argsv); + IV tiv = SvIVx(argsv); /* work around GCC bug #13488 */ switch (intsize) { - case 'h': iv = (short)iv; break; - default: break; - case 'l': iv = (long)iv; break; - case 'V': break; + case 'h': iv = (short)tiv; break; + case 'l': iv = (long)tiv; break; + case 'V': + default: iv = tiv; break; #ifdef HAS_QUAD - case 'q': iv = (Quad_t)iv; break; + case 'q': iv = (Quad_t)tiv; break; #endif } } @@ -8772,23 +8851,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV else if (args) { switch (intsize) { case 'h': uv = (unsigned short)va_arg(*args, unsigned); break; - default: uv = va_arg(*args, unsigned); break; case 'l': uv = va_arg(*args, unsigned long); break; case 'V': uv = va_arg(*args, UV); break; + default: uv = va_arg(*args, unsigned); break; #ifdef HAS_QUAD - case 'q': uv = va_arg(*args, Quad_t); break; + case 'q': uv = va_arg(*args, Uquad_t); break; #endif } } else { - uv = SvUVx(argsv); + UV tuv = SvUVx(argsv); /* work around GCC bug #13488 */ switch (intsize) { - case 'h': uv = (unsigned short)uv; break; - default: break; - case 'l': uv = (unsigned long)uv; break; - case 'V': break; + case 'h': uv = (unsigned short)tuv; break; + case 'l': uv = (unsigned long)tuv; break; + case 'V': + default: uv = tuv; break; #ifdef HAS_QUAD - case 'q': uv = (Quad_t)uv; break; + case 'q': uv = (Uquad_t)tuv; break; #endif } } @@ -8999,6 +9078,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV PL_efloatbuf[0] = '\0'; } + if ( !(width || left || plus || alt) && fill != '0' + && has_precis && intsize != 'q' ) { /* Shortcuts */ + /* See earlier comment about buggy Gconvert when digits, + aka precis is 0 */ + if ( c == 'g' && precis) { + Gconvert((NV)nv, (int)precis, 0, PL_efloatbuf); + if (*PL_efloatbuf) /* May return an empty string for digits==0 */ + goto float_converted; + } else if ( c == 'f' && !precis) { + if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen))) + break; + } + } eptr = ebuf + sizeof ebuf; *--eptr = '\0'; *--eptr = c; @@ -9043,6 +9135,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV #else (void)sprintf(PL_efloatbuf, eptr, nv); #endif + float_converted: eptr = PL_efloatbuf; elen = strlen(PL_efloatbuf); break; @@ -9654,7 +9747,7 @@ S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param) GvHV(gv) = (HV*)sv; } else { - SvREADONLY_on(GvAV(gv)); + SvREADONLY_on(GvHV(gv)); } return sstr; /* he_dup() will SvREFCNT_inc() */ @@ -10616,9 +10709,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_debug = proto_perl->Idebug; #ifdef USE_REENTRANT_API -#ifdef DEBUGGING - PERL_SET_CONTEXT(proto_perl); -#endif + /* XXX: things like -Dm will segfault here in perlio, but doing + * PERL_SET_CONTEXT(proto_perl); + * breaks too many other things + */ Perl_reentrant_init(aTHX); #endif diff --git a/gnu/usr.bin/perl/sv.h b/gnu/usr.bin/perl/sv.h index c4d47660740..f9268f7e80a 100644 --- a/gnu/usr.bin/perl/sv.h +++ b/gnu/usr.bin/perl/sv.h @@ -156,10 +156,10 @@ perform the upgrade if necessary. See C<svtype>. #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) # define SvREFCNT_inc(sv) \ ({ \ - SV *nsv = (SV*)(sv); \ - if (nsv) \ - ATOMIC_INC(SvREFCNT(nsv)); \ - nsv; \ + SV *_sv = (SV*)(sv); \ + if (_sv) \ + ATOMIC_INC(SvREFCNT(_sv)); \ + _sv; \ }) #else # ifdef USE_5005THREADS @@ -1025,12 +1025,12 @@ scalar. #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); }) -# define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); }) -# define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); }) -# define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); }) -# define SvPVutf8x(sv, lp) ({SV *nsv = (sv); SvPVutf8(nsv, lp); }) -# define SvPVbytex(sv, lp) ({SV *nsv = (sv); SvPVbyte(nsv, lp); }) +# define SvIVx(sv) ({SV *_sv = (SV*)(sv); SvIV(_sv); }) +# define SvUVx(sv) ({SV *_sv = (SV*)(sv); SvUV(_sv); }) +# define SvNVx(sv) ({SV *_sv = (SV*)(sv); SvNV(_sv); }) +# define SvPVx(sv, lp) ({SV *_sv = (sv); SvPV(_sv, lp); }) +# define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); }) +# define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); }) # define SvTRUE(sv) ( \ !sv \ ? 0 \ @@ -1047,7 +1047,7 @@ scalar. : SvNOK(sv) \ ? SvNVX(sv) != 0.0 \ : sv_2bool(sv) ) -# define SvTRUEx(sv) ({SV *nsv = (sv); SvTRUE(nsv); }) +# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) #else /* __GNUC__ */ @@ -1091,6 +1091,9 @@ scalar. # endif /* USE_5005THREADS */ #endif /* __GNU__ */ +#define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ + (SVf_FAKE | SVf_READONLY)) +#define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0) /* flag values for sv_*_flags functions */ #define SV_IMMEDIATE_UNREF 1 diff --git a/gnu/usr.bin/perl/t/op/join.t b/gnu/usr.bin/perl/t/op/join.t index 0f849fda9c0..a1cc6071252 100644 --- a/gnu/usr.bin/perl/t/op/join.t +++ b/gnu/usr.bin/perl/t/op/join.t @@ -1,6 +1,6 @@ #!./perl -print "1..14\n"; +print "1..18\n"; @x = (1, 2, 3); if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} @@ -65,3 +65,29 @@ if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";} print "ok 14\n"; } +{ # [perl #24846] $jb2 should be in bytes, not in utf8. + my $b = "abc\304"; + my $u = "abc\x{0100}"; + + sub join_into_my_variable { + my $r = join("", @_); + return $r; + } + + my $jb1 = join_into_my_variable("", $b); + my $ju1 = join_into_my_variable("", $u); + my $jb2 = join_into_my_variable("", $b); + my $ju2 = join_into_my_variable("", $u); + + print "not " unless unpack('H*', $jb1) eq unpack('H*', $b); + print "ok 15\n"; + + print "not " unless unpack('H*', $ju1) eq unpack('H*', $u); + print "ok 16\n"; + + print "not " unless unpack('H*', $jb2) eq unpack('H*', $b); + print "ok 17\n"; + + print "not " unless unpack('H*', $ju2) eq unpack('H*', $u); + print "ok 18\n"; +} diff --git a/gnu/usr.bin/perl/t/op/pat.t b/gnu/usr.bin/perl/t/op/pat.t index a10e28b8bb6..54e648da82f 100644 --- a/gnu/usr.bin/perl/t/op/pat.t +++ b/gnu/usr.bin/perl/t/op/pat.t @@ -1691,10 +1691,11 @@ EOT print "not " if $x =~ /[\x{100}]/; print "ok 604\n"; - print "not " unless $x =~ /\p{InLatin1Supplement}/; + # the next two tests must be ignored on EBCDIC + print "not " unless $x =~ /\p{InLatin1Supplement}/ or ord("A") == 193; print "ok 605\n"; - print "not " if $x =~ /\P{InLatin1Supplement}/; + print "not " if $x =~ /\P{InLatin1Supplement}/ and ord("A") != 193; print "ok 606\n"; print "not " if $x =~ /\p{InLatinExtendedA}/; @@ -1909,7 +1910,8 @@ print "ok 663\n"; print "not " unless chr(0xfb4f) =~ /\p{IsHebrew}/; # outside InHebrew print "ok 664\n"; -print "not " unless chr(0xb5) =~ /\p{IsGreek}/; # singleton (not in a range) +# singleton (not in a range, this test must be ignored on EBCDIC) +print "not " unless chr(0xb5) =~ /\p{IsGreek}/ or ord("A") == 193; print "ok 665\n"; print "not " unless chr(0x37a) =~ /\p{IsGreek}/; # singleton diff --git a/gnu/usr.bin/perl/t/op/range.t b/gnu/usr.bin/perl/t/op/range.t index a4f03c5a722..d54c96d11fd 100644 --- a/gnu/usr.bin/perl/t/op/range.t +++ b/gnu/usr.bin/perl/t/op/range.t @@ -1,6 +1,6 @@ #!./perl -print "1..19\n"; +print "1..25\n"; print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n"; @@ -79,3 +79,13 @@ print join(":","-4".."0") eq "-4:-3:-2:-1:0" ? "ok 16\n" : "not ok 16\n"; print join(":","-4".."-0") eq "-4:-3:-2:-1:0" ? "ok 17\n" : "not ok 17\n"; print join(":","-4\n".."0\n") eq "-4:-3:-2:-1:0" ? "ok 18\n" : "not ok 18\n"; print join(":","-4\n".."-0\n") eq "-4:-3:-2:-1:0" ? "ok 19\n" : "not ok 19\n"; + +# undef should be treated as 0 for numerical range +print join(":",undef..2) eq '0:1:2' ? "ok 20\n" : "not ok 20\n"; +print join(":",-2..undef) eq '-2:-1:0' ? "ok 21\n" : "not ok 21\n"; + +# undef should be treated as "" for magical range +print join(":","".."B") eq '' ? "ok 22\n" : "not ok 22\n"; +print join(":",undef.."B") eq '' ? "ok 23\n" : "not ok 23\n"; +print join(":","B".."") eq '' ? "ok 24\n" : "not ok 24\n"; +print join(":","B"..undef) eq '' ? "ok 25\n" : "not ok 25\n"; diff --git a/gnu/usr.bin/perl/t/op/substr.t b/gnu/usr.bin/perl/t/op/substr.t index 533f1a5bc47..dfb483aee58 100644 --- a/gnu/usr.bin/perl/t/op/substr.t +++ b/gnu/usr.bin/perl/t/op/substr.t @@ -1,6 +1,6 @@ #!./perl -print "1..176\n"; +print "1..177\n"; #P = start of string Q = start of substr R = end of substr S = end of string @@ -602,3 +602,10 @@ ok 174, $x eq "\x{100}\x{200}\xFFb"; my $x = my $y = 'AB'; ss $x; ss $y; ok 176, $x eq $y; } + +# [perl #24605] +{ + my $x = "0123456789\x{500}"; + my $y = substr $x, 4; + ok 177, substr($x, 7, 1) eq "7"; +} diff --git a/gnu/usr.bin/perl/t/op/taint.t b/gnu/usr.bin/perl/t/op/taint.t index e6e12654660..9751eecb269 100644 --- a/gnu/usr.bin/perl/t/op/taint.t +++ b/gnu/usr.bin/perl/t/op/taint.t @@ -124,7 +124,7 @@ my $echo = "$Invoke_Perl $ECHO"; my $TEST = catfile(curdir(), 'TEST'); -print "1..206\n"; +print "1..220\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -139,7 +139,17 @@ print "1..206\n"; if ($Is_Cygwin && ! -f 'cygwin1.dll') { system("/usr/bin/cp /usr/bin/cygwin1.dll .") && die "$0: failed to cp cygwin1.dll: $!\n"; - END { unlink "cygwin1.dll" } # yes, done for all platforms... + eval q{ + END { unlink "cygwin1.dll" } + }; + } + + if ($Is_Cygwin && ! -f 'cygcrypt-0.dll' && -f '/usr/bin/cygcrypt-0.dll') { + system("/usr/bin/cp /usr/bin/cygcrypt-0.dll .") && + die "$0: failed to cp cygcrypt-0.dll: $!\n"; + eval q{ + END { unlink "cygcrypt-0.dll" } + }; } test 1, eval { `$echo 1` } eq "1\n"; @@ -982,3 +992,42 @@ else $TAINT =~ /(.*)/; test 206, tainted(my $foo = $1); } + +{ + # Remove this when changes 21542 and 21563 are integrated + test 207, 1; + test 208, 1; +} + +{ + # [perl #24248] + $TAINT =~ /(.*)/; + test 209, !tainted($1); + my $notaint = $1; + test 210, !tainted($notaint); + + my $l; + $notaint =~ /($notaint)/; + $l = $1; + test 211, !tainted($1); + test 212, !tainted($l); + $notaint =~ /($TAINT)/; + $l = $1; + test 213, tainted($1); + test 214, tainted($l); + + $TAINT =~ /($notaint)/; + $l = $1; + test 215, !tainted($1); + test 216, !tainted($l); + $TAINT =~ /($TAINT)/; + $l = $1; + test 217, tainted($1); + test 218, tainted($l); + + my $r; + ($r = $TAINT) =~ /($notaint)/; + test 219, !tainted($1); + ($r = $TAINT) =~ /($TAINT)/; + test 220, tainted($1); +} diff --git a/gnu/usr.bin/perl/t/op/tie.t b/gnu/usr.bin/perl/t/op/tie.t index f30f69336da..51c4b3a5b85 100644 --- a/gnu/usr.bin/perl/t/op/tie.t +++ b/gnu/usr.bin/perl/t/op/tie.t @@ -446,3 +446,98 @@ sub FETCH } EXPECT ok +######## + +# test SCALAR method +package TieScalar; + +sub TIEHASH { + my $pkg = shift; + bless { } => $pkg; +} + +sub STORE { + $_[0]->{$_[1]} = $_[2]; +} + +sub FETCH { + $_[0]->{$_[1]} +} + +sub CLEAR { + %{ $_[0] } = (); +} + +sub SCALAR { + print "SCALAR\n"; + return 0 if ! keys %{$_[0]}; + sprintf "%i/%i", scalar keys %{$_[0]}, scalar keys %{$_[0]}; +} + +package main; +tie my %h => "TieScalar"; +$h{key1} = "val1"; +$h{key2} = "val2"; +print scalar %h, "\n"; +%h = (); +print scalar %h, "\n"; +EXPECT +SCALAR +2/2 +SCALAR +0 +######## + +# test scalar on tied hash when no SCALAR method has been given +package TieScalar; + +sub TIEHASH { + my $pkg = shift; + bless { } => $pkg; +} +sub STORE { + $_[0]->{$_[1]} = $_[2]; +} +sub FETCH { + $_[0]->{$_[1]} +} +sub CLEAR { + %{ $_[0] } = (); +} +sub FIRSTKEY { + my $a = keys %{ $_[0] }; + print "FIRSTKEY\n"; + each %{ $_[0] }; +} + +package main; +tie my %h => "TieScalar"; + +if (!%h) { + print "empty\n"; +} else { + print "not empty\n"; +} + +$h{key1} = "val1"; +print "not empty\n" if %h; +print "not empty\n" if %h; +print "-->\n"; +my ($k,$v) = each %h; +print "<--\n"; +print "not empty\n" if %h; +%h = (); +print "empty\n" if ! %h; +EXPECT +FIRSTKEY +empty +FIRSTKEY +not empty +FIRSTKEY +not empty +--> +FIRSTKEY +<-- +not empty +FIRSTKEY +empty diff --git a/gnu/usr.bin/perl/t/op/write.t b/gnu/usr.bin/perl/t/op/write.t index 744f6bd1d62..561d49e0e40 100644 --- a/gnu/usr.bin/perl/t/op/write.t +++ b/gnu/usr.bin/perl/t/op/write.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..49\n"; +print "1..50\n"; my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type' : ($^O eq 'MacOS') ? 'catenate' @@ -300,14 +300,24 @@ $v print `$CAT Op_write.tmp`; } +{ + # Bug #24774 format without trailing \n failed assertion + my @v = ('k'); + eval "format OUT14 = \n@\n\@v"; + open(OUT14, '>Op_write.tmp') || die "Can't create Op_write.tmp"; + write(OUT14); + close OUT14 or die "Could not close: $!"; + print "ok 14\n"; +} + ####################################### # Easiest to add new tests above here # ####################################### -# 14..49: scary format testing from Merijn H. Brand +# 15..50: scary format testing from Merijn H. Brand -my $test = 14; -my $tests = 49; +my $test = 15; +my $tests = 50; if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' || ($^O eq 'os2' and not eval '$OS2::can_fork')) { diff --git a/gnu/usr.bin/perl/t/pod/pod2usage.xr b/gnu/usr.bin/perl/t/pod/pod2usage.xr index d9ad11a1bb7..126da1554f5 100644 --- a/gnu/usr.bin/perl/t/pod/pod2usage.xr +++ b/gnu/usr.bin/perl/t/pod/pod2usage.xr @@ -47,6 +47,8 @@ SEE ALSO the Pod::Usage manpage, the pod2text(1) manpage AUTHOR + Please report bugs using http://rt.cpan.org. + Brad Appleton <bradapp@enteract.com> Based on code for pod2text(1) written by Tom Christiansen diff --git a/gnu/usr.bin/perl/universal.c b/gnu/usr.bin/perl/universal.c index b18306266ac..c55b48864fb 100644 --- a/gnu/usr.bin/perl/universal.c +++ b/gnu/usr.bin/perl/universal.c @@ -542,53 +542,13 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ XSRETURN_UNDEF; /* Can't happen. */ } -/* Maybe this should return the number of placeholders found in scalar context, - and a list of them in list context. */ XS(XS_Internals_hv_clear_placehold) { dXSARGS; HV *hv = (HV *) SvRV(ST(0)); - - /* I don't care how many parameters were passed in, but I want to avoid - the unused variable warning. */ - - items = (I32)HvPLACEHOLDERS(hv); - - if (items) { - HE *entry; - I32 riter = HvRITER(hv); - HE *eiter = HvEITER(hv); - hv_iterinit(hv); - /* This may look suboptimal with the items *after* the iternext, but - it's quite deliberate. We only get here with items==0 if we've - just deleted the last placeholder in the hash. If we've just done - that then it means that the hash is in lazy delete mode, and the - HE is now only referenced in our iterator. If we just quit the loop - and discarded our iterator then the HE leaks. So we do the && the - other way to ensure iternext is called just one more time, which - has the side effect of triggering the lazy delete. */ - while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) - && items) { - SV *val = hv_iterval(hv, entry); - - if (val == &PL_sv_placeholder) { - - /* It seems that I have to go back in the front of the hash - API to delete a hash, even though I have a HE structure - pointing to the very entry I want to delete, and could hold - onto the previous HE that points to it. And it's easier to - go in with SVs as I can then specify the precomputed hash, - and don't have fun and games with utf8 keys. */ - SV *key = hv_iterkeysv(entry); - - hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry)); - items--; - } - } - HvRITER(hv) = riter; - HvEITER(hv) = eiter; - } - + if (items != 1) + Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)"); + hv_clear_placeholders(hv); XSRETURN(0); } diff --git a/gnu/usr.bin/perl/unixish.h b/gnu/usr.bin/perl/unixish.h index 4bf37095a09..23b3cadf12b 100644 --- a/gnu/usr.bin/perl/unixish.h +++ b/gnu/usr.bin/perl/unixish.h @@ -103,9 +103,7 @@ */ /* #define ALTERNATE_SHEBANG "#!" / **/ -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__OpenBSD__) # include <signal.h> -#endif #ifndef SIGABRT # define SIGABRT SIGILL diff --git a/gnu/usr.bin/perl/util.c b/gnu/usr.bin/perl/util.c index 4f18a3060f8..856ef93bd7d 100644 --- a/gnu/usr.bin/perl/util.c +++ b/gnu/usr.bin/perl/util.c @@ -18,10 +18,7 @@ #include "perl.h" #ifndef PERL_MICRO -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> -#endif - #ifndef SIG_ERR # define SIG_ERR ((Sighandler_t) -1) #endif diff --git a/gnu/usr.bin/perl/utils/Makefile b/gnu/usr.bin/perl/utils/Makefile index 8b98950a1de..48f1e14ff31 100644 --- a/gnu/usr.bin/perl/utils/Makefile +++ b/gnu/usr.bin/perl/utils/Makefile @@ -5,9 +5,9 @@ REALPERL = ../perl # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL cpan.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL -plextract = c2ph cpan h2ph h2xs perlbug perldoc perlivp pl2pm splain perlcc dprofpp libnetcfg piconv enc2xs -plextractexe = ./c2ph ./cpan ./h2ph ./h2xs ./perlbug ./perldoc ./perlivp ./pl2pm ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs +pl = c2ph.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL +plextract = c2ph cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp +plextractexe = ./c2ph ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp all: $(plextract) @@ -35,12 +35,16 @@ h2ph: h2ph.PL ../config.sh h2xs: h2xs.PL ../config.sh +instmodsh: instmodsh.PL ../config.sh + perlbug: perlbug.PL ../config.sh ../patchlevel.h perldoc: perldoc.PL ../config.sh perlivp: perlivp.PL ../config.sh +prove: prove.PL ../config.sh + pl2pm: pl2pm.PL ../config.sh splain: splain.PL ../config.sh ../lib/diagnostics.pm @@ -55,6 +59,8 @@ piconv: piconv.PL ../config.sh enc2xs: enc2xs.PL ../config.sh +xsubpp: xsubpp.PL ../config.sh + clean: realclean: diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL index 8b43191aa47..ef2063d1cf3 100644 --- a/gnu/usr.bin/perl/utils/h2xs.PL +++ b/gnu/usr.bin/perl/utils/h2xs.PL @@ -101,7 +101,7 @@ Allows a pre-existing extension directory to be overwritten. =item B<-P>, B<--omit-pod> -Omit the autogenerated stub POD section. +Omit the autogenerated stub POD section. =item B<-X>, B<--omit-XS> @@ -169,7 +169,7 @@ not found in standard include directories. =item B<-g>, B<--global> -Include code for safely storing static data in the .xs file. +Include code for safely storing static data in the .xs file. Extensions that do no make use of static data can ignore this option. =item B<-h>, B<-?>, B<--help> @@ -305,7 +305,7 @@ also the section on L<LIMITATIONS of B<-x>>. # Extension is ONC::RPC. h2xs -cfn ONC::RPC - + # Extension is Lib::Foo which works at least with Perl5.005_03. # Constants are created for all #defines and enums h2xs can find # in foo.h. @@ -316,7 +316,7 @@ also the section on L<LIMITATIONS of B<-x>>. # whose names do not start with 'bar_'. h2xs -b 5.5.3 -e '^bar_' -n Lib::Foo foo.h - # Makefile.PL will look for library -lrpc in + # Makefile.PL will look for library -lrpc in # additional directory /opt/net/lib h2xs rpcsvc/rusers -L/opt/net/lib -lrpc @@ -326,7 +326,7 @@ also the section on L<LIMITATIONS of B<-x>>. # Extension is DCE::rgynbase # prefix "sec_rgy_" is dropped from perl function names - # subroutines are created for sec_rgy_wildcard_name and + # subroutines are created for sec_rgy_wildcard_name and # sec_rgy_wildcard_sid h2xs -n DCE::rgynbase -p sec_rgy_ \ -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase @@ -335,7 +335,7 @@ also the section on L<LIMITATIONS of B<-x>>. # visible from perl.h. Name of the extension is perl1. # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)= # Extra backslashes below because the string is passed to shell. - # Note that a directory with perl header files would + # Note that a directory with perl header files would # be added automatically to include path. h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h @@ -492,7 +492,7 @@ See L<perlxs> and L<perlxstut> for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.23 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.7 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -528,11 +528,11 @@ OPTIONS: from the XS file. -d, --debugging Turn on debugging messages. -e, --omit-enums Omit constants from enums in the constant() function. - If a pattern is given, only the matching enums are + If a pattern is given, only the matching enums are ignored. -f, --force Force creation of the extension even if the C header does not exist. - -g, --global Include code for safely storing static data in the .xs file. + -g, --global Include code for safely storing static data in the .xs file. -h, -?, --help Display this help message -k, --omit-const-func Omit 'const' attribute on function arguments (used with -x). @@ -825,7 +825,7 @@ if( @path_h ){ } if (!$opt_c) { - die "Can't find $tmp_path_h in @dirs\n" + die "Can't find $tmp_path_h in @dirs\n" if ( ! $opt_f && ! -f "$rel_path_h" ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names @@ -834,7 +834,7 @@ if( @path_h ){ defines: while (<CH>) { if ($pre_sub_tri_graphs) { - # Preprocess all tri-graphs + # Preprocess all tri-graphs # including things stuck in quoted string constants. s/\?\?=/#/g; # | ??=| #| s/\?\?\!/|/g; # | ??!| || @@ -888,12 +888,12 @@ if( @path_h ){ my $src = do { local $/; <CH> }; close CH; no warnings 'uninitialized'; - - # Remove C and C++ comments + + # Remove C and C++ comments $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs; - + while ($src =~ /(\benum\s*([\w_]*)\s*\{\s([\s\w=,]+)\})/gsc) { - my ($enum_name, $enum_body) = + my ($enum_name, $enum_body) = $1 =~ /enum\s*([\w_]*)\s*\{\s([\s\w=,]+)\}/gs; # skip enums matching $opt_e next if $opt_e && $enum_name =~ /$opt_e/; @@ -921,13 +921,13 @@ my $constsxsfname = 'const-xs.inc'; my $fallbackdirname = 'fallback'; my $ext = chdir 'ext' ? 'ext/' : ''; - + my @modparts = split(/::/,$module); my $modpname = join('-', @modparts); my $modfname = pop @modparts; my $modpmdir = join '/', 'lib', @modparts; my $modpmname = join '/', $modpmdir, $modfname.'.pm'; - + if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; } @@ -1053,7 +1053,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled $n = keys %td; my ($k, $v); while (($k, $v) = each %seen_define) { - # print("found '$k'=>'$v'\n"), + # print("found '$k'=>'$v'\n"), $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v}; } } @@ -1123,7 +1123,7 @@ if ( $compat_version < 5.006 ) { # Determine @ISA. my @modISA; -push @modISA, 'Exporter' unless $skip_exporter; +push @modISA, 'Exporter' unless $skip_exporter; push @modISA, 'DynaLoader' if $use_Dyna; # no XS my $myISA = "our \@ISA = qw(@modISA);"; $myISA =~ s/^our // if $compat_version < 5.006; @@ -1615,7 +1615,7 @@ _to_ptr(THIS) croak("Size \%d of packed data != expected \%d", len, sizeof(THIS)); RETVAL = ($name *)s; - } + } else croak("THIS is not of type $name"); OUTPUT: @@ -1748,9 +1748,9 @@ sub get_typemap { next unless -e $typemap ; # skip directories, binary files etc. warn " Scanning $typemap\n"; - warn("Warning: ignoring non-text typemap file '$typemap'\n"), next + warn("Warning: ignoring non-text typemap file '$typemap'\n"), next unless -T $typemap ; - open(TYPEMAP, $typemap) + open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; my $mode = 'Typemap'; while (<TYPEMAP>) { @@ -1781,7 +1781,7 @@ sub normalize_type { # Second arg: do not strip const's before \* my $do_keep_deep_const = shift; # If $do_keep_deep_const this is heuristical only my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : ''); - my $ignore_mods + my $ignore_mods = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! $type =~ s/$ignore_mods//go; @@ -1796,7 +1796,7 @@ sub normalize_type { # Second arg: do not strip const's before \* $type =~ s/\* (?=\*)/*/g; $type =~ s/\. \. \./.../g; $type =~ s/ ,/,/g; - $types_seen{$type}++ + $types_seen{$type}++ unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } @@ -2102,7 +2102,7 @@ _END_ print "# pass: \$\@"; } else { print "# fail: \$\@"; - \$fail = 1; + \$fail = 1; } } if (\$fail) { diff --git a/gnu/usr.bin/perl/vms/gen_shrfls.pl b/gnu/usr.bin/perl/vms/gen_shrfls.pl index 3cdd3ef84ae..f8bf6b190ba 100644 --- a/gnu/usr.bin/perl/vms/gen_shrfls.pl +++ b/gnu/usr.bin/perl/vms/gen_shrfls.pl @@ -39,7 +39,7 @@ require 5.000; $debug = $ENV{'GEN_SHRFLS_DEBUG'}; -print "gen_shrfls.pl Rev. 18-May-2001\n" if $debug; +print "gen_shrfls.pl Rev. 18-Dec-2003\n" if $debug; if ($ARGV[0] eq '-f') { open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; @@ -56,7 +56,8 @@ if ($ARGV[0] eq '-f') { $cc_cmd = shift @ARGV; # Someday, we'll have $GetSyI built into perl . . . -$isvax = `\$ Write Sys\$Output F\$GetSyI(\"HW_MODEL\")` <= 1024; +$isvax = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .LE. 1024 .AND. F\$GetSyI(\"HW_MODEL\") .GT. 0\)`; +chomp $isvax; print "\$isvax: \\$isvax\\\n" if $debug; print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug; diff --git a/gnu/usr.bin/perl/vms/perly_c.vms b/gnu/usr.bin/perl/vms/perly_c.vms index 2b99328ca97..1a50beed108 100644 --- a/gnu/usr.bin/perl/vms/perly_c.vms +++ b/gnu/usr.bin/perl/vms/perly_c.vms @@ -1396,7 +1396,7 @@ static char *yyrule[] = { #define YYMAXDEPTH 500 #endif #endif -#line 793 "perly.y" +#line 794 "perly.y" /* PROGRAM */ /* more stuff added to make perly_c.diff easier to apply */ @@ -2008,185 +2008,186 @@ case 88: break; case 91: #line 480 "perly.y" -{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); } +{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); + PL_expect = XOPERATOR; } break; case 92: -#line 482 "perly.y" +#line 483 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 93: -#line 484 "perly.y" +#line 485 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 94: -#line 488 "perly.y" +#line 489 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 95: -#line 492 "perly.y" +#line 493 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 96: -#line 495 "perly.y" +#line 496 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 97: -#line 500 "perly.y" +#line 501 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 98: -#line 505 "perly.y" +#line 506 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-3].opval))); } break; case 99: -#line 508 "perly.y" +#line 509 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-4].opval)))); } break; case 100: -#line 513 "perly.y" +#line 514 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-3].opval)))); } break; case 101: -#line 517 "perly.y" +#line 518 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-2].opval))); } break; case 102: -#line 523 "perly.y" +#line 524 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 103: -#line 525 "perly.y" +#line 526 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 104: -#line 527 "perly.y" +#line 528 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; case 105: -#line 531 "perly.y" +#line 532 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 106: -#line 533 "perly.y" +#line 534 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 107: -#line 535 "perly.y" +#line 536 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 108: -#line 537 "perly.y" +#line 538 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 109: -#line 539 "perly.y" +#line 540 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 110: -#line 541 "perly.y" +#line 542 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 111: -#line 543 "perly.y" +#line 544 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 112: -#line 545 "perly.y" +#line 546 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 113: -#line 547 "perly.y" +#line 548 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 114: -#line 549 "perly.y" +#line 550 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 115: -#line 554 "perly.y" +#line 555 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 116: -#line 556 "perly.y" +#line 557 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: -#line 558 "perly.y" +#line 559 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 118: -#line 560 "perly.y" +#line 561 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 119: -#line 562 "perly.y" +#line 563 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 120: -#line 565 "perly.y" +#line 566 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 121: -#line 568 "perly.y" +#line 569 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 122: -#line 571 "perly.y" +#line 572 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 123: -#line 578 "perly.y" +#line 579 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 124: -#line 580 "perly.y" +#line 581 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 125: -#line 582 "perly.y" +#line 583 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 126: -#line 584 "perly.y" +#line 585 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 127: -#line 586 "perly.y" +#line 587 "perly.y" { yyval.opval = newANONATTRSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 128: -#line 592 "perly.y" +#line 593 "perly.y" { yyval.opval = dofile(yyvsp[0].opval); } break; case 129: -#line 594 "perly.y" +#line 595 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 130: -#line 596 "perly.y" +#line 597 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -2196,7 +2197,7 @@ case 130: )),Nullop)); dep();} break; case 131: -#line 604 "perly.y" +#line 605 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -2207,76 +2208,76 @@ case 131: )))); dep();} break; case 132: -#line 613 "perly.y" +#line 614 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 133: -#line 617 "perly.y" +#line 618 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 138: -#line 629 "perly.y" +#line 630 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 139: -#line 631 "perly.y" +#line 632 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 140: -#line 633 "perly.y" +#line 634 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 141: -#line 635 "perly.y" +#line 636 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 142: -#line 637 "perly.y" +#line 638 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 143: -#line 639 "perly.y" +#line 640 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 144: -#line 641 "perly.y" +#line 642 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 145: -#line 643 "perly.y" +#line 644 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 146: -#line 645 "perly.y" +#line 646 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 147: -#line 647 "perly.y" +#line 648 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 148: -#line 649 "perly.y" +#line 650 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 149: -#line 651 "perly.y" +#line 652 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 150: -#line 653 "perly.y" +#line 654 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 151: -#line 655 "perly.y" +#line 656 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 152: -#line 657 "perly.y" +#line 658 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -2284,7 +2285,7 @@ case 152: ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 153: -#line 663 "perly.y" +#line 664 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -2293,179 +2294,179 @@ case 153: PL_expect = XOPERATOR; } break; case 154: -#line 670 "perly.y" +#line 671 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 155: -#line 672 "perly.y" +#line 673 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 156: -#line 674 "perly.y" +#line 675 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 157: -#line 676 "perly.y" +#line 677 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 158: -#line 679 "perly.y" +#line 680 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 159: -#line 682 "perly.y" +#line 683 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 160: -#line 685 "perly.y" +#line 686 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 161: -#line 687 "perly.y" +#line 688 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 162: -#line 689 "perly.y" +#line 690 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 163: -#line 691 "perly.y" +#line 692 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 164: -#line 693 "perly.y" +#line 694 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 165: -#line 695 "perly.y" +#line 696 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 166: -#line 698 "perly.y" +#line 699 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 167: -#line 700 "perly.y" +#line 701 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 168: -#line 702 "perly.y" +#line 703 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[0].opval)); } break; case 169: -#line 705 "perly.y" +#line 706 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 170: -#line 707 "perly.y" +#line 708 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 171: -#line 709 "perly.y" +#line 710 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 172: -#line 711 "perly.y" +#line 712 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 175: -#line 718 "perly.y" +#line 719 "perly.y" { yyval.opval = my_attrs(yyvsp[-1].opval,yyvsp[0].opval); } break; case 176: -#line 720 "perly.y" +#line 721 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 177: -#line 725 "perly.y" +#line 726 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 178: -#line 727 "perly.y" +#line 728 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 179: -#line 729 "perly.y" +#line 730 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 180: -#line 731 "perly.y" +#line 732 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 181: -#line 733 "perly.y" +#line 734 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 182: -#line 738 "perly.y" +#line 739 "perly.y" { yyval.opval = Nullop; } break; case 183: -#line 740 "perly.y" +#line 741 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 184: -#line 744 "perly.y" +#line 745 "perly.y" { yyval.opval = Nullop; } break; case 185: -#line 746 "perly.y" +#line 747 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 186: -#line 748 "perly.y" +#line 749 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 187: -#line 754 "perly.y" +#line 755 "perly.y" { PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 188: -#line 758 "perly.y" +#line 759 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 189: -#line 762 "perly.y" +#line 763 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 190: -#line 766 "perly.y" +#line 767 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 191: -#line 770 "perly.y" +#line 771 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 192: -#line 774 "perly.y" +#line 775 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 193: -#line 778 "perly.y" +#line 779 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 194: -#line 783 "perly.y" +#line 784 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 195: -#line 785 "perly.y" +#line 786 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 196: -#line 787 "perly.y" +#line 788 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 197: -#line 790 "perly.y" +#line 791 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2459 "perly.c" +#line 2460 "perly.c" } yyssp -= yym; yystate = *yyssp; diff --git a/gnu/usr.bin/perl/vms/vms.c b/gnu/usr.bin/perl/vms/vms.c index 0fcd5a5c8b2..ceafe80e0aa 100644 --- a/gnu/usr.bin/perl/vms/vms.c +++ b/gnu/usr.bin/perl/vms/vms.c @@ -235,6 +235,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, retsts = SS$_NOLOGNAM; for (i = 0; environ[i]; i++) { if ((eq = strchr(environ[i],'=')) && + lnmdsc.dsc$w_length == (eq - environ[i]) && !strncmp(environ[i],uplnm,eq - environ[i])) { eq++; for (eqvlen = 0; eq[eqvlen]; eqvlen++) eqv[eqvlen] = eq[eqvlen]; @@ -744,6 +745,11 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec) $DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM"); $DESCRIPTOR(local,"_LOCAL"); + if (!lnm) { + set_errno(EINVAL); set_vaxc_errno(SS$_IVLOGNAM); + return SS$_IVLOGNAM; + } + for (cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) { *cp2 = _toupper(*cp1); if (cp1 - lnm > LNM$C_NAMLENGTH) { @@ -758,8 +764,9 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec) for (curtab = 0; tabvec[curtab]; curtab++) { if (!ivenv && !str$case_blind_compare(tabvec[curtab],&crtlenv)) { int i; - for (i = 0; environ[i]; i++) { /* Iff it's an environ elt, reset */ + for (i = 0; environ[i]; i++) { /* If it's an environ elt, reset */ if ((cp1 = strchr(environ[i],'=')) && + lnmdsc.dsc$w_length == (cp1 - environ[i]) && !strncmp(environ[i],lnm,cp1 - environ[i])) { #ifdef HAS_SETENV return setenv(lnm,"",1) ? vaxc$errno : 0; diff --git a/gnu/usr.bin/perl/vos/config.alpha.h b/gnu/usr.bin/perl/vos/config.alpha.h index 1e74d7cbaa5..748160eeea8 100644 --- a/gnu/usr.bin/perl/vos/config.alpha.h +++ b/gnu/usr.bin/perl/vos/config.alpha.h @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config_h.SH. * - * \$Id: config.alpha.h,v 1.4 2003/12/03 03:02:51 millert Exp $ + * \$Id: config.alpha.h,v 1.5 2004/04/07 21:33:11 millert Exp $ */ /* @@ -1387,8 +1387,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/system/ported/lib/perl5/5.8.2" /**/ -#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.2" /**/ +#define PRIVLIB "/system/ported/lib/perl5/5.8.3" /**/ +#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.3" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1405,8 +1405,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.2/hppa1.1" /**/ -/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.2/hppa1.1" /**/ +/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.3/hppa1.1" /**/ +/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.3/hppa1.1" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1428,8 +1428,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.2" /**/ -#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.2" /**/ +#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.3" /**/ +#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.3" /**/ #define SITELIB_STEM "/system/ported/lib/perl5/site_perl" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.2/hppa1.1 for older + * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.3/hppa1.1 for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /system/ported/lib/perl5/site_perl/5.8.2 for older directories across major versions + * search in /system/ported/lib/perl5/site_perl/5.8.3 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/vos/config.ga.h b/gnu/usr.bin/perl/vos/config.ga.h index c52830e0aa8..3cdf812dd86 100644 --- a/gnu/usr.bin/perl/vos/config.ga.h +++ b/gnu/usr.bin/perl/vos/config.ga.h @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config_h.SH. * - * \$Id: config.ga.h,v 1.4 2003/12/03 03:02:51 millert Exp $ + * \$Id: config.ga.h,v 1.5 2004/04/07 21:33:11 millert Exp $ */ /* @@ -1387,8 +1387,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/system/ported/lib/perl5/5.8.2" /**/ -#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.2" /**/ +#define PRIVLIB "/system/ported/lib/perl5/5.8.3" /**/ +#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.3" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1405,8 +1405,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.2/hppa1.1" /**/ -/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.2/hppa1.1" /**/ +/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.3/hppa1.1" /**/ +/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.3/hppa1.1" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1428,8 +1428,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.2" /**/ -#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.2" /**/ +#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.3" /**/ +#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.3" /**/ #define SITELIB_STEM "/system/ported/lib/perl5/site_perl" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.2/hppa1.1 for older + * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.3/hppa1.1 for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /system/ported/lib/perl5/site_perl/5.8.2 for older directories across major versions + * search in /system/ported/lib/perl5/site_perl/5.8.3 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/win32/Makefile b/gnu/usr.bin/perl/win32/Makefile index 7f902b3baac..37d24994e86 100644 --- a/gnu/usr.bin/perl/win32/Makefile +++ b/gnu/usr.bin/perl/win32/Makefile @@ -32,7 +32,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER = \5.8.2
+#INST_VER = \5.8.3
#
# Comment this out if you DON'T want your perl installation to have
@@ -495,6 +495,9 @@ UTILS = \ ..\utils\enc2xs \
..\utils\piconv \
..\utils\cpan \
+ ..\utils\xsubpp \
+ ..\utils\prove \
+ ..\utils\instmodsh \
..\pod\checkpods \
..\pod\pod2html \
..\pod\pod2latex \
@@ -506,7 +509,6 @@ UTILS = \ ..\x2p\find2perl \
..\x2p\psed \
..\x2p\s2p \
- ..\lib\ExtUtils\xsubpp \
bin\exetype.pl \
bin\runperl.pl \
bin\pl2bat.pl \
@@ -990,53 +992,60 @@ doc: $(PERLEXE) --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML::=|)" \
--libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
+# Note that this next section is parsed (and regenerated) by pod/buildtoc
+# so please check that script before making structural changes here
+
utils: $(PERLEXE) $(X2P)
cd ..\utils
$(MAKE) PERL=$(MINIPERL)
cd ..\pod
- copy ..\README.aix .\perlaix.pod
- copy ..\README.amiga .\perlamiga.pod
- copy ..\README.apollo .\perlapollo.pod
- copy ..\README.beos .\perlbeos.pod
- copy ..\README.bs2000 .\perlbs2000.pod
- copy ..\README.ce .\perlce.pod
- copy ..\README.cn .\perlcn.pod
- copy ..\README.cygwin .\perlcygwin.pod
- copy ..\README.dgux .\perldgux.pod
- copy ..\README.dos .\perldos.pod
- copy ..\README.epoc .\perlepoc.pod
- copy ..\README.freebsd .\perlfreebsd.pod
- copy ..\README.hpux .\perlhpux.pod
- copy ..\README.hurd .\perlhurd.pod
- copy ..\README.irix .\perlirix.pod
- copy ..\README.jp .\perljp.pod
- copy ..\README.ko .\perlko.pod
- copy ..\README.machten .\perlmachten.pod
- copy ..\README.macos .\perlmacos.pod
- copy ..\README.macosx .\perlmacosx.pod
- copy ..\README.mint .\perlmint.pod
- copy ..\README.mpeix .\perlmpeix.pod
- copy ..\README.netware .\perlnetware.pod
- copy ..\README.os2 .\perlos2.pod
- copy ..\README.os390 .\perlos390.pod
- copy ..\README.os400 .\perlos400.pod
- copy ..\README.plan9 .\perlplan9.pod
- copy ..\README.qnx .\perlqnx.pod
- copy ..\README.solaris .\perlsolaris.pod
- copy ..\README.tru64 .\perltru64.pod
- copy ..\README.tw .\perltw.pod
- copy ..\README.uts .\perluts.pod
- copy ..\README.vmesa .\perlvmesa.pod
- copy ..\README.vms .\perlvms.pod
- copy ..\README.vos .\perlvos.pod
- copy ..\README.win32 .\perlwin32.pod
copy ..\vms\perlvms.pod .\perlvms.pod
+ copy ..\README.aix ..\pod\perlaix.pod
+ copy ..\README.amiga ..\pod\perlamiga.pod
+ copy ..\README.apollo ..\pod\perlapollo.pod
+ copy ..\README.beos ..\pod\perlbeos.pod
+ copy ..\README.bs2000 ..\pod\perlbs2000.pod
+ copy ..\README.ce ..\pod\perlce.pod
+ copy ..\README.cn ..\pod\perlcn.pod
+ copy ..\README.cygwin ..\pod\perlcygwin.pod
+ copy ..\README.dgux ..\pod\perldgux.pod
+ copy ..\README.dos ..\pod\perldos.pod
+ copy ..\README.epoc ..\pod\perlepoc.pod
+ copy ..\README.freebsd ..\pod\perlfreebsd.pod
+ copy ..\README.hpux ..\pod\perlhpux.pod
+ copy ..\README.hurd ..\pod\perlhurd.pod
+ copy ..\README.irix ..\pod\perlirix.pod
+ copy ..\README.jp ..\pod\perljp.pod
+ copy ..\README.ko ..\pod\perlko.pod
+ copy ..\README.machten ..\pod\perlmachten.pod
+ copy ..\README.macos ..\pod\perlmacos.pod
+ copy ..\README.macosx ..\pod\perlmacosx.pod
+ copy ..\README.mint ..\pod\perlmint.pod
+ copy ..\README.mpeix ..\pod\perlmpeix.pod
+ copy ..\README.netware ..\pod\perlnetware.pod
+ copy ..\README.os2 ..\pod\perlos2.pod
+ copy ..\README.os390 ..\pod\perlos390.pod
+ copy ..\README.os400 ..\pod\perlos400.pod
+ copy ..\README.plan9 ..\pod\perlplan9.pod
+ copy ..\README.qnx ..\pod\perlqnx.pod
+ copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.tru64 ..\pod\perltru64.pod
+ copy ..\README.tw ..\pod\perltw.pod
+ copy ..\README.uts ..\pod\perluts.pod
+ copy ..\README.vmesa ..\pod\perlvmesa.pod
+ copy ..\README.vms ..\pod\perlvms.pod
+ copy ..\README.vos ..\pod\perlvos.pod
+ copy ..\README.win32 ..\pod\perlwin32.pod
+ copy ..\pod\perl583delta.pod ..\pod\perldelta.pod
$(MAKE) -f ..\win32\pod.mak converters
cd ..\lib
$(PERLEXE) lib_pm.PL
cd ..\win32
$(PERLEXE) $(PL2BAT) $(UTILS)
+# Note that the pod cleanup in this next section is parsed (and regenerated
+# by pod/buildtoc so please check that script before making changes here
+
# the doubled rmdir calls are needed because older cmd shells
# don't understand /q
distclean: clean
@@ -1089,18 +1098,20 @@ distclean: clean cd $(PODDIR)
-del /f *.html *.bat checkpods \
perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \
- perlbs2000.pod perlce.pod perlcygwin.pod perldgux.pod \
- perldos.pod perlepoc.pod perlfreebsd.pod perlhurd.pod \
- perlhpux.pod perlirix.pod perlmachten.pod \
- perlmacos.pod perlmint.pod perlmpeix.pod perlnetware.pod \
+ perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
+ perldelta.pod perldgux.pod perldos.pod perlepoc.pod \
+ perlfreebsd.pod perlhpux.pod perlhurd.pod perlirix.pod \
+ perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
+ perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
- perlqnx.pod perlsolaris.pod perltru64.pod perluts.pod \
- perlvmesa.pod perlvms.pod perlvos.pod \
- perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \
+ perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
+ perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
+ perlwin32.pod \
+ pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
cd ..\utils
-del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs perldoc perlivp \
- dprofpp perlcc libnetcfg enc2xs piconv cpan
+ dprofpp perlcc libnetcfg enc2xs piconv cpan xsubpp instmodsh prove
-del /f *.bat
cd ..\win32
cd ..\x2p
diff --git a/gnu/usr.bin/perl/win32/config.bc b/gnu/usr.bin/perl/win32/config.bc index 6564e53fabe..7613756c4d4 100644 --- a/gnu/usr.bin/perl/win32/config.bc +++ b/gnu/usr.bin/perl/win32/config.bc @@ -451,7 +451,7 @@ d_tmpnam_r='undef' d_truncate='undef' d_ttyname_r='undef' d_tzname='define' -d_u32align='define' +d_u32align='undef' d_ualarm='undef' d_umask='define' d_uname='define' diff --git a/gnu/usr.bin/perl/win32/config.vc b/gnu/usr.bin/perl/win32/config.vc index f9d178436b2..25c2f45f716 100644 --- a/gnu/usr.bin/perl/win32/config.vc +++ b/gnu/usr.bin/perl/win32/config.vc @@ -450,7 +450,7 @@ d_tmpnam_r='undef' d_truncate='undef' d_ttyname_r='undef' d_tzname='define' -d_u32align='define' +d_u32align='undef' d_ualarm='undef' d_umask='define' d_uname='define' diff --git a/gnu/usr.bin/perl/win32/config_H.bc b/gnu/usr.bin/perl/win32/config_H.bc index 5e80e35aa94..6892af670f6 100644 --- a/gnu/usr.bin/perl/win32/config_H.bc +++ b/gnu/usr.bin/perl/win32/config_H.bc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + * $Id: config_H.bc,v 1.6 2003/12/03 03:02:51 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.2\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.2")) /**/ +#define PRIVLIB "c:\\perl\\5.8.3\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.3")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.2\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.2")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.3\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.3")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread for older + * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in c:\\perl\\site\\5.8.2\\lib for older directories across major versions + * search in c:\\perl\\site\\5.8.3\\lib for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/win32/config_H.gc b/gnu/usr.bin/perl/win32/config_H.gc index 1113a31c115..4a0cca5ecd8 100644 --- a/gnu/usr.bin/perl/win32/config_H.gc +++ b/gnu/usr.bin/perl/win32/config_H.gc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + * $Id: config_H.gc,v 1.6 2003/12/03 03:02:51 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.2\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.2")) /**/ +#define PRIVLIB "c:\\perl\\5.8.3\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.3")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.2\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.2")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.3\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.3")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread for older + * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in c:\\perl\\site\\5.8.2\\lib for older directories across major versions + * search in c:\\perl\\site\\5.8.3\\lib for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/win32/config_H.vc b/gnu/usr.bin/perl/win32/config_H.vc index d0df3de3533..12933dc9e2e 100644 --- a/gnu/usr.bin/perl/win32/config_H.vc +++ b/gnu/usr.bin/perl/win32/config_H.vc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ + * $Id: config_H.vc,v 1.6 2003/12/03 03:02:52 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.2\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.3\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.2\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.2")) /**/ +#define PRIVLIB "c:\\perl\\5.8.3\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.3")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.2\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.2")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.3\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.3")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.2\\lib\\MSWin32-x86-multi-thread for older + * lib/lib.pm will automatically search in c:\\perl\\site\\5.8.3\\lib\\MSWin32-x86-multi-thread for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in c:\\perl\\site\\5.8.2\\lib for older directories across major versions + * search in c:\\perl\\site\\5.8.3\\lib for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/win32/makefile.mk b/gnu/usr.bin/perl/win32/makefile.mk index 6e3e5f22383..060ba4e2375 100644 --- a/gnu/usr.bin/perl/win32/makefile.mk +++ b/gnu/usr.bin/perl/win32/makefile.mk @@ -34,7 +34,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER *= \5.8.2
+INST_VER *= \5.8.3
#
# Comment this out if you DON'T want your perl installation to have
@@ -397,7 +397,7 @@ LINK_FLAGS += -L"$(CCLIBDIR)\Release" .ELIF "$(CCTYPE)" == "GCC"
CC = gcc
-LINK32 = gcc
+LINK32 = g++
.IF "$(USE_GCC_V3_2)" == "define"
LINK32 = g++
.END
@@ -611,6 +611,9 @@ UTILS = \ ..\utils\enc2xs \
..\utils\piconv \
..\utils\cpan \
+ ..\utils\xsubpp \
+ ..\utils\prove \
+ ..\utils\instmodsh \
..\pod\checkpods \
..\pod\pod2html \
..\pod\pod2latex \
@@ -622,7 +625,6 @@ UTILS = \ ..\x2p\find2perl \
..\x2p\psed \
..\x2p\s2p \
- ..\lib\ExtUtils\xsubpp \
bin\exetype.pl \
bin\runperl.pl \
bin\pl2bat.pl \
@@ -1123,49 +1125,55 @@ doc: $(PERLEXE) --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML:s,:,|,)"\
--libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
+# Note that this next section is parsed (and regenerated) by pod/buildtoc
+# so please check that script before making structural changes here
utils: $(PERLEXE) $(X2P)
cd ..\utils && $(MAKE) PERL=$(MINIPERL)
- copy ..\README.aix .\perlaix.pod
- copy ..\README.amiga .\perlamiga.pod
- copy ..\README.apollo .\perlapollo.pod
- copy ..\README.beos .\perlbeos.pod
- copy ..\README.bs2000 .\perlbs2000.pod
- copy ..\README.ce .\perlce.pod
- copy ..\README.cn .\perlcn.pod
- copy ..\README.cygwin .\perlcygwin.pod
- copy ..\README.dgux .\perldgux.pod
- copy ..\README.dos .\perldos.pod
- copy ..\README.epoc .\perlepoc.pod
- copy ..\README.freebsd .\perlfreebsd.pod
- copy ..\README.hpux .\perlhpux.pod
- copy ..\README.hurd .\perlhurd.pod
- copy ..\README.irix .\perlirix.pod
- copy ..\README.jp .\perljp.pod
- copy ..\README.ko .\perlko.pod
- copy ..\README.machten .\perlmachten.pod
- copy ..\README.macos .\perlmacos.pod
- copy ..\README.macosx .\perlmacosx.pod
- copy ..\README.mint .\perlmint.pod
- copy ..\README.mpeix .\perlmpeix.pod
- copy ..\README.netware .\perlnetware.pod
- copy ..\README.os2 .\perlos2.pod
- copy ..\README.os390 .\perlos390.pod
- copy ..\README.os400 .\perlos400.pod
- copy ..\README.plan9 .\perlplan9.pod
- copy ..\README.qnx .\perlqnx.pod
- copy ..\README.solaris .\perlsolaris.pod
- copy ..\README.tru64 .\perltru64.pod
- copy ..\README.tw .\perltw.pod
- copy ..\README.uts .\perluts.pod
- copy ..\README.vmesa .\perlvmesa.pod
- copy ..\README.vms .\perlvms.pod
- copy ..\README.vos .\perlvos.pod
- copy ..\README.win32 .\perlwin32.pod
copy ..\vms\perlvms.pod ..\pod\perlvms.pod
+ copy ..\README.aix ..\pod\perlaix.pod
+ copy ..\README.amiga ..\pod\perlamiga.pod
+ copy ..\README.apollo ..\pod\perlapollo.pod
+ copy ..\README.beos ..\pod\perlbeos.pod
+ copy ..\README.bs2000 ..\pod\perlbs2000.pod
+ copy ..\README.ce ..\pod\perlce.pod
+ copy ..\README.cn ..\pod\perlcn.pod
+ copy ..\README.cygwin ..\pod\perlcygwin.pod
+ copy ..\README.dgux ..\pod\perldgux.pod
+ copy ..\README.dos ..\pod\perldos.pod
+ copy ..\README.epoc ..\pod\perlepoc.pod
+ copy ..\README.freebsd ..\pod\perlfreebsd.pod
+ copy ..\README.hpux ..\pod\perlhpux.pod
+ copy ..\README.hurd ..\pod\perlhurd.pod
+ copy ..\README.irix ..\pod\perlirix.pod
+ copy ..\README.jp ..\pod\perljp.pod
+ copy ..\README.ko ..\pod\perlko.pod
+ copy ..\README.machten ..\pod\perlmachten.pod
+ copy ..\README.macos ..\pod\perlmacos.pod
+ copy ..\README.macosx ..\pod\perlmacosx.pod
+ copy ..\README.mint ..\pod\perlmint.pod
+ copy ..\README.mpeix ..\pod\perlmpeix.pod
+ copy ..\README.netware ..\pod\perlnetware.pod
+ copy ..\README.os2 ..\pod\perlos2.pod
+ copy ..\README.os390 ..\pod\perlos390.pod
+ copy ..\README.os400 ..\pod\perlos400.pod
+ copy ..\README.plan9 ..\pod\perlplan9.pod
+ copy ..\README.qnx ..\pod\perlqnx.pod
+ copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.tru64 ..\pod\perltru64.pod
+ copy ..\README.tw ..\pod\perltw.pod
+ copy ..\README.uts ..\pod\perluts.pod
+ copy ..\README.vmesa ..\pod\perlvmesa.pod
+ copy ..\README.vms ..\pod\perlvms.pod
+ copy ..\README.vos ..\pod\perlvos.pod
+ copy ..\README.win32 ..\pod\perlwin32.pod
+ copy ..\pod\perl583delta.pod ..\pod\perldelta.pod
cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters
cd ..\lib && $(PERLEXE) lib_pm.PL
$(PERLEXE) $(PL2BAT) $(UTILS)
+# Note that the pod cleanup in this next section is parsed (and regenerated
+# by pod/buildtoc so please check that script before making changes here
+
distclean: clean
-del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
$(PERLIMPLIB) ..\miniperl$(a) $(MINIMOD)
@@ -1211,17 +1219,19 @@ distclean: clean -cd $(PODDIR) && del /f *.html *.bat checkpods \
perlaix.pod perlamiga.pod perlapollo.pod perlbeos.pod \
perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
- perldgux.pod perldos.pod perlepoc.pod perlfreebsd.pod \
- perlhpux.pod perlhurd.pod perlirix.pod perljp.pod perlko.pod \
- perlmachten.pod perlmacos.pod perlmacosx.pod perlmint.pod \
- perlmpeix.pod perlnetware.pod perlos2.pod perlos390.pod \
- perlos400.pod perlplan9.pod perlqnx.pod perlsolaris.pod \
- perltru64.pod perltw.pod perluts.pod perlvmesa.pod perlvms.pod \
- perlvms.pod perlvos.pod perlwin32.pod \
+ perldelta.pod perldgux.pod perldos.pod perlepoc.pod \
+ perlfreebsd.pod perlhpux.pod perlhurd.pod perlirix.pod \
+ perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
+ perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
+ perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
+ perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
+ perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
+ perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
- perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat
+ perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat \
+ xsubpp instmodsh prove
-cd ..\x2p && del /f find2perl s2p psed *.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
diff --git a/gnu/usr.bin/perl/win32/pod.mak b/gnu/usr.bin/perl/win32/pod.mak index 2b4a86e6bcc..39a91fc20b2 100644 --- a/gnu/usr.bin/perl/win32/pod.mak +++ b/gnu/usr.bin/perl/win32/pod.mak @@ -25,6 +25,8 @@ POD = \ perl572delta.pod \ perl573delta.pod \ perl581delta.pod \ + perl582delta.pod \ + perl583delta.pod \ perl58delta.pod \ perlapi.pod \ perlapio.pod \ @@ -122,6 +124,8 @@ MAN = \ perl572delta.man \ perl573delta.man \ perl581delta.man \ + perl582delta.man \ + perl583delta.man \ perl58delta.man \ perlapi.man \ perlapio.man \ @@ -219,6 +223,8 @@ HTML = \ perl572delta.html \ perl573delta.html \ perl581delta.html \ + perl582delta.html \ + perl583delta.html \ perl58delta.html \ perlapi.html \ perlapio.html \ @@ -316,6 +322,8 @@ TEX = \ perl572delta.tex \ perl573delta.tex \ perl581delta.tex \ + perl582delta.tex \ + perl583delta.tex \ perl58delta.tex \ perlapi.tex \ perlapio.tex \ diff --git a/gnu/usr.bin/perl/win32/win32.c b/gnu/usr.bin/perl/win32/win32.c index c6683e4b7be..d532ee995ad 100644 --- a/gnu/usr.bin/perl/win32/win32.c +++ b/gnu/usr.bin/perl/win32/win32.c @@ -3130,7 +3130,7 @@ win32_chsize(int fd, Off_t size) do { count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend; count = win32_write(fd, b, count); - if (count < 0) { + if ((int)count < 0) { retval = -1; break; } diff --git a/gnu/usr.bin/perl/x2p/find2perl.PL b/gnu/usr.bin/perl/x2p/find2perl.PL index 94cf2423064..679ca3c05c7 100644 --- a/gnu/usr.bin/perl/x2p/find2perl.PL +++ b/gnu/usr.bin/perl/x2p/find2perl.PL @@ -80,6 +80,7 @@ my $out = ''; my $declaresubs = "sub wanted;\n"; my %init = (); my ($follow_in_effect,$Skip_And) = (0,0); +my $print_needed = 1; while (@ARGV) { $_ = shift; @@ -117,8 +118,10 @@ while (@ARGV) { $out .= tab . "-$filetest _"; } elsif ($_ eq 'print') { $out .= tab . 'print("$name\n")'; + $print_needed = 0; } elsif ($_ eq 'print0') { $out .= tab . 'print("$name\0")'; + $print_needed = 0; } elsif ($_ eq 'fstype') { my $type = shift; $out .= tab; @@ -183,6 +186,7 @@ while (@ARGV) { $declaresubs .= "sub doexec (\$\@);\n"; $init{doexec} = 1; } + $print_needed = 0; } elsif ($_ eq 'ok') { my @cmd = (); while (@ARGV && $ARGV[0] ne ';') @@ -194,6 +198,7 @@ while (@ARGV) { { local $" = "','"; $out .= "doexec(1, '@cmd')"; } $declaresubs .= "sub doexec (\$\@);\n"; $init{doexec} = 1; + $print_needed = 0; } elsif ($_ eq 'prune') { $out .= tab . '($File::Find::prune = 1)'; } elsif ($_ eq 'xdev') { @@ -217,6 +222,7 @@ while (@ARGV) { $out .= tab . "ls"; $declaresubs .= "sub ls ();\n"; $init{ls} = 1; + $print_needed = 0; } elsif ($_ eq 'tar') { die "-tar must have a filename argument\n" unless @ARGV; my $file = shift; @@ -258,6 +264,10 @@ while (@ARGV) { } } +if ($print_needed) { + $out .= "\n" . tab . '&& print("$name\n")'; +} + print <<"END"; $startperl @@ -833,7 +843,9 @@ True if last-modified time of file matches N. =item C<-print> -Print out path of file (always true). +Print out path of file (always true). If none of C<-exec>, C<-ls>, +C<-print0>, or C<-ok> is specified, then C<-print> will be added +implicitly. =item C<-print0> |