# # This patch takes you from Perl 5.005_01 to 5.005_02. # # To apply, chdir to a clean perl5.005_01 source directory # and do: # # patch -p1 -N < this_file # touch Porting/fixCORE touch README.os390 touch ebcdic.c touch win32/des_fcrypt.patch exit Index: patchlevel.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/patchlevel.h Sun Jul 26 17:15:21 1998 --- perl5.005_02/patchlevel.h Fri Aug 7 23:44:26 1998 *************** *** 1,6 **** #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 5 ! #define SUBVERSION 1 /* local_patches -- list of locally applied less-than-subversion patches. --- 1,7 ---- #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 5 ! #undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */ ! #define SUBVERSION 2 /* local_patches -- list of locally applied less-than-subversion patches. Index: Changes ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/Changes Sun Jul 26 19:27:56 1998 --- perl5.005_02/Changes Fri Aug 7 23:54:42 1998 *************** *** 74,79 **** --- 74,726 ---- ---------------- + Version 5.005_02 Second maintenance release of 5.005 + ---------------- + + ____________________________________________________________________________ + [ 1758] By: gsar on 1998/08/08 03:45:04 + Log: set patchlevel.h, other minor tweaks + Branch: maint-5.005/perl + ! Changes patchlevel.h pod/perlhist.pod pod/perlport.pod + ____________________________________________________________________________ + [ 1757] By: gsar on 1998/08/08 03:33:33 + Log: prevent lexical leaks from Benchmark into target code (inspired by + an attempt by John Allen) + Branch: maint-5.005/perl + ! lib/Benchmark.pm + ____________________________________________________________________________ + [ 1755] By: gsar on 1998/08/07 23:58:33 + Log: temporary opcode.pl workaround for ebcdic (suggested by + David J. Fiander and M.J.T. Guy) + Branch: maint-5.005/perl + ! opcode.pl + ____________________________________________________________________________ + [ 1754] By: gsar on 1998/08/07 22:21:10 + Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Date: Fri, 7 Aug 1998 09:56:01 +0100 (BST) + Message-Id: <9808070856.AA28065@claudius.bfsec.bt.co.uk> + Subject: [PATCH 5.005_50 & 5.005_02] Fix for command line use of source filters + Branch: maint-5.005/perl + ! perl.c + ____________________________________________________________________________ + [ 1753] By: gsar on 1998/08/07 22:19:42 + Log: perlport.pod notes from Jarkko Hietaniemi; utime() note for Win32 + Branch: maint-5.005/perl + ! pod/perlport.pod + ____________________________________________________________________________ + [ 1752] By: gsar on 1998/08/07 22:08:29 + Log: perlport.pod v1.33 from Chris Nandor + Branch: maint-5.005/perl + ! pod/perlport.pod + ____________________________________________________________________________ + [ 1751] By: gsar on 1998/08/07 22:01:04 + Log: From: Ilya Zakharevich + Date: Thu, 6 Aug 1998 19:44:16 -0400 (EDT) + Message-Id: <199808062344.TAA09505@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Minor cleanup of RE tests and docs + Branch: maint-5.005/perl + ! pod/perlre.pod t/op/regexp.t + ____________________________________________________________________________ + [ 1750] By: gsar on 1998/08/07 21:51:52 + Log: allow more compatible interpretation of spaces File::DosGlob::glob() + patterns + Branch: maint-5.005/perl + ! lib/File/DosGlob.pm + ____________________________________________________________________________ + [ 1749] By: gsar on 1998/08/07 21:36:04 + Log: don't use © in Test.pm (suggested by M.J.T. Guy) + Branch: maint-5.005/perl + ! lib/Test.pm + ____________________________________________________________________________ + [ 1748] By: gsar on 1998/08/07 21:31:46 + Log: From: Dominic Dunlop + Date: Thu, 6 Aug 1998 12:38:07 +0000 + Message-Id: + Subject: [Patch perl5.005_02-TRIAL2] Update hints, Configure for MachTen 4.1.1 + Branch: maint-5.005/perl + ! Configure hints/machten.sh + ____________________________________________________________________________ + [ 1746] By: gsar on 1998/08/05 22:55:59 + Log: MM_Win32.pm and Liblist.pm tweaks + Branch: maint-5.005/perl + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + ____________________________________________________________________________ + [ 1745] By: gsar on 1998/08/05 21:57:00 + Log: pod/perlfaq* update from Tom Christiansen + Branch: maint-5.005/perl + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq8.pod + ____________________________________________________________________________ + [ 1744] By: gsar on 1998/08/05 21:53:30 + Log: From: Chris Nandor + Date: Wed, 5 Aug 1998 15:38:48 -0400 + Message-Id: + Subject: [PATCH] perlport 1.32 + Branch: maint-5.005/perl + ! pod/perlport.pod + ____________________________________________________________________________ + [ 1743] By: gsar on 1998/08/05 21:52:05 + Log: README.os2 update + From: Ilya Zakharevich + Date: Wed, 5 Aug 1998 05:44:46 -0400 (EDT) + Message-Id: <199808050944.FAA09053@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Additional OS/2 tweaks: docs, tests + Branch: maint-5.005/perl + ! README.os2 t/lib/posix.t t/op/exec.t + ____________________________________________________________________________ + [ 1742] By: gsar on 1998/08/05 21:50:07 + Log: additional INSTALL notes from Jarkko Hietaniemi + on semget failure in t/lib/ipc_sysv.t + Branch: maint-5.005/perl + ! INSTALL + ____________________________________________________________________________ + [ 1741] By: gsar on 1998/08/05 21:46:13 + Log: correct URL for perlcrt.dll + Branch: maint-5.005/perl + ! Changes win32/Makefile win32/makefile.mk + ____________________________________________________________________________ + [ 1740] By: gsar on 1998/08/05 10:05:46 + Log: update Changes, patchlevel, tweak Liblist.pm + Branch: maint-5.005/perl + ! Changes lib/ExtUtils/Liblist.pm patchlevel.h + ____________________________________________________________________________ + [ 1739] By: gsar on 1998/08/05 09:10:45 + Log: newer cperl-mode.el + From: Ilya Zakharevich + Date: Wed, 5 Aug 1998 03:50:16 -0400 (EDT) + Message-Id: <199808050750.DAA07240@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] CPerl update + Branch: maint-5.005/perl + ! emacs/cperl-mode.el + ____________________________________________________________________________ + [ 1738] By: gsar on 1998/08/05 09:08:33 + Log: support :nosearch in ExtUtils::Liblist for win32, and make -lfoo + processing (somewhat) compiler-specific + Branch: maint-5.005/perl + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + ____________________________________________________________________________ + [ 1737] By: gsar on 1998/08/05 03:20:03 + Log: add index entries for -X + From: Ilya Zakharevich + Date: Sun, 02 Aug 1998 16:33:18 EDT + Message-Id: <199808022033.QAA18778@monk.mps.ohio-state.edu> + Subject: [PATCH] A missing docu patch + Branch: maint-5.005/perl + ! pod/perlfunc.pod + ____________________________________________________________________________ + [ 1736] By: gsar on 1998/08/05 03:09:58 + Log: make Test::Harness optionally check for stray files when running tests + From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 18:12:48 -0400 (EDT) + Message-Id: <199808022212.SAA20126@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] File leaked from test suite + Branch: maint-5.005/perl + ! lib/Test/Harness.pm + ____________________________________________________________________________ + [ 1735] By: gsar on 1998/08/05 02:29:46 + Log: back out change#1703 that break bincompat with PERL_OBJECT and + MULTIPLICITY + Branch: maint-5.005/perl + ! ext/re/re.pm regcomp.c regexec.c thrdvar.h + ____________________________________________________________________________ + [ 1734] By: gsar on 1998/08/05 02:23:47 + Log: fixes to enable ISC to build IPC/SysV + From: Jarkko Hietaniemi + Date: 05 Aug 1998 00:59:13 +0300 + Message-ID: + Subject: [PATCH] 5.005_02-TRIAL1: (Re: Bug in pp_rename and ISC hint) + Branch: maint-5.005/perl + ! ext/IPC/SysV/SysV.xs hints/isc.sh hints/isc_2.sh + ____________________________________________________________________________ + [ 1733] By: gsar on 1998/08/05 01:20:29 + Log: let some 'tr' be '$tr' for occult reasons + From: Jeff Okamoto + Date: Mon, 3 Aug 1998 11:04:30 -0700 (PDT) + Message-Id: <199808031804.LAA25595@xfiles.intercon.hp.com> + Subject: PATCH: Configure uses tr, not $tr + Branch: maint-5.005/perl + ! Configure + ____________________________________________________________________________ + [ 1732] By: gsar on 1998/08/05 01:16:40 + Log: perlre.pod tweak suggested by Mike Wescott + Branch: maint-5.005/perl + ! pod/perlre.pod + ____________________________________________________________________________ + [ 1731] By: gsar on 1998/08/05 01:10:41 + Log: explain caveat about use of numeric constants in podoc for sysopen() + From: "David J. Fiander" + Date: Tue, 4 Aug 1998 13:09:58 -0400 + Message-Id: <199808041709.NAA01750@mks.com> + Subject: Re: [PATCH] 5.005_01: OE MVS + Branch: maint-5.005/perl + ! pod/perlfunc.pod + ____________________________________________________________________________ + [ 1730] By: gsar on 1998/08/05 00:46:53 + Log: end pod processing when source file is closed (prevents it carrying + over into require()d files) + Branch: maint-5.005/perl + ! t/comp/require.t toke.c + ____________________________________________________________________________ + [ 1729] By: gsar on 1998/08/04 23:03:23 + Log: correct prototype for des_fcrypt(), explain how to add it in more + detail, and supply a patch for libdes-3.06 + Branch: maint-5.005/perl + + win32/des_fcrypt.patch + ! MANIFEST README.win32 win32/Makefile win32/makefile.mk + ! win32/win32.c + ____________________________________________________________________________ + [ 1728] By: gsar on 1998/08/04 21:50:40 + Log: tweak to avoid ambiguity warnings + Branch: maint-5.005/perl + ! pp.c + ____________________________________________________________________________ + [ 1727] By: gsar on 1998/08/04 20:31:04 + Log: remove useless 'rcsid' (extension of a suggestion by + Stephen McCamant) + Branch: maint-5.005/perl + ! embed.h ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.c + ! global.sym gv.c perl.c vms/gen_shrfls.pl + ____________________________________________________________________________ + [ 1726] By: gsar on 1998/08/04 19:52:43 + Log: correct Pod::Html's notion of email addresses + From: abigail@fnx.com + Date: Mon, 3 Aug 1998 20:22:49 -0400 (EDT) + Message-ID: <19980804002249.2011.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.005_01] lib/Pod/Html.pm + Branch: maint-5.005/perl + ! lib/Pod/Html.pm + ____________________________________________________________________________ + [ 1725] By: gsar on 1998/08/04 19:50:06 + Log: perlport.pod additions from Peter Prymmer + Date: Mon, 3 Aug 98 15:31:35 PDT + Message-Id: <9808032231.AA22324@forte.com> + -- + Date: Tue, 4 Aug 98 12:44:20 PDT + Message-Id: <9808041944.AA04815@forte.com> + Branch: maint-5.005/perl + ! pod/perlport.pod + ____________________________________________________________________________ + [ 1724] By: gsar on 1998/08/04 18:08:07 + Log: From: Chris Nandor + Date: Mon, 3 Aug 1998 13:35:25 -0400 + Message-Id: + Subject: [PATCH] perlport 1.30 + Branch: maint-5.005/perl + ! pod/perlport.pod + ____________________________________________________________________________ + [ 1723] By: gsar on 1998/08/04 18:06:13 + Log: update postscript generator + From: Tom Christiansen + Date: Mon, 3 Aug 1998 05:29:25 -0600 + Message-Id: <199808031129.FAA24985@chthon.perl.com> + Subject: PATCH: pod/roffitall (5.005_02) + Branch: maint-5.005/perl + ! pod/roffitall + ____________________________________________________________________________ + [ 1722] By: gsar on 1998/08/03 17:01:12 + Log: applied suggested patch, slightly tweaked + From: Jarkko Hietaniemi + Date: Mon, 3 Aug 1998 11:52:30 +0300 (EET DST) + Message-Id: <199808030852.LAA14153@alpha.hut.fi> + Subject: [PATCH] perl5.005_02-TRIAL1: pod/perlhist.pod + Branch: maint-5.005/perl + ! pod/perlhist.pod + ____________________________________________________________________________ + [ 1721] By: gsar on 1998/08/03 16:30:20 + Log: fix segfault when threadsv is used as foreach itervar + From: Stephen McCamant + Date: Sun, 02 Aug 1998 21:44:34 CDT + Message-Id: <13765.8641.997452.14516@alias-2.pr.mcs.net> + Subject: [PATCH] threadsv index in enteriter targ in op_free() + Branch: maint-5.005/perl + ! op.c + ____________________________________________________________________________ + [ 1720] By: gsar on 1998/08/02 23:33:42 + Log: close() open files before unlink() + From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 18:14:22 -0400 (EDT) + Message-Id: <199808022214.SAA20135@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] File leaked from test suite - tests + Branch: maint-5.005/perl + ! t/base/rs.t t/op/defins.t + ____________________________________________________________________________ + [ 1719] By: gsar on 1998/08/02 23:31:51 + Log: more pack() tests + From: Jarkko Hietaniemi + Date: Mon, 3 Aug 1998 00:59:41 +0300 (EET DST) + Message-Id: <199808022159.AAA17160@alpha.hut.fi> + Subject: Re: uudecode 'u' problem + Branch: maint-5.005/perl + ! t/op/pack.t + ____________________________________________________________________________ + [ 1718] By: gsar on 1998/08/02 23:26:51 + Log: t/TEST aesthetic tweak suggested by Jarkko + Branch: maint-5.005/perl + ! t/TEST + ____________________________________________________________________________ + [ 1717] By: gsar on 1998/08/02 23:23:43 + Log: add Digital Unix 3.x notes to README.threads (as suggested by + Phoenix ) + Branch: maint-5.005/perl + ! README.threads + ____________________________________________________________________________ + [ 1716] By: gsar on 1998/08/02 23:15:00 + Log: allow *FOO{BAR}[0] etc. (without intervening arrow) + From: Stephen McCamant + Date: Sun, 2 Aug 1998 16:16:50 -0500 (CDT) + Message-ID: <13764.54929.60137.104838@alias-2.pr.mcs.net> + Subject: [PATCH] Re: Minor nit in glob notation + Branch: maint-5.005/perl + ! Changes op.c + ____________________________________________________________________________ + [ 1715] By: gsar on 1998/08/02 22:49:53 + Log: fix unpack('u',...) problem with spaces in input + Branch: maint-5.005/perl + ! pp.c t/op/pack.t + ____________________________________________________________________________ + [ 1714] By: gsar on 1998/08/02 21:27:19 + Log: update location of perlcrt.dll for win32 builds + Branch: maint-5.005/perl + ! win32/Makefile win32/makefile.mk + ____________________________________________________________________________ + [ 1713] By: gsar on 1998/08/02 09:28:32 + Log: From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 04:35:11 -0400 (EDT) + Message-Id: <199808020835.EAA09367@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Better debugging output from malloc.c + Branch: maint-5.005/perl + ! malloc.c + ____________________________________________________________________________ + [ 1712] By: gsar on 1998/08/02 09:16:55 + Log: fix longstanding bug in pack('u',...) (reads garbage beyond the end + of the input string) + Branch: maint-5.005/perl + ! pp.c + ____________________________________________________________________________ + [ 1711] By: gsar on 1998/08/02 08:14:25 + Log: update Changes, tweak Porting/makerel + Branch: maint-5.005/perl + ! Changes Porting/makerel + ____________________________________________________________________________ + [ 1710] By: gsar on 1998/08/02 07:31:37 + Log: remove CRs from djgpp/configure.bat (Porting/makerel adds them) + Branch: maint-5.005/perl + ! djgpp/configure.bat + ____________________________________________________________________________ + [ 1709] By: gsar on 1998/08/02 07:27:34 + Log: Porting/makerel tweaks + Branch: maint-5.005/perl + ! Porting/makerel + ____________________________________________________________________________ + [ 1708] By: gsar on 1998/08/02 07:09:35 + Log: fixes for pod noises + Branch: maint-5.005/perl + ! ext/B/B/Bytecode.pm ext/Thread/Thread/Specific.pm + ! pod/perlembed.pod pod/perlfaq.pod + ____________________________________________________________________________ + [ 1707] By: gsar on 1998/08/02 06:59:47 + Log: malloc.c tweaks + From: Ilya Zakharevich + Date: Sat, 01 Aug 1998 18:46:32 EDT + Message-Id: <199808012246.SAA00699@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Better malloc.c + Branch: maint-5.005/perl + ! malloc.c + ____________________________________________________________________________ + [ 1706] By: gsar on 1998/08/02 06:56:37 + Log: fix quoting of keys with embedded nulls + From: Slaven Rezic + Date: Sat, 01 Aug 1998 13:38:03 +0200 + Message-Id: <199808011138.NAA05189@mail.cs.tu-berlin.de> + Subject: Data::Dumper 2.09, patch + Branch: maint-5.005/perl + ! ext/Data/Dumper/Dumper.xs + ____________________________________________________________________________ + [ 1705] By: gsar on 1998/08/02 06:50:07 + Log: From: pvhp@forte.com (Peter Prymmer) + Date: Fri, 31 Jul 1998 14:50:41 PDT + Message-Id: <9807312150.AA08867@forte.com> + Subject: Re: \Q doesn't work in interpolated regular expressions + Branch: maint-5.005/perl + ! pod/perlre.pod + ____________________________________________________________________________ + [ 1704] By: gsar on 1998/08/02 06:37:06 + Log: add test for magic autovivification + From: "M.J.T. Guy" + Date: Thu, 30 Jul 1998 12:18:15 +0100 + Message-Id: + Subject: Re: Perl5.005_01 failing to autovivify subroutine args + Branch: maint-5.005/perl + ! pod/perldiag.pod t/cmd/subval.t + ____________________________________________________________________________ + [ 1703] By: gsar on 1998/08/02 06:26:57 + Log: From: Ilya Zakharevich + Date: Tue, 21 Jul 1998 23:58:53 -0400 (EDT) + Message-Id: <199807220358.XAA19811@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_76] better RE colors + Branch: maint-5.005/perl + ! ext/re/re.pm regcomp.c regexec.c thrdvar.h + ____________________________________________________________________________ + [ 1702] By: gsar on 1998/08/02 06:22:15 + Log: mark link type of exported functions for OS/2 + From: Ilya Zakharevich + Date: Sun, 26 Jul 1998 21:03:03 -0400 (EDT) + Message-Id: <199807270103.VAA04977@monk.mps.ohio-state.edu> + Subject: Re: Compiler linkage's types [PATCH 5.005] + Branch: maint-5.005/perl + ! os2/os2ish.h proto.h + ____________________________________________________________________________ + [ 1701] By: gsar on 1998/08/02 06:16:03 + Log: tweaked version of suggested patch + From: Ilya Zakharevich + Date: Mon, 20 Jul 1998 21:40:00 -0400 (EDT) + Message-Id: <199807210140.VAA17186@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_75] Enable -DS + Branch: maint-5.005/perl + ! README.threads ext/Thread/Thread.xs ext/Thread/typemap mg.c + ! op.c perl.c perl.h pod/perlrun.pod pp.c pp_hot.c scope.c + ! thread.h util.c win32/win32thread.c + ____________________________________________________________________________ + [ 1700] By: gsar on 1998/08/02 05:54:00 + Log: up patchlevel to 5.005_02 + Branch: maint-5.005/perl + ! Changes patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk + ____________________________________________________________________________ + [ 1699] By: gsar on 1998/08/02 05:50:01 + Log: From: Ilya Zakharevich + Message-Id: <199807180809.EAA09379@monk.mps.ohio-state.edu> + Date: Sat, 18 Jul 1998 04:09:26 -0400 (EDT) + Subject: [PATCH 5.004_72] Make tests succeed on OS/2 + Branch: maint-5.005/perl + ! t/io/fs.t t/lib/io_pipe.t t/lib/io_sock.t t/op/stat.t + ____________________________________________________________________________ + [ 1698] By: gsar on 1998/08/02 05:41:41 + Log: use I32_MAX as the limit when U16_MAX > I32_MAX (for CRAY) + Branch: maint-5.005/perl + ! regcomp.c + ____________________________________________________________________________ + [ 1697] By: gsar on 1998/08/02 05:20:12 + Log: support OE/MVS + From: Jarkko Hietaniemi + Message-Id: <199808010903.MAA09371@alpha.hut.fi> + Date: Sat, 1 Aug 1998 12:03:02 +0300 (EET DST) + Subject: [PATCH] 5.005_01: OE MVS + Branch: maint-5.005/perl + + README.os390 ebcdic.c + ! Configure MANIFEST doio.c ext/Errno/Errno_pm.PL gv.c handy.h + ! hints/os390.sh lib/bigint.pl mg.c patchlevel.h perl.c perl.h + ! perly.c perly.h perly.y perly_c.diff pod/perldelta.pod + ! pod/perlport.pod pp.c pp_ctl.c pp_hot.c pp_sys.c sv.c + ! t/base/term.t t/comp/package.t t/comp/require.t + ! t/lib/bigintpm.t t/lib/cgi-html.t t/lib/filehand.t t/lib/ph.t + ! t/op/auto.t t/op/bop.t t/op/each.t t/op/magic.t t/op/misc.t + ! t/op/ord.t t/op/pack.t t/op/quotemeta.t t/op/re_tests + ! t/op/regexp.t t/op/sort.t t/op/sprintf.t t/op/subst.t + ! t/op/taint.t t/op/universal.t t/pragma/constant.t + ! t/pragma/overload.t t/pragma/subs.t toke.c x2p/a2p.h + ! x2p/a2py.c + ____________________________________________________________________________ + [ 1696] By: gsar on 1998/08/02 05:03:09 + Log: VMS patches + From: pvhp@forte.com (Peter Prymmer) + Message-Id: <9807290017.AA01833@forte.com> + Date: Tue, 28 Jul 98 17:17:33 PDT + Subject: Re: Not OK: perl 5.00501 on VMS_AXP-thread I7.2 + -- + From: Dan Sugalski + Message-Id: <3.0.5.32.19980729125623.00b562b0@ous.edu> + Date: Wed, 29 Jul 1998 12:56:23 -0700 + Subject: [PATCH 5.005_01]Typo in CONFIGURE.COM (vms) + -- + From: Dan Sugalski + Date: Thu, 30 Jul 1998 09:02:24 -0700 + Message-Id: <3.0.5.32.19980730090224.00b70eb0@ous.edu> + Subject: [PATCH 5.005_01]VMS config SOCKETSHR typo patch and fcntl check + Branch: maint-5.005/perl + ! configure.com vms/subconfigure.com + ____________________________________________________________________________ + [ 1695] By: gsar on 1998/08/02 04:49:32 + Log: rename duplicate warning in regexec.c + Branch: maint-5.005/perl + ! regexec.c + ____________________________________________________________________________ + [ 1694] By: gsar on 1998/08/02 04:44:20 + Log: beware egcs' ld on Solaris + From: Tom Spindler + Message-ID: <19980801212158.A2934@home.merit.edu> + Date: Sat, 1 Aug 1998 21:21:58 -0400 + Subject: Re: [PATCH perl5.005_01] hints/solaris_2.sh, egcs, and ld + Branch: maint-5.005/perl + ! hints/solaris_2.sh + ____________________________________________________________________________ + [ 1693] By: gsar on 1998/08/02 04:41:43 + Log: de-utf-ized variation of Ilya's patch + From: Jan-Pieter Cornet + Date: 31 Jul 1998 12:44:57 +0200 + Message-ID: <6ps779$hmj$1@xs1.xs4all.nl> + Subject: Re: s/\s*$//g in majordomo causes segfault under 5.005_01 + Branch: maint-5.005/perl + ! regexec.c + ____________________________________________________________________________ + [ 1692] By: gsar on 1998/08/02 04:39:14 + Log: better validation of SysV IPC availability + From: Jarkko Hietaniemi + Date: Fri, 31 Jul 1998 13:13:57 +0300 (EEST) + Message-Id: <199807311013.NAA28887@koah.research.nokia.com> + Subject: Re: lib/ipc_sysv.t fails under FreeBSD 2.2.1 + Branch: maint-5.005/perl + ! Configure INSTALL ext/IPC/SysV/SysV.xs pod/perldiag.pod + ! t/lib/ipc_sysv.t + ____________________________________________________________________________ + [ 1691] By: gsar on 1998/08/02 04:32:30 + Log: fix bug in display of watched expressions + From: Ilya Zakharevich + Date: Thu, 30 Jul 1998 20:02:04 -0400 (EDT) + Message-Id: <199807310002.UAA21681@monk.mps.ohio-state.edu> + Subject: Re: Bug? in perl5db.pl [PATCH] + Branch: maint-5.005/perl + ! lib/perl5db.pl + ____________________________________________________________________________ + [ 1690] By: gsar on 1998/08/02 04:29:08 + Log: applied all but one hunk + From: Horst von Brand + Date: Thu, 30 Jul 1998 17:19:42 -0400 + Message-Id: <199807302119.RAA06852@sleipnir.valparaiso.cl> + Subject: Some typos in perldelta.pod + Branch: maint-5.005/perl + ! pod/perldelta.pod + ____________________________________________________________________________ + [ 1689] By: gsar on 1998/08/02 04:27:02 + Log: From: Andy Dougherty + Date: Thu, 30 Jul 1998 10:22:36 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.005_05] Remove redundant dTHR + Branch: maint-5.005/perl + ! mg.c sv.c + ____________________________________________________________________________ + [ 1688] By: gsar on 1998/08/02 04:25:49 + Log: From: Tom Hughes + Date: 30 Jul 1998 09:47:31 +0100 + Message-ID: + Subject: Class::Struct has an incomplete tied array package + Branch: maint-5.005/perl + ! lib/Class/Struct.pm + ____________________________________________________________________________ + [ 1687] By: gsar on 1998/08/02 04:21:48 + Log: ensure implicit close on local(*FH) doesn't affect $! and thence $? + Branch: maint-5.005/perl + ! sv.c t/op/die_exit.t + ____________________________________________________________________________ + [ 1686] By: gsar on 1998/08/02 03:57:28 + Log: From: Jarkko Hietaniemi + Date: Thu, 30 Jul 1998 00:39:30 +0300 (EET DST) + Message-Id: <199807292139.AAA01795@alpha.hut.fi> + Subject: Re: [PATCH] 5.004_05-MAINT_TRIAL_5: three locale fixes + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs pod/perllocale.pod + ____________________________________________________________________________ + [ 1685] By: gsar on 1998/08/02 03:54:15 + Log: PERL_OBJECT bincompat fixes from Douglas Lankshear + Date: Wed, 29 Jul 1998 10:45:31 -0700 + Message-ID: <000101bdbb18$ae767550$a32fa8c0@tau.Active> + Subject: [PATCH 5.005_01] Fixes binary compatibility for PERL_OBJECT + -- + Date: Sat, 1 Aug 1998 09:33:19 -0700 + Message-ID: <000701bdbd6a$17ada180$a32fa8c0@tau.Active> + Subject: [PATCH 5.005_01] + Branch: maint-5.005/perl + ! perl.h proto.h + ____________________________________________________________________________ + [ 1684] By: gsar on 1998/08/02 03:49:33 + Log: hand-apply whitespace-mutiliated patch + From: Nicholas Clark + Date: Tue, 28 Jul 1998 16:40:42 +0100 (BST) + Message-Id: <199807281540.QAA04640@flirble.org> + Subject: [PATCH] POSIX::ELOOP + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + ____________________________________________________________________________ + [ 1683] By: gsar on 1998/08/02 03:45:26 + Log: document return values of do() better + From: "M.J.T. Guy" + Date: Tue, 28 Jul 1998 12:44:36 +0100 + Message-Id: + Subject: [PATCH] Re: Obscurity of lexicals with do "" + Branch: maint-5.005/perl + ! pod/perlfunc.pod + ____________________________________________________________________________ + [ 1682] By: gsar on 1998/08/02 03:42:26 + Log: avoid reusing foreach itervar if magic got tacked onto it + From: Stephen McCamant + Date: Tue, 28 Jul 1998 22:18:25 -0500 (CDT) + Message-ID: <13758.36756.215424.719750@alias-2.pr.mcs.net> + Subject: [PATCH] Re: pos() resetting changed with 5.005? + Branch: maint-5.005/perl + ! pp_hot.c + ____________________________________________________________________________ + [ 1681] By: gsar on 1998/08/02 03:39:27 + Log: From: Nick Ing-Simmons + Date: Wed, 29 Jul 1998 13:28:14 +0100 + Message-Id: <199807291228.NAA20055@tiuk.ti.com> + Subject: [Patch] Math::Complex - Ambiguous call resolved as CORE::foo() + Branch: maint-5.005/perl + + Porting/fixCORE + ! MANIFEST lib/Math/Complex.pm + ____________________________________________________________________________ + [ 1680] By: gsar on 1998/08/02 03:33:07 + Log: From: h.sanden@elsevier.nl (Hugo van der Sanden) + Date: Mon, 27 Jul 1998 13:34:45 +0200 + Message-Id: <199807271134.NAA24475@dorlas.elsevier.nl> + Subject: perlcall.pod + Branch: maint-5.005/perl + ! pod/perlcall.pod + ____________________________________________________________________________ + [ 1679] By: gsar on 1998/08/02 03:29:41 + Log: MM_Win32::maybe_command() case-insesitivity tweak + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Win32.pm + ____________________________________________________________________________ + [ 1678] By: gsar on 1998/08/02 03:24:29 + Log: fix MM_Win32::maybe_command() + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Win32.pm + ____________________________________________________________________________ + [ 1677] By: gsar on 1998/08/01 19:52:19 + Log: fixes for overloading bugs and docs, tweaked some + From: Ilya Zakharevich + Date: Sat, 25 Jul 1998 21:28:16 -0400 (EDT) + Message-Id: <199807260128.VAA10543@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_76] better overloading + Branch: maint-5.005/perl + ! Changes gv.c lib/dumpvar.pl lib/overload.pm lib/perl5db.pl + ! t/pragma/overload.t + ____________________________________________________________________________ + [ 1676] By: gsar on 1998/08/01 19:37:13 + Log: stray s/foo/PL_foo/ + From: win@in.rhein-main.de (Winfried Koenig) + Date: Mon, 27 Jul 98 21:13 MET + Message-Id: + Subject: Bug in pp_rename and ISC hint + Branch: maint-5.005/perl + ! pp_sys.c + ____________________________________________________________________________ + [ 1675] By: gsar on 1998/08/01 19:22:13 + Log: newer Porting/patchls from maint-5.004 + Branch: maint-5.005/perl + ! Porting/patchls + ____________________________________________________________________________ + [ 1674] By: gsar on 1998/08/01 17:50:44 + Log: fix buggy detection of failed glob() + Branch: maint-5.005/perl + ! pp_hot.c + ____________________________________________________________________________ + [ 1673] By: gsar on 1998/07/29 18:14:32 + Log: fix typo in change#1489 that prevented magic-autovivification + Branch: maint-5.005/perl + ! mg.c + + ---------------- Version 5.005_01 First maintenance release of 5.005 ---------------- Index: Configure Prereq: 3.0.1.9 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/Configure Thu Jul 23 23:59:27 1998 --- perl5.005_02/Configure Fri Aug 7 17:38:53 1998 *************** *** 1823,1836 **** *) # There is a discontinuity in EBCDIC between 'I' and 'J' # (0xc9 and 0xd1), therefore that is a nice testing point. if test "X$up" = X -o "X$low" = X; then ! case "`echo IJ | tr '[I-J]' '[i-j]' 2>/dev/null`" in ij) up='[A-Z]' low='[a-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then ! case "`echo IJ | tr I-J i-j 2>/dev/null`" in ij) up='A-Z' low='a-z' ;; --- 1823,1836 ---- *) # There is a discontinuity in EBCDIC between 'I' and 'J' # (0xc9 and 0xd1), therefore that is a nice testing point. if test "X$up" = X -o "X$low" = X; then ! case "`echo IJ | $tr '[I-J]' '[i-j]' 2>/dev/null`" in ij) up='[A-Z]' low='[a-z]' ;; esac fi if test "X$up" = X -o "X$low" = X; then ! case "`echo IJ | $tr I-J i-j 2>/dev/null`" in ij) up='A-Z' low='a-z' ;; *************** *** 1858,1864 **** esac fi esac ! case "`echo IJ | tr \"$up\" \"$low\" 2>/dev/null`" in ij) echo "Using $up and $low to convert case." >&4 ;; --- 1858,1864 ---- esac fi esac ! case "`echo IJ | $tr \"$up\" \"$low\" 2>/dev/null`" in ij) echo "Using $up and $low to convert case." >&4 ;; *************** *** 1887,1893 **** # tr '[A-Z]' '[a-z]' would not work in EBCDIC # because the A-Z/a-z are not consecutive. myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \ ! ./tr '[A-Z]' '[a-z]' | tr $trnl ' '` newmyuname="$myuname" dflt=n case "$knowitall" in --- 1887,1893 ---- # tr '[A-Z]' '[a-z]' would not work in EBCDIC # because the A-Z/a-z are not consecutive. myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \ ! ./tr '[A-Z]' '[a-z]' | $tr $trnl ' '` newmyuname="$myuname" dflt=n case "$knowitall" in *************** *** 1956,1962 **** $test -d /usr/apollo/bin && osname=apollo $test -f /etc/saf/_sactab && osname=svr4 $test -d /usr/include/minix && osname=minix ! if $test -d /MachTen; then osname=machten if $test -x /sbin/version; then osvers=`/sbin/version | $awk '{print $2}' | --- 1956,1962 ---- $test -d /usr/apollo/bin && osname=apollo $test -f /etc/saf/_sactab && osname=svr4 $test -d /usr/include/minix && osname=minix ! if $test -d /MachTen -o -d /MachTen_Folder; then osname=machten if $test -x /sbin/version; then osvers=`/sbin/version | $awk '{print $2}' | *************** *** 7631,7636 **** --- 7631,7655 ---- case "$d_msgctl$d_msgget$d_msgsnd$d_msgrcv" in *"$undef"*) h_msg=false;; esac + case "$osname" in + freebsd) + case "`ipcs 2>&1`" in + "SVID messages"*"not configured"*) + echo "But your FreeBSD kernel does not have the msg*(2) configured." >&4 + h_msg=false + val="$undef" + set msgctl d_msgctl + eval $setvar + set msgget d_msgget + eval $setvar + set msgsnd d_msgsnd + eval $setvar + set msgrcv d_msgrcv + eval $setvar + ;; + esac + ;; + esac : we could also check for sys/ipc.h ... if $h_msg && $test `./findhdr sys/msg.h`; then echo "You have the full msg*(2) library." >&4 *************** *** 8113,8118 **** --- 8132,8154 ---- case "$d_semctl$d_semget$d_semop" in *"$undef"*) h_sem=false;; esac + case "$osname" in + freebsd) + case "`ipcs 2>&1`" in + "SVID messages"*"not configured"*) + echo "But your FreeBSD kernel does not have the sem*(2) configured." >&4 + h_sem=false + val="$undef" + set semctl d_semctl + eval $setvar + set semget d_semget + eval $setvar + set semop d_semop + eval $setvar + ;; + esac + ;; + esac : we could also check for sys/ipc.h ... if $h_sem && $test `./findhdr sys/sem.h`; then echo "You have the full sem*(2) library." >&4 *************** *** 8459,8464 **** --- 8495,8519 ---- case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in *"$undef"*) h_shm=false;; esac + case "$osname" in + freebsd) + case "`ipcs 2>&1`" in + "SVID shared memory"*"not configured"*) + echo "But your FreeBSD kernel does not have the shm*(2) configured." >&4 + h_shm=false + val="$undef" + set shmctl d_shmctl + evat $setvar + set shmget d_shmget + evat $setvar + set shmat d_shmat + evat $setvar + set shmdt d_shmdt + evat $setvar + ;; + esac + ;; + esac : we could also check for sys/ipc.h ... if $h_shm && $test `./findhdr sys/shm.h`; then echo "You have the full shm*(2) library." >&4 *************** *** 11971,11977 **** case "$ebcdic" in $define) xxx='' ! echo "This is an EBCDIC system, checking if any parser files may need regenerating." >&4 rm -f y.tab.c y.tab.h yacc -d perly.y >/dev/null 2>&1 if cmp -s y.tab.c perly.c; then --- 12026,12032 ---- case "$ebcdic" in $define) xxx='' ! echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4 rm -f y.tab.c y.tab.h yacc -d perly.y >/dev/null 2>&1 if cmp -s y.tab.c perly.c; then *************** *** 11993,12000 **** fi echo "x2p/a2p.y" >&4 cd x2p ! rm -f y.tab.c y.tab.h ! yacc -d a2p.y >/dev/null 2>&1 if cmp -s y.tab.c a2p.c then rm -f y.tab.c --- 12048,12055 ---- fi echo "x2p/a2p.y" >&4 cd x2p ! rm -f y.tab.c ! yacc a2p.y >/dev/null 2>&1 if cmp -s y.tab.c a2p.c then rm -f y.tab.c *************** *** 12005,12018 **** sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c xxx="$xxx a2p.c" - fi - if cmp -s y.tab.h a2p.h - then - rm -f y.tab.h - else - echo "a2p.h -> a2p.h" >&4 - mv -f y.tab.h a2p.h - xxx="$xxx a2p.h" fi cd .. case "$xxx" in --- 12060,12065 ---- Index: INSTALL Prereq: 1.42 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/INSTALL Thu Jul 23 23:59:28 1998 --- perl5.005_02/INSTALL Wed Aug 5 17:57:37 1998 *************** *** 1203,1208 **** --- 1203,1223 ---- with FreeBSD 2.1) had broken handling of recno databases with modified bval settings. Upgrade your DB library or OS. + =item Bad arg length for semctl, is XX, should be ZZZ + + If you get this error message from the lib/ipc_sysv test, your System + V IPC may be broken. The XX typically is 20, and that is what ZZZ + also should be. Consider upgrading your OS, or reconfiguring your OS + to include the System V semaphores. + + =item lib/ipc_sysv........semget: No space left on device + + Either your account or the whole system has run out of semaphores. Or + both. Either list the semaphores with "ipcs" and remove the unneeded + ones (which ones these are depends on your system and applications) + with "ipcrm -s SEMAPHORE_ID_HERE" or configure more semaphores to your + system. + =item Miscellaneous Some additional things that have been reported for either perl4 or perl5: *************** *** 1212,1217 **** --- 1227,1236 ---- NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT. + + FreeBSD can fail the lib/ipc_sysv.t test if SysV IPC has not been + configured to the kernel. Perl tries to detect this, though, and + you will get a message telling what to do. If you get syntax errors on '(', try -DCRIPPLED_CC. Index: MANIFEST ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/MANIFEST Thu Jul 23 23:59:29 1998 --- perl5.005_02/MANIFEST Tue Aug 4 19:08:11 1998 *************** *** 19,24 **** --- 19,25 ---- Porting/config.sh Sample config.sh Porting/config_H Sample config.h Porting/findvars Find occurrences of words + Porting/fixCORE Find and fix modules that generate warnings Porting/fixvars Find undeclared variables with C compiler and fix em Porting/genlog Generate formatted changelogs by querying p4d Porting/makerel Release making utility *************** *** 33,38 **** --- 34,40 ---- README.dos Notes about dos/djgpp port README.mpeix Notes about MPE/iX port README.os2 Notes about OS/2 port + README.os390 Notes about OS/390 (nee MVS) port README.plan9 Notes about Plan9 port README.qnx Notes about QNX port README.threads Notes about multithreading *************** *** 72,77 **** --- 74,80 ---- doop.c Support code for various operations dosish.h Some defines for MS/DOSish machines dump.c Debugging output + ebcdic.c EBCDIC support routines eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts eg/cgi/RunMeFirst Setup script for CGI examples *************** *** 1035,1040 **** --- 1038,1044 ---- win32/config_H.vc Win32 config header (Visual C++ build) win32/config_h.PL Perl code to convert Win32 config.sh to config.h win32/config_sh.PL Perl code to update Win32 config.sh from Makefile + win32/des_fcrypt.patch Win32 port win32/dl_win32.xs Win32 port win32/genxsdef.pl Win32 port win32/include/arpa/inet.h Win32 port Index: Porting/fixCORE ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/Porting/fixCORE Sat Aug 8 00:41:28 1998 --- perl5.005_02/Porting/fixCORE Sat Aug 1 23:42:26 1998 *************** *** 0 **** --- 1,68 ---- + #!/usr/local/bin/perl -w + use Data::Dumper; + + my $targ = shift; + my $inc = join(' ',map("-I$_",@INC)); + + my $work = 1; + while ($work) + { + open(PIPE,"$^X -w $inc -M$targ -e '' 2>&1 |") || die "Cannot open pipe to child:$!"; + my %fix; + while () + { + if (/^Ambiguous call resolved as CORE::(\w+)\(\), qualify as such or use \& at (\S+) line (\d+)/ + && -f $2 ) + { + my ($var,$file,$line) = ($1,$2,$3); + $fix{$file} = [] unless exists $fix{$file}; + push(@{$fix{$file}},[$line => $var]) unless ($var =~ /^PL_/ || $file =~ /\.h$/); + } + print; + } + close(PIPE); + # warn "Make retured $?\n"; + # last unless $?; + my $changed = 0; + foreach my $file (keys %fix) + { + my @ar = sort( { $a->[0] <=> $b->[0] } @{delete $fix{$file}}); + my @miss; + my $fixed = 0; + @ARGV = ($file); + $. = 0; + local $^I = '.sav'; + while (<>) + { + while (@ar && $. == $ar[0][0]) + { + my ($line,$var) = @{shift(@ar)}; + if (s/(? perl5.005_02 *** perl5.005_02/Porting/makerel Thu Jul 23 23:59:34 1998 --- perl5.005_02/Porting/makerel Sun Aug 2 03:49:13 1998 *************** *** 66,76 **** #system("perl -pi -e 's/^\QPERL_VERSION = \E\d\_\d+(\s*\#)/PERL_VERSION = $vms_vers$1/' vms/descrip.mms"); print "Setting file permissions...\n"; system("find . -type f -print | xargs chmod -w"); system("find . -type d -print | xargs chmod g-s"); system("find t -name '*.t' -print | xargs chmod +x"); ! @exe = qw( Configure configpm embed.pl --- 66,92 ---- #system("perl -pi -e 's/^\QPERL_VERSION = \E\d\_\d+(\s*\#)/PERL_VERSION = $vms_vers$1/' vms/descrip.mms"); + + print "Creating $relroot/$reldir release directory...\n"; + die "$relroot/$reldir release directory already exists\n" if -e "$relroot/$reldir"; + die "$relroot/$reldir.tar.gz release file already exists\n" if -e "$relroot/$reldir.tar.gz"; + mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n"; + print "\n"; + + + print "Copying files to release directory...\n"; + # ExtUtils::Manifest maniread does not preserve the order + $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir"; + system($cmd) == 0 or die "$cmd failed"; + print "\n"; + + chdir "$relroot/$reldir" or die $!; + print "Setting file permissions...\n"; system("find . -type f -print | xargs chmod -w"); system("find . -type d -print | xargs chmod g-s"); system("find t -name '*.t' -print | xargs chmod +x"); ! my @exe = qw( Configure configpm embed.pl *************** *** 90,112 **** Porting/makerel ); system("chmod +x @exe"); - print "\n"; - - - print "Creating $relroot/$reldir release directory...\n"; - die "$relroot/$reldir release directory already exists\n" if -e "$relroot/$reldir"; - die "$relroot/$reldir.tar.gz release file already exists\n" if -e "$relroot/$reldir.tar.gz"; - mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n"; - print "\n"; - ! print "Copying files to release directory...\n"; ! # ExtUtils::Manifest maniread does not preserve the order ! $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir"; ! system($cmd) == 0 or die "$cmd failed"; print "\n"; ! chdir $relroot or die $!; print "Creating and compressing the tar file...\n"; my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch --- 106,124 ---- Porting/makerel ); system("chmod +x @exe"); ! print "Adding CRs to DOSish files...\n"; ! my @crlf = qw( ! djgpp/configure.bat ! README.dos ! README.win32 ! win32/Makefile ! win32/makefile.mk ! ); ! system("perl -pi -e 's/\$/\\r/' @crlf"); print "\n"; ! chdir ".." or die $!; print "Creating and compressing the tar file...\n"; my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch Index: Porting/patchls ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/Porting/patchls Thu Jul 23 23:59:34 1998 --- perl5.005_02/Porting/patchls Sat Aug 1 15:29:25 1998 *************** *** 17,23 **** use strict; use vars qw($VERSION); ! $VERSION = 2.05; sub usage { die qq{ --- 17,23 ---- use strict; use vars qw($VERSION); ! $VERSION = 2.08; sub usage { die qq{ *************** *** 30,35 **** --- 30,36 ---- -m print formatted Meta-information (Subject,From,Msg-ID etc). -p N strip N levels of directory Prefix (like patch), else automatic. -v more verbose (-d for noisy debugging). + -n give a count of the number of patches applied to a file if >1. -f F only list patches which patch files matching regexp F (F has \$ appended unless it contains a /). -e Expect patched files to Exist (relative to current directory) *************** *** 40,45 **** --- 41,47 ---- -5 like -4 but add "|| exit 1" after each command -M T Like -m but only output listed meta tags (eg -M 'Title From') -W N set wrap width to N (defaults to 70, use 0 for no wrap) + -X list patchfiles that may clash (i.e. patch the same file) patchls version $VERSION by Tim Bunce } *************** *** 49,54 **** --- 51,57 ---- $::opt_d = 0; $::opt_v = 0; $::opt_m = 0; + $::opt_n = 0; $::opt_i = 0; $::opt_h = 0; $::opt_l = 0; *************** *** 63,97 **** $::opt_M = ''; # like -m but only output these meta items (-M Title) $::opt_W = 70; # set wrap width columns (see Text::Wrap module) $::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented usage unless @ARGV; ! getopts("mihlvecC45p:f:IM:W:") or usage; $columns = $::opt_W || 9999999; $::opt_m = 1 if $::opt_M; $::opt_4 = 1 if $::opt_5; ! my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); # see get_meta_info() my %cat_title = ( 'BUILD' => 'BUILD PROCESS', 'CORE' => 'CORE LANGUAGE', 'DOC' => 'DOCUMENTATION', ! 'LIB' => 'LIBRARY AND EXTENSIONS', 'PORT1' => 'PORTABILITY - WIN32', 'PORT2' => 'PORTABILITY - GENERAL', 'TEST' => 'TESTS', 'UTIL' => 'UTILITIES', 'OTHER' => 'OTHER CHANGES', ); sub get_meta_info { my $ls = shift; local($_) = shift; ! $ls->{From}{$1}=1 if /^From:\s+(.*\S)/i; ! $ls->{Title}{$1}=1 if /^Subject:\s+(?:Re: )?(.*\S)/i; $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i; $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i; $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/; --- 66,120 ---- $::opt_M = ''; # like -m but only output these meta items (-M Title) $::opt_W = 70; # set wrap width columns (see Text::Wrap module) $::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented + $::opt_X = 0; # list patchfiles that patch the same file usage unless @ARGV; ! getopts("dmnihlvecC45Xp:f:IM:W:") or usage; $columns = $::opt_W || 9999999; $::opt_m = 1 if $::opt_M; $::opt_4 = 1 if $::opt_5; ! $::opt_i = 1 if $::opt_X; ! ! # see get_meta_info() ! my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID Files'); ! my %show_meta = map { ($_,1) } @show_meta; my %cat_title = ( 'BUILD' => 'BUILD PROCESS', 'CORE' => 'CORE LANGUAGE', 'DOC' => 'DOCUMENTATION', ! 'LIB' => 'LIBRARY', 'PORT1' => 'PORTABILITY - WIN32', 'PORT2' => 'PORTABILITY - GENERAL', 'TEST' => 'TESTS', 'UTIL' => 'UTILITIES', 'OTHER' => 'OTHER CHANGES', + 'EXT' => 'EXTENSIONS', + 'UNKNOWN' => 'UNKNOWN - NO FILES PATCH', ); sub get_meta_info { my $ls = shift; local($_) = shift; ! if (/^From:\s+(.*\S)/i) {; ! my $from = $1; # temporary measure for Chip Salzenberg ! $from =~ s/chip\@(atlantic\.net|perlsupport\.com)/chip\@pobox.com/; ! $from =~ s/\(Tim Bunce\) \(Tim Bunce\)/(Tim Bunce)/; ! $ls->{From}{$from} = 1 ! } ! if (/^Subject:\s+(?:Re: )?(.*\S)/i) { ! my $title = $1; ! $title =~ s/\[(PATCH|PERL)[\w\. ]*\]:?//g; ! $title =~ s/\b(PATCH|PERL)[\w\.]*://g; ! $title =~ s/\bRe:\s+/ /g; ! $title =~ s/\s+/ /g; ! $title =~ s/^\s*(.*?)\s*$/$1/g; ! $ls->{Title}{$title} = 1; ! } $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i; $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i; $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/; *************** *** 118,124 **** my %ls; ! my ($in, $prevline, $ls); my $prevtype = ''; my (@removed, @added); my $prologue = 1; # assume prologue till patch or /^exit\b/ seen --- 141,149 ---- my %ls; ! my $in; ! my $ls; ! my $prevline = ''; my $prevtype = ''; my (@removed, @added); my $prologue = 1; # assume prologue till patch or /^exit\b/ seen *************** *** 149,161 **** next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/; $prologue = 0; ! print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d; # Some patches have Index lines but not diff headers # Patch copes with this, so must we. It's also handy for # documenting manual changes by simply adding Index: lines ! # to the file which describes the problem bing fixed. ! add_file($ls, $1), next if /^Index:\s+(\S+)/; if ( ($type eq '---' and $prevtype eq '***') # Style 1 or ($type eq '+++' and $prevtype eq '---') # Style 2 --- 174,190 ---- next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/; $prologue = 0; ! print "Last: $prevline","This: ${_}Got: $type\n\n" if $::opt_d; # Some patches have Index lines but not diff headers # Patch copes with this, so must we. It's also handy for # documenting manual changes by simply adding Index: lines ! # to the file which describes the problem being fixed. ! if (/^Index:\s+(.*)/) { ! my $f; ! foreach $f (split(/ /, $1)) { add_file($ls, $f) } ! next; ! } if ( ($type eq '---' and $prevtype eq '***') # Style 1 or ($type eq '+++' and $prevtype eq '---') # Style 2 *************** *** 170,195 **** } continue { $prevline = $_; ! $prevtype = $type; $type = ''; } # special mode for patch sets from Chip ! if ($::opt_C && $in =~ m:[\\/]patch$:) { my $chip; my $dir; ($dir = $in) =~ s:[\\/]patch$::; if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) { get_meta_info($ls, $_) while (); } if (open CHIP,"<$dir/from") { chop($chip = ); $ls->{From} = { $chip => 1 }; } if (open CHIP,"<$dir/tag") { chop($chip = ); $ls->{Title} = { $chip => 1 }; } ! $ls->{From} = { "Chip Salzenberg" => 1 } unless $ls->{From}; } # if we don't have a title for -m then use the file name --- 199,228 ---- } continue { $prevline = $_; ! $prevtype = $type || ''; $type = ''; } # special mode for patch sets from Chip ! if ($in =~ m:[\\/]patch$:) { ! my $is_chip; my $chip; my $dir; ($dir = $in) =~ s:[\\/]patch$::; if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) { get_meta_info($ls, $_) while (); + $is_chip = 1; } if (open CHIP,"<$dir/from") { chop($chip = ); $ls->{From} = { $chip => 1 }; + $is_chip = 1; } if (open CHIP,"<$dir/tag") { chop($chip = ); $ls->{Title} = { $chip => 1 }; + $is_chip = 1; } ! $ls->{From} = { "Chip Salzenberg" => 1 } if $is_chip && !$ls->{From}; } # if we don't have a title for -m then use the file name *************** *** 207,219 **** my @ls = values %ls; if ($::opt_f) { # filter out patches based on -f - my $out; $::opt_f .= '$' unless $::opt_f =~ m:/:; @ls = grep { - my @out = keys %{$_->{out}}; my $match = 0; ! for $out (@out) { ! ++$match if $out =~ m/$::opt_f/o; } $match; } @ls; --- 240,254 ---- my @ls = values %ls; if ($::opt_f) { # filter out patches based on -f $::opt_f .= '$' unless $::opt_f =~ m:/:; @ls = grep { my $match = 0; ! if ($_->{is_in}) { ! my @out = keys %{ $_->{out} }; ! $match=1 if grep { m/$::opt_f/o } @out; ! } ! else { ! $match=1 if $_->{in} =~ m/$::opt_f/o; } $match; } @ls; *************** *** 230,265 **** my $tail = ($::opt_5) ? "|| exit 1" : ""; print map { "p4 delete $_$tail\n" } @removed if @removed; print map { "p4 add $_$tail\n" } @added if @added; ! my @patches = grep { $_->{is_in} } @ls; my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches; delete @patched{@added}; my @patched = sort keys %patched; ! print map { my $edit = ($::opt_e && !-f $_) ? "add " : "edit"; ! "p4 $edit $_$tail\n" ! } @patched if @patched; exit 0 unless $::opt_C; } if ($::opt_I) { my $n_patches = 0; my($in,$out); my %all_out; foreach $in (@ls) { next unless $in->{is_in}; ++$n_patches; my @outs = keys %{$in->{out}}; @all_out{@outs} = ($in->{in}) x @outs; } my @all_out = sort keys %all_out; my @missing = grep { ! -f $_ } @all_out; print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n"; print "(use -v to list patches which patch 'missing' files)\n" ! if @missing && !$::opt_v; if ($::opt_v and @missing) { print "Missing files:\n"; foreach $out (@missing) { ! printf " %-20s\t%s\n", $out, $all_out{$out}; } } print "Added files: @added\n" if @added; --- 265,315 ---- my $tail = ($::opt_5) ? "|| exit 1" : ""; print map { "p4 delete $_$tail\n" } @removed if @removed; print map { "p4 add $_$tail\n" } @added if @added; ! my @patches = sort grep { $_->{is_in} } @ls; ! my @no_outs = grep { keys %{$_->{out}} == 0 } @patches; ! warn "Warning: Some files contain no patches:", ! join("\n\t", '', map { $_->{in} } @no_outs), "\n" if @no_outs; my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches; delete @patched{@added}; my @patched = sort keys %patched; ! foreach(@patched) { my $edit = ($::opt_e && !-f $_) ? "add " : "edit"; ! print "p4 $edit $_$tail\n"; ! } exit 0 unless $::opt_C; } + if ($::opt_I) { my $n_patches = 0; my($in,$out); my %all_out; + my @no_outs; foreach $in (@ls) { next unless $in->{is_in}; ++$n_patches; my @outs = keys %{$in->{out}}; + push @no_outs, $in unless @outs; @all_out{@outs} = ($in->{in}) x @outs; } my @all_out = sort keys %all_out; my @missing = grep { ! -f $_ } @all_out; print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n"; + print @no_outs." patch files don't contain patches.\n" if @no_outs; print "(use -v to list patches which patch 'missing' files)\n" ! if (@missing || @no_outs) && !$::opt_v; ! if ($::opt_v and @no_outs) { ! print "Patch files which don't contain patches:\n"; ! foreach $out (@no_outs) { ! printf " %-20s\n", $out->{in}; ! } ! } if ($::opt_v and @missing) { print "Missing files:\n"; foreach $out (@missing) { ! printf " %-20s\t", $out unless $::opt_h; ! print $all_out{$out} unless $::opt_l; ! print "\n"; } } print "Added files: @added\n" if @added; *************** *** 270,275 **** --- 320,326 ---- unless ($::opt_c and $::opt_m) { foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; + next if $::opt_X and keys %{$ls->{out}} <= 1; list_files_by_patch($ls); } } *************** *** 304,309 **** --- 355,361 ---- sub add_file { my $ls = shift; + print "add_file '$_[0]'\n" if $::opt_d; my $out = trim_name(shift); $ls->{out}->{$out} = 1; *************** *** 351,357 **** my @list = sort keys %{$ls->{$meta}}; push @meta, sprintf "%7s: ", $meta; if ($meta eq 'Title') { ! @list = map { s/\[?(PATCH|PERL)\]?:?\s*//g; "\"$_\""; } @list; push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:; } elsif ($meta eq 'From') { --- 403,409 ---- my @list = sort keys %{$ls->{$meta}}; push @meta, sprintf "%7s: ", $meta; if ($meta eq 'Title') { ! @list = map { "\"$_\""; } @list; push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:; } elsif ($meta eq 'From') { *************** *** 372,388 **** $name = "\n$name" if @meta and $name; } # don't print the header unless the file contains something interesting ! return if !@meta and !$ls->{out}; ! print("$ls->{in}\n"),return if $::opt_l; # -l = no listing, just names # a twisty maze of little options my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat"; print join('',"\n",@meta) if @meta; my @v = sort PATORDER keys %{ $ls->{out} }; ! my $v = "@v\n"; print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v; } --- 424,450 ---- $name = "\n$name" if @meta and $name; } # don't print the header unless the file contains something interesting ! return if !@meta and !$ls->{out} and !$::opt_v; ! if ($::opt_l) { # -l = no listing, just names ! print "$ls->{in}"; ! my $n = keys %{ $ls->{out} }; ! print " ($n patches)" if $::opt_n and $n>1; ! print "\n"; ! return; ! } # a twisty maze of little options my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat"; print join('',"\n",@meta) if @meta; + return if $::opt_m && !$show_meta{Files}; my @v = sort PATORDER keys %{ $ls->{out} }; ! my $n = @v; ! my $v = "@v"; print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v; + print " ($n patches)" if $::opt_n and $n>1; + print "\n"; } *************** *** 408,415 **** if m:^(cygwin32|os2|plan9|qnx|vms)/: or m:^(hints|Porting|ext/DynaLoader)/: or m:^README\.:; $c{LIB} += 10,next ! if m:^(lib|ext)/:; $c{'CORE'} += 15,next if m:^[^/]+[\._]([chH]|sym|pl)$:; $c{BUILD} += 10,next --- 470,479 ---- if m:^(cygwin32|os2|plan9|qnx|vms)/: or m:^(hints|Porting|ext/DynaLoader)/: or m:^README\.:; + $c{EXT} += 10,next + if m:^(ext|lib/ExtUtils)/:; $c{LIB} += 10,next ! if m:^(lib)/:; $c{'CORE'} += 15,next if m:^[^/]+[\._]([chH]|sym|pl)$:; $c{BUILD} += 10,next *************** *** 435,441 **** } else { my($c, $v) = %c; ! $c ||= 'OTHER'; $v ||= 0; print " ".@$files." patches: $c: $v\n" if $verb; return $c; } --- 499,505 ---- } else { my($c, $v) = %c; ! $c ||= 'UNKNOWN'; $v ||= 0; print " ".@$files." patches: $c: $v\n" if $verb; return $c; } Index: README.dos ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/README.dos Thu Jul 23 23:59:36 1998 --- perl5.005_02/README.dos Fri Aug 7 23:57:51 1998 *************** *** 1,276 **** ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see perlpod manpage) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perldos - Perl under DOS, W31, W95. ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under DOS (or w??), using ! DJGPP v2.01 or later. Under w95 long filenames are supported. ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! ! =head2 Prerequisites ! ! =over 4 ! ! =item DJGPP ! ! DJGPP is a port of GNU C/C++ compiler and development tools to 32-bit, ! protected-mode environment on Intel 32-bit CPUs running MS-DOS and compatible ! operating systems, by DJ Delorie and friends. ! ! For more details (FAQ), check out the home of DJGPP at: ! ! http://www.delorie.com/djgpp/ ! ! If you have questions about DJGPP, try posting to the DJGPP newsgroup: ! comp.os.msdos.djgpp, or use the email gateway djgpp@delorie.com. ! ! You can find the full DJGPP distribution on any SimTel.Net mirror all over ! the world. Like: ! ! ftp://ftp.simtel.net/pub/simtelnet/gnu/djgpp/v2* ! ! You need the following files to build perl (or add new modules): ! ! v2/djdev201.zip ! v2/bnu27b.zip ! v2gnu/gcc2721b.zip ! v2gnu/bsh1147b.zip ! v2gnu/mak3761b.zip ! v2gnu/fil316b.zip ! v2gnu/sed118b.zip ! v2gnu/txt122b.zip ! v2gnu/dif271b.zip ! v2gnu/grep21b.zip ! v2gnu/shl112b.zip ! v2gnu/gawk303b.zip ! v2misc/csdpmi4b.zip ! ! or any newer version. ! ! =item Pthreads ! ! If you want multithreading support in perl, you need a pthread library ! that supports DJGPP. One of them can be found at: ! ! ftp://ftp.cs.fsu.edu/pub/PART/PTHREADS/pthreads.zip ! ! But thread support is still in alpha, it may be unstable. For more information ! see below. ! ! =back ! ! =head2 Shortcomings of Perl under DOS ! ! Perl under DOS lacks some features of perl under UNIX because of ! deficiencies in the UNIX-emulation, most notably: ! ! =over 4 ! ! =item * ! ! fork() and pipe() ! ! =item * ! ! some features of the UNIX filesystem regarding link count and file dates ! ! =item * ! ! in-place operation is a little bit broken with short filenames ! ! =item * ! ! sockets ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Unpack the source package F with djtarx. If you want ! to use long file names under w95, don't forget to use ! ! set LFN=y ! ! before unpacking the archive. ! ! =item * ! ! Create a "symlink" or copy your bash.exe to sh.exe in your C<($DJDIR)/bin> ! directory. ! ! ln -s bash.exe sh.exe ! ! And make the C environment variable point to this F: ! ! set SHELL=c:/djgpp/bin/sh.exe (use full path name!) ! ! You can do this in F too. Add this line BEFORE any section ! definition: ! ! +SHELL=%DJDIR%/bin/sh.exe ! ! =item * ! ! If you have F and F in your path, then rename ! F to F, and F to F. ! Copy or link F to F if you don't have F. ! Copy or link F to F if you don't have F. ! ! =item * ! ! Chdir to the djgpp subdirectory of perl toplevel and type the following ! command: ! ! configure.bat ! ! This will do some preprocessing then run the Configure script for you. ! The Configure script is interactive, but in most cases you ! just need to press ENTER. ! ! If the script says that your package is incomplete, and asks whether ! to continue, just answer with Y (this can only happen if you don't use ! long filenames). ! ! When Configure asks about the extensions, I suggest IO and Fcntl, ! and if you want database handling then SDBM_File or GDBM_File ! (you need to install gdbm for this one). If you want to use the ! POSIX extension (this is the default), make sure that the stack ! size of your F is at least 512kbyte (you can check this ! with: C). ! ! You can use the Configure script in non-interactive mode too. ! When I built my F, I used something like this: ! ! configure.bat -Uuseposix -des ! ! You can find more info about Configure's command line switches in ! the F file. ! ! When the script ends, and you want to change some values in the ! generated F file, then run ! ! sh Configure -S ! ! after you made your modifications. ! ! IMPORTANT: if you use this C<-S> switch, be sure to delete the CONFIG ! environment variable before running the script: ! ! set CONFIG= ! ! =item * ! ! Now you can compile Perl. Type: ! ! make ! ! =back ! ! =head2 Testing ! ! Type: ! ! make test ! ! You should see "All tests successful" if you configured a database ! manager, and 1 failed test script if not (F). If you ! configured POSIX you will see 1 additional failed subtest in F. ! ! =head2 Installation ! ! Type: ! ! make install ! ! This will copy the newly compiled perl and libraries into your DJGPP ! directory structure. Perl.exe and the utilities go into C<($DJDIR)/bin>, ! and the library goes under C<($DJDIR)/lib/perl5>. The pod documentation ! goes under C<($DJDIR)/lib/perl5/pod>. ! ! =head2 Threaded perl under dos-djgpp ! ! Multithreading support is considered alpha, because some of the ! tests in C still die with SIGSEGV (patches are welcome). But ! if you want to give it a try, here are the necessary steps: ! ! =over 4 ! ! =item ! ! 1. You will need a pthread library which supports djgpp. Go, and download ! FSU's version from: ! ! ftp://ftp.cs.fsu.edu/pub/PART/PTHREADS/pthreads.zip ! ! The latest version is 3.5, released in Feb 98. ! ! =item ! ! 2. Unzip the file, cd to C and run F. ! ! =item ! ! 3. Add C or C or C to C ! in the F. Note that using these values, multithreading will ! NOT be preemptive. This is necessary, since djgpp's libc is not thread safe. ! ! =item ! ! 4. Apply the following patch: ! ! *** include/pthread/signal.h~ Wed Feb 4 10:51:24 1998 ! --- include/pthread/signal.h Tue Feb 10 22:40:32 1998 ! *************** ! *** 364,368 **** ! --- 364,370 ---- ! ! #ifndef SA_ONSTACK ! + #ifdef SV_ONSTACK ! #define SA_ONSTACK SV_ONSTACK ! + #endif ! #endif /* !SA_ONSTACK */ ! ! =item ! ! 5. run make (before you do this, you must make sure your C environment ! variable does NOT point to bash). ! ! =item ! ! 6. Install the library and header files into your djgpp directory structure. ! ! =item ! ! 7. Add C<-Dusethreads> to the commmand line of perl's F. ! ! =back ! ! =head1 AUTHOR ! ! Laszlo Molnar, F ! ! =head1 SEE ALSO ! ! perl(1). ! ! =cut ! --- 1,276 ---- ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see perlpod manpage) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perldos - Perl under DOS, W31, W95. ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under DOS (or w??), using ! DJGPP v2.01 or later. Under w95 long filenames are supported. ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! ! =head2 Prerequisites ! ! =over 4 ! ! =item DJGPP ! ! DJGPP is a port of GNU C/C++ compiler and development tools to 32-bit, ! protected-mode environment on Intel 32-bit CPUs running MS-DOS and compatible ! operating systems, by DJ Delorie and friends. ! ! For more details (FAQ), check out the home of DJGPP at: ! ! http://www.delorie.com/djgpp/ ! ! If you have questions about DJGPP, try posting to the DJGPP newsgroup: ! comp.os.msdos.djgpp, or use the email gateway djgpp@delorie.com. ! ! You can find the full DJGPP distribution on any SimTel.Net mirror all over ! the world. Like: ! ! ftp://ftp.simtel.net/pub/simtelnet/gnu/djgpp/v2* ! ! You need the following files to build perl (or add new modules): ! ! v2/djdev201.zip ! v2/bnu27b.zip ! v2gnu/gcc2721b.zip ! v2gnu/bsh1147b.zip ! v2gnu/mak3761b.zip ! v2gnu/fil316b.zip ! v2gnu/sed118b.zip ! v2gnu/txt122b.zip ! v2gnu/dif271b.zip ! v2gnu/grep21b.zip ! v2gnu/shl112b.zip ! v2gnu/gawk303b.zip ! v2misc/csdpmi4b.zip ! ! or any newer version. ! ! =item Pthreads ! ! If you want multithreading support in perl, you need a pthread library ! that supports DJGPP. One of them can be found at: ! ! ftp://ftp.cs.fsu.edu/pub/PART/PTHREADS/pthreads.zip ! ! But thread support is still in alpha, it may be unstable. For more information ! see below. ! ! =back ! ! =head2 Shortcomings of Perl under DOS ! ! Perl under DOS lacks some features of perl under UNIX because of ! deficiencies in the UNIX-emulation, most notably: ! ! =over 4 ! ! =item * ! ! fork() and pipe() ! ! =item * ! ! some features of the UNIX filesystem regarding link count and file dates ! ! =item * ! ! in-place operation is a little bit broken with short filenames ! ! =item * ! ! sockets ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Unpack the source package F with djtarx. If you want ! to use long file names under w95, don't forget to use ! ! set LFN=y ! ! before unpacking the archive. ! ! =item * ! ! Create a "symlink" or copy your bash.exe to sh.exe in your C<($DJDIR)/bin> ! directory. ! ! ln -s bash.exe sh.exe ! ! And make the C environment variable point to this F: ! ! set SHELL=c:/djgpp/bin/sh.exe (use full path name!) ! ! You can do this in F too. Add this line BEFORE any section ! definition: ! ! +SHELL=%DJDIR%/bin/sh.exe ! ! =item * ! ! If you have F and F in your path, then rename ! F to F, and F to F. ! Copy or link F to F if you don't have F. ! Copy or link F to F if you don't have F. ! ! =item * ! ! Chdir to the djgpp subdirectory of perl toplevel and type the following ! command: ! ! configure.bat ! ! This will do some preprocessing then run the Configure script for you. ! The Configure script is interactive, but in most cases you ! just need to press ENTER. ! ! If the script says that your package is incomplete, and asks whether ! to continue, just answer with Y (this can only happen if you don't use ! long filenames). ! ! When Configure asks about the extensions, I suggest IO and Fcntl, ! and if you want database handling then SDBM_File or GDBM_File ! (you need to install gdbm for this one). If you want to use the ! POSIX extension (this is the default), make sure that the stack ! size of your F is at least 512kbyte (you can check this ! with: C). ! ! You can use the Configure script in non-interactive mode too. ! When I built my F, I used something like this: ! ! configure.bat -Uuseposix -des ! ! You can find more info about Configure's command line switches in ! the F file. ! ! When the script ends, and you want to change some values in the ! generated F file, then run ! ! sh Configure -S ! ! after you made your modifications. ! ! IMPORTANT: if you use this C<-S> switch, be sure to delete the CONFIG ! environment variable before running the script: ! ! set CONFIG= ! ! =item * ! ! Now you can compile Perl. Type: ! ! make ! ! =back ! ! =head2 Testing ! ! Type: ! ! make test ! ! You should see "All tests successful" if you configured a database ! manager, and 1 failed test script if not (F). If you ! configured POSIX you will see 1 additional failed subtest in F. ! ! =head2 Installation ! ! Type: ! ! make install ! ! This will copy the newly compiled perl and libraries into your DJGPP ! directory structure. Perl.exe and the utilities go into C<($DJDIR)/bin>, ! and the library goes under C<($DJDIR)/lib/perl5>. The pod documentation ! goes under C<($DJDIR)/lib/perl5/pod>. ! ! =head2 Threaded perl under dos-djgpp ! ! Multithreading support is considered alpha, because some of the ! tests in C still die with SIGSEGV (patches are welcome). But ! if you want to give it a try, here are the necessary steps: ! ! =over 4 ! ! =item ! ! 1. You will need a pthread library which supports djgpp. Go, and download ! FSU's version from: ! ! ftp://ftp.cs.fsu.edu/pub/PART/PTHREADS/pthreads.zip ! ! The latest version is 3.5, released in Feb 98. ! ! =item ! ! 2. Unzip the file, cd to C and run F. ! ! =item ! ! 3. Add C or C or C to C ! in the F. Note that using these values, multithreading will ! NOT be preemptive. This is necessary, since djgpp's libc is not thread safe. ! ! =item ! ! 4. Apply the following patch: ! ! *** include/pthread/signal.h~ Wed Feb 4 10:51:24 1998 ! --- include/pthread/signal.h Tue Feb 10 22:40:32 1998 ! *************** ! *** 364,368 **** ! --- 364,370 ---- ! ! #ifndef SA_ONSTACK ! + #ifdef SV_ONSTACK ! #define SA_ONSTACK SV_ONSTACK ! + #endif ! #endif /* !SA_ONSTACK */ ! ! =item ! ! 5. run make (before you do this, you must make sure your C environment ! variable does NOT point to bash). ! ! =item ! ! 6. Install the library and header files into your djgpp directory structure. ! ! =item ! ! 7. Add C<-Dusethreads> to the commmand line of perl's F. ! ! =back ! ! =head1 AUTHOR ! ! Laszlo Molnar, F ! ! =head1 SEE ALSO ! ! perl(1). ! ! =cut ! Index: README.os2 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/README.os2 Thu Jul 23 23:59:37 1998 --- perl5.005_02/README.os2 Wed Aug 5 17:58:56 1998 *************** *** 112,117 **** --- 112,118 ---- - Threading - Calls to external programs - Memory allocation + - Threads AUTHOR SEE ALSO *************** *** 883,932 **** make test ! Some tests (4..6) should fail. Some perl invocations should end in a ! segfault (system error C). To get finer error reports, call ! perl t/harness ! The report you get may look like ! Failed Test Status Wstat Total Fail Failed List of failed ! --------------------------------------------------------------- ! io/fs.t 26 11 42.31% 2-5, 7-11, 18, 25 ! lib/io_pipe.t 3 768 6 ?? % ?? ! lib/io_sock.t 3 768 5 ?? % ?? ! op/stat.t 56 5 8.93% 3-4, 20, 35, 39 ! Failed 4/140 test scripts, 97.14% okay. 27/2937 subtests failed, 99.08% okay. ! Note that using C target two more tests may fail: C ! because of (mis)feature of pdksh, and C, which checks ! that the buffers are not flushed on C<_exit> (this is a bug in the test ! which assumes that tty output is buffered). ! I submitted a patch to EMX which makes it possible to fork() with EMX ! dynamic libraries loaded, which makes F tests pass. This means ! that soon the number of failing tests may decrease yet more. ! However, the test F is disabled, since it never terminates, I ! do not know why. Comments/fixes welcome. ! The reasons for failed tests are: ! =over 8 ! =item F ! Checks I operations. Tests: ! =over 10 ! =item 2-5, 7-11 ! Check C and C - nonesuch under OS/2. =item 18 ! Checks C and C of C - I could not understand this test. =item 25 --- 884,948 ---- make test ! All tests should succeed (with some of them skipped). Note that on one ! of the systems I see intermittent failures of F subtest 9. ! Any help to track what happens with this test is appreciated. ! Some tests may generate extra messages similar to ! =over 4 ! =item A lot of C ! in database tests related to Berkeley DB. This is a confirmed bug of ! DB. You may disable this warnings, see L<"PERL_BADFREE">. ! There is not much we can do with it (but apparently it does not cause ! any real error with data). ! =item Process terminated by SIGTERM/SIGINT ! This is a standard message issued by OS/2 applications. *nix ! applications die in silence. It is considered a feature. One can ! easily disable this by appropriate sighandlers. ! However the test engine bleeds these message to screen in unexpected ! moments. Two messages of this kind I be present during ! testing. ! =back ! Two F tests may generate popups (system error C), ! but should succeed anyway. This is due to a bug of EMX related to ! fork()ing with dynamically loaded libraries. ! I submitted a patch to EMX which makes it possible to fork() with EMX ! dynamic libraries loaded, which makes F tests pass without ! skipping offended tests. This means that soon the number of skipped tests ! may decrease yet more. ! ! To get finer test reports, call ! ! perl t/harness ! ! The report with F failing may look like this: ! Failed Test Status Wstat Total Fail Failed List of failed ! ------------------------------------------------------------ ! io/pipe.t 12 1 8.33% 9 ! 7 tests skipped, plus 56 subtests skipped. ! Failed 1/195 test scripts, 99.49% okay. 1/6542 subtests failed, 99.98% okay. ! ! The reasons for most important skipped tests are: ! ! =over 8 ! =item F =item 18 ! Checks C and C of C - unfortunately, HPFS ! provides only 2sec time granularity (for compatibility with FAT?). =item 25 *************** *** 951,1012 **** =over 4 - =item 3 - - Checks C - nonesuch under OS/2. - =item 4 ! Checks C and C of C - I could not understand this test. ! ! =item 20 ! ! Checks C<-x> - determined by the file extension only under OS/2. ! ! =item 35 ! ! Needs F. ! ! =item 39 ! ! Checks C<-t> of F. Should not fail! ! ! =back =back ! In addition to errors, you should get a lot of warnings. ! ! =over 4 ! ! =item A lot of C ! ! in databases related to Berkeley DB. This is a confirmed bug of ! DB. You may disable this warnings, see L<"PERL_BADFREE">. ! ! =item Process terminated by SIGTERM/SIGINT ! This is a standard message issued by OS/2 applications. *nix ! applications die in silence. It is considered a feature. One can ! easily disable this by appropriate sighandlers. ! ! However the test engine bleeds these message to screen in unexpected ! moments. Two messages of this kind I be present during ! testing. ! ! =item F<*/sh.exe>: ln: not found ! ! =item C: /dev: No such file or directory ! ! The last two should be self-explanatory. The test suite discovers that ! the system it runs on is not I *nixish. =back - A lot of C... in databases, bug in DB confirmed on other - platforms. You may disable it by setting PERL_BADFREE environment variable - to 1. - =head2 Installing the built perl If you haven't yet moved perl.dll onto LIBPATH, do it now. --- 967,986 ---- =over 4 =item 4 ! Checks C and C of C - unfortunately, HPFS ! provides only 2sec time granularity (for compatibility with FAT?). =back ! =item F ! It never terminates, apparently some bug in storing the last socket from ! which we obtained a message. =back =head2 Installing the built perl If you haven't yet moved perl.dll onto LIBPATH, do it now. *************** *** 1550,1563 **** =head2 Memory allocation Perl uses its own malloc() under OS/2 - interpreters are usually malloc-bound ! for speed, but perl is not, since its malloc is lightning-fast. ! Unfortunately, it is also quite frivolous with memory usage as well. ! ! Since kitchen-top machines are usually low on memory, perl is compiled with ! all the possible memory-saving options. This probably makes perl's ! malloc() as greedy with memory as the neighbor's malloc(), but still ! much quickier. Note that this is true only for a "typical" usage, ! it is possible that the perl malloc will be worse for some very special usage. Combination of perl's malloc() and rigid DLL name resolution creates a special problem with library functions which expect their return value to --- 1524,1533 ---- =head2 Memory allocation Perl uses its own malloc() under OS/2 - interpreters are usually malloc-bound ! for speed, but perl is not, since its malloc is lightning-fast. ! Perl-memory-usage-tuned benchmarks show that Perl's malloc is 5 times quickier ! than EMX one. I do not have convincing data about memory footpring, but ! a (pretty random) benchmark showed that Perl one is 5% better. Combination of perl's malloc() and rigid DLL name resolution creates a special problem with library functions which expect their return value to *************** *** 1565,1570 **** --- 1535,1565 ---- such functions, system memory-allocation functions are still available with the prefix C added. (Currently only DLL perl has this, it should propagate to F shortly.) + + =head2 Threads + + One can build perl with thread support enabled by providing C<-D usethreads> + option to F. Currently OS/2 support of threads is very + preliminary. + + Most notable problems: + + =over + + =item C + + may have a race condition. Needs a reimplementation (in terms of chaining + waiting threads, with linker list stored in per-thread structure?). + + =item F + + has a couple of static variables used in OS/2-specific functions. (Need to be + moved to per-thread structure, or serialized?) + + =back + + Note that these problems should not discourage experimenting, since they + have a low probability of affecting small programs. =cut Index: README.os390 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/README.os390 Sat Aug 8 00:41:28 1998 --- perl5.005_02/README.os390 Sun Aug 2 01:15:06 1998 *************** *** 0 **** --- 1,83 ---- + This is a fully ported perl for OS/390 Release 3. It may work on + other versions, but that's the one we've tested it on. + + If you've downloaded the binary distribution, it needs to be + installed below /usr/local. Source code distributions have an + automated `make install` step that means you do not need to extract + the source code below /usr/local (though that is where it will be + installed by default). You may need to worry about the networking + configuration files discussed in the last bullet below. + + Gunzip/gzip for OS/390 is discussed at: + + http://www.s390.ibm.com/products/oe/bpxqp1.html + + to extract an ASCII tar archive on OS/390, try this: + + pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar + + GNU make for OS/390, which may be required for the build of perl, + is available from: + + http://www.mks.com/s390/gnu/index.htm + + Once you've unpacked the distribution, run Configure (see INSTALL for + full discussion of the Configure options), and then run make, then + "make test" then "make install" (this last step may require UID=0 + privileges) + + There is a "hints" file for os390 that specifies the correct values + for most things. Some things to watch out for are + + - this port doesn't support dynamic loading. Although + OS/390 has support for DLLs, there are some differences + that cause problems for perl. + + - You may see a "WHOA THERE!!!" message for $d_shmatprototype + it is OK to keep the recommended "define". + + - Don't turn on the compiler optimization flag "-O". There's + a bug in either the optimizer or perl that causes perl to + not work correctly when the optimizer is on. + + - Some of the configuration files in /etc used by the + networking APIs are either missing or have the wrong + names. In particular, make sure that there's either + an /etc/resolv.conf or and /etc/hosts, so that + gethostbyname() works, and make sure that the file + /etc/proto has been renamed to /etc/protocol (NOT + /etc/protocols, as used by other Unix systems). + + When using perl on OS/390 please keep in mind that the EBCDIC and ASCII + character sets are different. Perl builtin functions that may behave + differently under EBCDIC are mentioned in the perlport.pod document. + + OpenEdition (UNIX System Services) does not (yet) support the #! means + of script invokation. + See: + + head `whence perldoc` + + for an example of how to use the "eval exec" trick to ask the shell to + have perl run your scripts for you. + + perl-mvs mailing list: The Perl Institute (http://www.perl.org/) + maintains a mailing list of interest to all folks building and/or + using perl on EBCDIC platforms. To subscibe, send a message of: + + subscribe perl-mvs + + to majordomo@perl.org. + + Regression tests: as the 5.005 kit was was being assembled + the following "failures" were known to appear on some machines + during `make test` (mostly due to ASCII vs. EBCDIC conflicts), + your results may differ: + + comp/cpp..........FAILED at test 0 + op/pack...........FAILED at test 58 + op/stat...........Out of memory! + op/taint..........FAILED at test 73 + lib/errno.........FAILED at test 1 + lib/posix.........FAILED at test 19 + lib/searchdict....FAILED at test 1 Index: README.threads ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/README.threads Thu Jul 23 23:59:38 1998 --- perl5.005_02/README.threads Sun Aug 2 19:30:17 1998 *************** *** 8,13 **** --- 8,15 ---- * Digital UNIX 4.x + * Digital UNIX 3.x (Formerly DEC OSF/1), see additional note below + * Solaris 2.x for recentish x (2.5 is OK) * IRIX 6.2 or newer. 6.2 will require a few os patches. *************** *** 59,64 **** --- 61,74 ---- Zap mallocobj and mallocsrc (foo='') Change d_mymalloc to undef + For Digital Unix 3.x (Formerly DEC OSF/1): + Add -DOLD_PTHREADS_API to ccflags + If compiling with the GNU cc compiler, remove -thread from ccflags + + (The following should be done automatically if you call Configure + with the -Dusethreads option). + Add -lpthread -lmach -lc_r to libs (in the order specified). + For IRIX: (This should all be done automatically by the hint file). Add -lpthread to libs *************** *** 150,162 **** Debugging ! Use the -DL command-line option to turn on debugging of the multi-threading code. Under Linux, that also turns on a quick hack I did to grab a bit of extra information from segfaults. If you have a fancier gdb/threads setup than I do then you'll have to delete the lines in perl.c which say #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) ! DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv);); #endif --- 160,172 ---- Debugging ! Use the -DS command-line option to turn on debugging of the multi-threading code. Under Linux, that also turns on a quick hack I did to grab a bit of extra information from segfaults. If you have a fancier gdb/threads setup than I do then you'll have to delete the lines in perl.c which say #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) ! DEBUG_S(signal(SIGSEGV, (void(*)(int))catch_sigsegv);); #endif Index: README.win32 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/README.win32 Sun Jul 26 17:04:47 1998 --- perl5.005_02/README.win32 Fri Aug 7 23:57:52 1998 *************** *** 1,694 **** ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see pod/perlpod.pod) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perlwin32 - Perl under Win32 ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under Windows NT (versions ! 3.51 or 4.0). Currently, this port is reported to build ! under Windows95 using the 4DOS shell--the default shell that infests ! Windows95 will not work (see below). Note this caveat is only about ! B perl. Once built, you should be able to B it on ! either Win32 platform (modulo the problems arising from the inferior ! command shell). ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! Also make sure you read L below for the ! known limitations of this port. ! ! The INSTALL file in the perl top-level has much information that is ! only relevant to people building Perl on Unix-like systems. In ! particular, you can safely ignore any information that talks about ! "Configure". ! ! You may also want to look at two other options for building ! a perl that will work on Windows NT: the README.cygwin32 and ! README.os2 files, which each give a different set of rules to build ! a Perl that will work on Win32 platforms. Those two methods will ! probably enable you to build a more Unix-compatible perl, but you ! will also need to download and use various other build-time and ! run-time support software described in those files. ! ! This set of instructions is meant to describe a so-called "native" ! port of Perl to Win32 platforms. The resulting Perl requires no ! additional software to run (other than what came with your operating ! system). Currently, this port is capable of using one of the ! following compilers: ! ! Borland C++ version 5.02 or later ! Microsoft Visual C++ version 4.2 or later ! Mingw32 with EGCS version 1.0.2 ! Mingw32 with GCC version 2.8.1 ! ! The last two of these are high quality freeware compilers. Support ! for them is still experimental. ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! See L below for general hints about this. ! ! =head2 Setting Up ! ! =over 4 ! ! =item Command Shell ! ! Use the default "cmd" shell that comes with NT. Some versions of the ! popular 4DOS/NT shell have incompatibilities that may cause you trouble. ! If the build fails under that shell, try building again with the cmd ! shell. The Makefile also has known incompatibilites with the "command.com" ! shell that comes with Windows95, so building under Windows95 should ! be considered "unsupported". However, there have been reports of successful ! build attempts using 4DOS/NT version 6.01 under Windows95, using dmake, but ! your mileage may vary. ! ! The surest way to build it is on WindowsNT, using the cmd shell. ! ! =item Borland C++ ! ! If you are using the Borland compiler, you will need dmake, a freely ! available make that has very nice macro features and parallelability. ! (The make that Borland supplies is seriously crippled, and will not ! work for MakeMaker builds.) ! ! A port of dmake for win32 platforms is available from: ! ! http://www-personal.umich.edu/~gsar/dmake-4.1-win32.zip ! ! Fetch and install dmake somewhere on your path (follow the instructions ! in the README.NOW file). ! ! =item Microsoft Visual C++ ! ! The NMAKE that comes with Visual C++ will suffice for building. ! You will need to run the VCVARS32.BAT file usually found somewhere ! like C:\MSDEV4.2\BIN. This will set your build environment. ! ! You can also use dmake to build using Visual C++, provided: ! you set OSRELEASE to "microsft" (or whatever the directory name ! under which the Visual C dmake configuration lives) in your environment, ! and edit win32/config.vc to change "make=nmake" into "make=dmake". The ! latter step is only essential if you want to use dmake as your default ! make for building extensions using MakeMaker. ! ! =item Mingw32 with EGCS or GCC ! ! ECGS-1.0.2 binaries can be downloaded from: ! ! ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/ ! ! GCC-2.8.1 binaries are available from: ! ! http://agnes.dida.physik.uni-essen.de/~janjaap/mingw32/ ! ! You only need either one of those, not both. Both bundles come with ! Mingw32 libraries and headers. While both of them work to build perl, ! the EGCS binaries are currently favored by the maintainers, since they ! come with more up-to-date Mingw32 libraries. ! ! Make sure you install the binaries as indicated in the web sites ! above. You will need to set up a few environment variables (usually ! run from a batch file). ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Make sure you are in the "win32" subdirectory under the perl toplevel. ! This directory contains a "Makefile" that will work with ! versions of NMAKE that come with Visual C++, and a dmake "makefile.mk" ! that will work for all supported compilers. The defaults in the dmake ! makefile are setup to build using the Borland compiler. ! ! =item * ! ! Edit the makefile.mk (or Makefile, if using nmake) and change the values ! of INST_DRV and INST_TOP. You can also enable various build ! flags. ! ! Beginning with version 5.005, there is experimental support for building ! a perl interpreter that supports the Perl Object abstraction (courtesy ! ActiveState Tool Corp.) PERL_OBJECT uses C++, and the binaries are ! therefore incompatible with the regular C build. However, the ! PERL_OBJECT build does provide something called the C-API, for linking ! it with extensions that won't compile under PERL_OBJECT. PERL_OBJECT ! is not yet supported under GCC or EGCS. WARNING: Binaries built with ! PERL_OBJECT enabled are B compatible with binaries built without. ! Perl installs PERL_OBJECT binaries under a distinct architecture name, ! so they B coexist, though. ! ! Beginning with version 5.005, there is experimental support for building ! a perl interpreter that is capable of native threading. Binaries built ! with thread support enabled are also incompatible with the vanilla C ! build. WARNING: Binaries built with threads enabled are B compatible ! with binaries built without. Perl installs threads enabled binaries under ! a distinct architecture name, so they B coexist, though. ! ! At the present time, you cannot enable both threading and PERL_OBJECT. ! You can get only one of them in a Perl interpreter. ! ! If you have either the source or a library that contains des_fcrypt(), ! enable the appropriate option in the makefile. des_fcrypt() is not ! bundled with the distribution due to US Government restrictions ! on the export of cryptographic software. Nevertheless, this routine ! is part of the "libdes" library (written by Ed Young) which is widely ! available worldwide, usually along with SSLeay (for example: ! "ftp://fractal.mta.ca/pub/crypto/SSLeay/DES/"). Set CRYPT_SRC to the ! name of the file that implements des_fcrypt(). Alternatively, if ! you have built a library that contains des_fcrypt(), you can set ! CRYPT_LIB to point to the library name. ! ! Perl will also build without des_fcrypt(), but the crypt() builtin will ! fail at run time. ! ! You will also have to make sure CCHOME points to wherever you installed ! your compiler. ! ! Other options are explained in the makefiles. Be sure to read the ! instructions carefully. ! ! =item * ! ! Type "dmake" (or "nmake" if you are using that make). ! ! This should build everything. Specifically, it will create perl.exe, ! perl.dll (or perlcore.dll), and perlglob.exe at the perl toplevel, and ! various other extension dll's under the lib\auto directory. If the build ! fails for any reason, make sure you have done the previous steps correctly. ! ! The build process may produce "harmless" compiler warnings (more or ! less copiously, depending on how picky your compiler gets). The ! maintainers are aware of these warnings, thankyouverymuch. :) ! ! When building using Visual C++, a perl95.exe will also get built. This ! executable is only needed on Windows95, and should be used instead of ! perl.exe, and then only if you want sockets to work properly on Windows95. ! This is necessitated by a bug in the Microsoft C Runtime that cannot be ! worked around in the "normal" perl.exe. perl95.exe gets built with its ! own private copy of the C Runtime that is not accessible to extensions ! (which see the DLL version of the CRT). Be aware, therefore, that this ! perl95.exe will have esoteric problems with extensions like perl/Tk that ! themselves use the C Runtime heavily, or want to free() pointers ! malloc()-ed by perl. ! ! You can avoid the perl95.exe problems completely if you use Borland ! C++ for building perl (perl95.exe is not needed and will not be built ! in that case). ! ! =back ! ! =head2 Testing ! ! Type "dmake test" (or "nmake test"). This will run most of the tests from ! the testsuite (many tests will be skipped, and but no test should fail). ! ! If some tests do fail, it may be because you are using a different command ! shell than the native "cmd.exe". ! ! If you used the Borland compiler, you may see a failure in op/taint.t ! arising from the inability to find the Borland Runtime DLLs on the system ! default path. You will need to copy the DLLs reported by the messages ! from where Borland chose to install it, into the Windows system directory ! (usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. ! ! The Visual C runtime apparently has a bug that causes posix.t to fail ! one it test#2. This usually happens only if you extracted the files in ! text mode. ! ! Please report any other failures as described under L. ! ! =head2 Installation ! ! Type "dmake install" (or "nmake install"). This will put the newly ! built perl and the libraries under whatever C points to in the ! Makefile. It will also install the pod documentation under ! C<$INST_TOP\$VERSION\lib\pod> and HTML versions of the same under ! C<$INST_TOP\$VERSION\lib\pod\html>. To use the Perl you just installed, ! you will need to add two components to your PATH environment variable, ! C<$INST_TOP\$VERSION\bin>, and C<$INST_TOP\$VERSION\bin\$ARCHNAME>. ! For example: ! ! set PATH c:\perl\5.005\bin;c:\perl\5.005\bin\MSWin32-x6;%PATH% ! ! ! =head2 Usage Hints ! ! =over 4 ! ! =item Environment Variables ! ! The installation paths that you set during the build get compiled ! into perl, so you don't have to do anything additional to start ! using that perl (except add its location to your PATH variable). ! ! If you put extensions in unusual places, you can set PERL5LIB ! to a list of paths separated by semicolons where you want perl ! to look for libraries. Look for descriptions of other environment ! variables you can set in L. ! ! You can also control the shell that perl uses to run system() and ! backtick commands via PERL5SHELL. See L. ! ! Currently, Perl does not depend on the registry, but can look up ! values if you choose to put them there. [XXX add registry locations ! that perl looks at here.] ! ! =item File Globbing ! ! By default, perl spawns an external program to do file globbing. ! The install process installs both a perlglob.exe and a perlglob.bat ! that perl can use for this purpose. Note that with the default ! installation, perlglob.exe will be found by the system before ! perlglob.bat. ! ! perlglob.exe relies on the argv expansion done by the C Runtime of ! the particular compiler you used, and therefore behaves very ! differently depending on the Runtime used to build it. To preserve ! compatiblity, perlglob.bat (a perl script that can be used portably) ! is installed. Besides being portable, perlglob.bat also offers ! enhanced globbing functionality. ! ! If you want perl to use perlglob.bat instead of perlglob.exe, just ! delete perlglob.exe from the install location (or move it somewhere ! perl cannot find). Using File::DosGlob.pm (which implements the core ! functionality of perlglob.bat) to override the internal CORE::glob() ! works about 10 times faster than spawing perlglob.exe, and you should ! take this approach when writing new modules. See File::DosGlob for ! details. ! ! =item Using perl from the command line ! ! If you are accustomed to using perl from various command-line ! shells found in UNIX environments, you will be less than pleased ! with what Windows NT offers by way of a command shell. ! ! The crucial thing to understand about the "cmd" shell (which is ! the default on Windows NT) is that it does not do any wildcard ! expansions of command-line arguments (so wildcards need not be ! quoted). It also provides only rudimentary quoting. The only ! (useful) quote character is the double quote ("). It can be used to ! protect spaces in arguments and other special characters. The ! Windows NT documentation has almost no description of how the ! quoting rules are implemented, but here are some general observations ! based on experiments: The shell breaks arguments at spaces and ! passes them to programs in argc/argv. Doublequotes can be used ! to prevent arguments with spaces in them from being split up. ! You can put a double quote in an argument by escaping it with ! a backslash and enclosing the whole argument within double quotes. ! The backslash and the pair of double quotes surrounding the ! argument will be stripped by the shell. ! ! The file redirection characters "<", ">", and "|" cannot be quoted ! by double quotes (there are probably more such). Single quotes ! will protect those three file redirection characters, but the ! single quotes don't get stripped by the shell (just to make this ! type of quoting completely useless). The caret "^" has also ! been observed to behave as a quoting character (and doesn't get ! stripped by the shell also). ! ! Here are some examples of usage of the "cmd" shell: ! ! This prints two doublequotes: ! ! perl -e "print '\"\"' " ! ! This does the same: ! ! perl -e "print \"\\\"\\\"\" " ! ! This prints "bar" and writes "foo" to the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" > blurch ! ! This prints "foo" ("bar" disappears into nowhereland): ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> nul ! ! This prints "bar" and writes "foo" into the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 1> blurch ! ! This pipes "foo" to the "less" pager and prints "bar" on the console: ! ! perl -e "print 'foo'; print STDERR 'bar'" | less ! ! This pipes "foo\nbar\n" to the less pager: ! ! perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less ! ! This pipes "foo" to the pager and writes "bar" in the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! ! ! Discovering the usefulness of the "command.com" shell on Windows95 ! is left as an exercise to the reader :) ! ! =item Building Extensions ! ! The Comprehensive Perl Archive Network (CPAN) offers a wealth ! of extensions, some of which require a C compiler to build. ! Look in http://www.perl.com/ for more information on CPAN. ! ! Most extensions (whether they require a C compiler or not) can ! be built, tested and installed with the standard mantra: ! ! perl Makefile.PL ! $MAKE ! $MAKE test ! $MAKE install ! ! where $MAKE stands for NMAKE or DMAKE. Some extensions may not ! provide a testsuite (so "$MAKE test" may not do anything, or fail), ! but most serious ones do. ! ! If a module implements XSUBs, you will need one of the supported ! C compilers. You must make sure you have set up the environment for ! the compiler for command-line compilation. ! ! If a module does not build for some reason, look carefully for ! why it failed, and report problems to the module author. If ! it looks like the extension building support is at fault, report ! that with full details of how the build failed using the perlbug ! utility. ! ! =item Command-line Wildcard Expansion ! ! The default command shells on DOS descendant operating systems (such ! as they are) usually do not expand wildcard arguments supplied to ! programs. They consider it the application's job to handle that. ! This is commonly achieved by linking the application (in our case, ! perl) with startup code that the C runtime libraries usually provide. ! However, doing that results in incompatible perl versions (since the ! behavior of the argv expansion code differs depending on the ! compiler, and it is even buggy on some compilers). Besides, it may ! be a source of frustration if you use such a perl binary with an ! alternate shell that *does* expand wildcards. ! ! Instead, the following solution works rather well. The nice things ! about it: 1) you can start using it right away 2) it is more powerful, ! because it will do the right thing with a pattern like */*/*.c ! 3) you can decide whether you do/don't want to use it 4) you can ! extend the method to add any customizations (or even entirely ! different kinds of wildcard expansion). ! ! C:\> copy con c:\perl\lib\Wild.pm ! # Wild.pm - emulate shell @ARGV expansion on shells that don't ! use File::DosGlob; ! @ARGV = map { ! my @g = File::DosGlob::glob($_) if /[*?]/; ! @g ? @g : $_; ! } @ARGV; ! 1; ! ^Z ! C:\> set PERL5OPT=-MWild ! C:\> perl -le "for (@ARGV) { print }" */*/perl*.c ! p4view/perl/perl.c ! p4view/perl/perlio.c ! p4view/perl/perly.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! ! Note there are two distinct steps there: 1) You'll have to create ! Wild.pm and put it in your perl lib directory. 2) You'll need to ! set the PERL5OPT environment variable. If you want argv expansion ! to be the default, just set PERL5OPT in your default startup ! environment. ! ! If you are using the Visual C compiler, you can get the C runtime's ! command line wildcard expansion built into perl binary. The resulting ! binary will always expand unquoted command lines, which may not be ! what you want if you use a shell that does that for you. The expansion ! done is also somewhat less powerful than the approach suggested above. ! ! =item Win32 Specific Extensions ! ! A number of extensions specific to the Win32 platform are available ! from CPAN. You may find that many of these extensions are meant to ! be used under the Activeware port of Perl, which used to be the only ! native port for the Win32 platform. Since the Activeware port does not ! have adequate support for Perl's extension building tools, these ! extensions typically do not support those tools either, and therefore ! cannot be built using the generic steps shown in the previous section. ! ! To ensure smooth transitioning of existing code that uses the ! ActiveState port, there is a bundle of Win32 extensions that contains ! all of the ActiveState extensions and most other Win32 extensions from ! CPAN in source form, along with many added bugfixes, and with MakeMaker ! support. This bundle is available at: ! ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.12.zip ! ! See the README in that distribution for building and installation ! instructions. Look for later versions that may be available at the ! same location. ! ! =item Running Perl Scripts ! ! Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to ! indicate to the OS that it should execute the file using perl. ! Win32 has no comparable means to indicate arbitrary files are ! executables. ! ! Instead, all available methods to execute plain text files on ! Win32 rely on the file "extension". There are three methods ! to use this to execute perl scripts: ! ! =over 8 ! ! =item 1 ! ! There is a facility called "file extension associations" that will ! work in Windows NT 4.0. This can be manipulated via the two ! commands "assoc" and "ftype" that come standard with Windows NT ! 4.0. Type "ftype /?" for a complete example of how to set this ! up for perl scripts (Say what? You thought Windows NT wasn't ! perl-ready? :). ! ! =item 2 ! ! Since file associations don't work everywhere, and there are ! reportedly bugs with file associations where it does work, the ! old method of wrapping the perl script to make it look like a ! regular batch file to the OS, may be used. The install process ! makes available the "pl2bat.bat" script which can be used to wrap ! perl scripts into batch files. For example: ! ! pl2bat foo.pl ! ! will create the file "FOO.BAT". Note "pl2bat" strips any ! .pl suffix and adds a .bat suffix to the generated file. ! ! If you use the 4DOS/NT or similar command shell, note that ! "pl2bat" uses the "%*" variable in the generated batch file to ! refer to all the command line arguments, so you may need to make ! sure that construct works in batch files. As of this writing, ! 4DOS/NT users will need a "ParameterChar = *" statement in their ! 4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT ! startup file to enable this to work. ! ! =item 3 ! ! Using "pl2bat" has a few problems: the file name gets changed, ! so scripts that rely on C<$0> to find what they must do may not ! run properly; running "pl2bat" replicates the contents of the ! original script, and so this process can be maintenance intensive ! if the originals get updated often. A different approach that ! avoids both problems is possible. ! ! A script called "runperl.bat" is available that can be copied ! to any filename (along with the .bat suffix). For example, ! if you call it "foo.bat", it will run the file "foo" when it is ! executed. Since you can run batch files on Win32 platforms simply ! by typing the name (without the extension), this effectively ! runs the file "foo", when you type either "foo" or "foo.bat". ! With this method, "foo.bat" can even be in a different location ! than the file "foo", as long as "foo" is available somewhere on ! the PATH. If your scripts are on a filesystem that allows symbolic ! links, you can even avoid copying "runperl.bat". ! ! Here's a diversion: copy "runperl.bat" to "runperl", and type ! "runperl". Explain the observed behavior, or lack thereof. :) ! Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH ! ! =back ! ! =item Miscellaneous Things ! ! A full set of HTML documentation is installed, so you should be ! able to use it if you have a web browser installed on your ! system. ! ! C is also a useful tool for browsing information contained ! in the documentation, especially in conjunction with a pager ! like C (recent versions of which have Win32 support). You may ! have to set the PAGER environment variable to use a specific pager. ! "perldoc -f foo" will print information about the perl operator ! "foo". ! ! If you find bugs in perl, you can run C to create a ! bug report (you may have to send it manually if C cannot ! find a mailer on your system). ! ! =back ! ! =head1 BUGS AND CAVEATS ! ! An effort has been made to ensure that the DLLs produced by the two ! supported compilers are compatible with each other (despite the ! best efforts of the compiler vendors). Extension binaries produced ! by one compiler should also coexist with a perl binary built by ! a different compiler. In order to accomplish this, PERL.DLL provides ! a layer of runtime code that uses the C Runtime that perl was compiled ! with. Extensions which include "perl.h" will transparently access ! the functions in this layer, thereby ensuring that both perl and ! extensions use the same runtime functions. ! ! If you have had prior exposure to Perl on Unix platforms, you will notice ! this port exhibits behavior different from what is documented. Most of the ! differences fall under one of these categories. We do not consider ! any of them to be serious limitations (especially when compared to the ! limited nature of some of the Win32 OSes themselves :) ! ! =over 8 ! ! =item * ! ! C and C functions may not behave as documented. They ! may return values that bear no resemblance to those reported on Unix ! platforms, and some fields (like the the one for inode) may be completely ! bogus. ! ! =item * ! ! The following functions are currently unavailable: C, ! C, C, C, C, C, ! C and related security functions, C, ! C, C, C, C, ! C, C, C, C, C, ! C<*netent()>, C<*protoent()>, C<*servent()>, C<*hostent()>, ! C. ! This list is possibly incomplete. ! ! =item * ! ! Various C related calls are supported, but they may not ! behave as on Unix platforms. ! ! =item * ! ! The four-argument C call is only supported on sockets. ! ! =item * ! ! The C call is only supported on sockets (where it provides the ! functionality of ioctlsocket() in the Winsock API). ! ! =item * ! ! Failure to spawn() a subprocess is indicated by setting $? to "255 << 8". ! C<$?> is set in a way compatible with Unix (i.e. the exitstatus of the ! subprocess is obtained by "$? >> 8", as described in the documentation). ! ! =item * ! ! You can expect problems building modules available on CPAN if you ! build perl itself with -DUSE_THREADS. These problems should be resolved ! as we get closer to 5.005. ! ! =item * ! ! C, C and process-related functions may not ! behave as described in the documentation, and some of the ! returned values or effects may be bogus. ! ! =item * ! ! Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). For instance, calling C ! or C from signal handlers will cause an exception, since most ! implementations of C on Win32 are severely crippled. ! Thus, signals may work only for simple things like setting a flag ! variable in the handler. Using signals under this port should ! currently be considered unsupported. ! ! =item * ! ! C is implemented, but doesn't have the semantics of ! C, i.e. it doesn't send a signal to the identified process ! like it does on Unix platforms. Instead it immediately calls ! C. Thus the signal argument is ! used to set the exit-status of the terminated process. This behavior ! may change in future. ! ! =item * ! ! File globbing may not behave as on Unix platforms. In particular, ! if you don't use perlglob.bat for globbing, it will understand ! wildcards only in the filename component (and not in the pathname). ! In other words, something like "print <*/*.pl>" will not print all the ! perl scripts in all the subdirectories one level under the current one ! (like it does on UNIX platforms). perlglob.exe is also dependent on ! the particular implementation of wildcard expansion in the vendor ! libraries used to build it (which varies wildly at the present time). ! Using perlglob.bat (or File::DosGlob) avoids these limitations, but ! still only provides DOS semantics (read "warts") for globbing. ! ! =back ! ! Please send detailed descriptions of any problems and solutions that ! you may find to >, along with the output produced ! by C. ! ! =head1 AUTHORS ! ! =over 4 ! ! Gary Ng E71564.1743@CompuServe.COME ! ! Gurusamy Sarathy Egsar@umich.eduE ! ! Nick Ing-Simmons Enick@ni-s.u-net.comE ! ! =back ! ! This document is maintained by Gurusamy Sarathy. ! ! =head1 SEE ALSO ! ! L ! ! =head1 HISTORY ! ! This port was originally contributed by Gary Ng around 5.003_24, ! and borrowed from the Hip Communications port that was available ! at the time. ! ! Nick Ing-Simmons and Gurusamy Sarathy have made numerous and ! sundry hacks since then. ! ! Borland support was added in 5.004_01 (Gurusamy Sarathy). ! ! Last updated: 12 July 1998 ! ! =cut ! --- 1,699 ---- ! If you read this file _as_is_, just ignore the funny characters you ! see. It is written in the POD format (see pod/perlpod.pod) which is ! specially designed to be readable as is. ! ! =head1 NAME ! ! perlwin32 - Perl under Win32 ! ! =head1 SYNOPSIS ! ! These are instructions for building Perl under Windows NT (versions ! 3.51 or 4.0). Currently, this port is reported to build ! under Windows95 using the 4DOS shell--the default shell that infests ! Windows95 will not work (see below). Note this caveat is only about ! B perl. Once built, you should be able to B it on ! either Win32 platform (modulo the problems arising from the inferior ! command shell). ! ! =head1 DESCRIPTION ! ! Before you start, you should glance through the README file ! found in the top-level directory where the Perl distribution ! was extracted. Make sure you read and understand the terms under ! which this software is being distributed. ! ! Also make sure you read L below for the ! known limitations of this port. ! ! The INSTALL file in the perl top-level has much information that is ! only relevant to people building Perl on Unix-like systems. In ! particular, you can safely ignore any information that talks about ! "Configure". ! ! You may also want to look at two other options for building ! a perl that will work on Windows NT: the README.cygwin32 and ! README.os2 files, which each give a different set of rules to build ! a Perl that will work on Win32 platforms. Those two methods will ! probably enable you to build a more Unix-compatible perl, but you ! will also need to download and use various other build-time and ! run-time support software described in those files. ! ! This set of instructions is meant to describe a so-called "native" ! port of Perl to Win32 platforms. The resulting Perl requires no ! additional software to run (other than what came with your operating ! system). Currently, this port is capable of using one of the ! following compilers: ! ! Borland C++ version 5.02 or later ! Microsoft Visual C++ version 4.2 or later ! Mingw32 with EGCS version 1.0.2 ! Mingw32 with GCC version 2.8.1 ! ! The last two of these are high quality freeware compilers. Support ! for them is still experimental. ! ! This port currently supports MakeMaker (the set of modules that ! is used to build extensions to perl). Therefore, you should be ! able to build and install most extensions found in the CPAN sites. ! See L below for general hints about this. ! ! =head2 Setting Up ! ! =over 4 ! ! =item Command Shell ! ! Use the default "cmd" shell that comes with NT. Some versions of the ! popular 4DOS/NT shell have incompatibilities that may cause you trouble. ! If the build fails under that shell, try building again with the cmd ! shell. The Makefile also has known incompatibilites with the "command.com" ! shell that comes with Windows95, so building under Windows95 should ! be considered "unsupported". However, there have been reports of successful ! build attempts using 4DOS/NT version 6.01 under Windows95, using dmake, but ! your mileage may vary. ! ! The surest way to build it is on WindowsNT, using the cmd shell. ! ! =item Borland C++ ! ! If you are using the Borland compiler, you will need dmake, a freely ! available make that has very nice macro features and parallelability. ! (The make that Borland supplies is seriously crippled, and will not ! work for MakeMaker builds.) ! ! A port of dmake for win32 platforms is available from: ! ! http://www-personal.umich.edu/~gsar/dmake-4.1-win32.zip ! ! Fetch and install dmake somewhere on your path (follow the instructions ! in the README.NOW file). ! ! =item Microsoft Visual C++ ! ! The NMAKE that comes with Visual C++ will suffice for building. ! You will need to run the VCVARS32.BAT file usually found somewhere ! like C:\MSDEV4.2\BIN. This will set your build environment. ! ! You can also use dmake to build using Visual C++, provided: ! you set OSRELEASE to "microsft" (or whatever the directory name ! under which the Visual C dmake configuration lives) in your environment, ! and edit win32/config.vc to change "make=nmake" into "make=dmake". The ! latter step is only essential if you want to use dmake as your default ! make for building extensions using MakeMaker. ! ! =item Mingw32 with EGCS or GCC ! ! ECGS-1.0.2 binaries can be downloaded from: ! ! ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/ ! ! GCC-2.8.1 binaries are available from: ! ! http://agnes.dida.physik.uni-essen.de/~janjaap/mingw32/ ! ! You only need either one of those, not both. Both bundles come with ! Mingw32 libraries and headers. While both of them work to build perl, ! the EGCS binaries are currently favored by the maintainers, since they ! come with more up-to-date Mingw32 libraries. ! ! Make sure you install the binaries as indicated in the web sites ! above. You will need to set up a few environment variables (usually ! run from a batch file). ! ! =back ! ! =head2 Building ! ! =over 4 ! ! =item * ! ! Make sure you are in the "win32" subdirectory under the perl toplevel. ! This directory contains a "Makefile" that will work with ! versions of NMAKE that come with Visual C++, and a dmake "makefile.mk" ! that will work for all supported compilers. The defaults in the dmake ! makefile are setup to build using the Borland compiler. ! ! =item * ! ! Edit the makefile.mk (or Makefile, if using nmake) and change the values ! of INST_DRV and INST_TOP. You can also enable various build ! flags. ! ! Beginning with version 5.005, there is experimental support for building ! a perl interpreter that supports the Perl Object abstraction (courtesy ! ActiveState Tool Corp.) PERL_OBJECT uses C++, and the binaries are ! therefore incompatible with the regular C build. However, the ! PERL_OBJECT build does provide something called the C-API, for linking ! it with extensions that won't compile under PERL_OBJECT. PERL_OBJECT ! is not yet supported under GCC or EGCS. WARNING: Binaries built with ! PERL_OBJECT enabled are B compatible with binaries built without. ! Perl installs PERL_OBJECT binaries under a distinct architecture name, ! so they B coexist, though. ! ! Beginning with version 5.005, there is experimental support for building ! a perl interpreter that is capable of native threading. Binaries built ! with thread support enabled are also incompatible with the vanilla C ! build. WARNING: Binaries built with threads enabled are B compatible ! with binaries built without. Perl installs threads enabled binaries under ! a distinct architecture name, so they B coexist, though. ! ! At the present time, you cannot enable both threading and PERL_OBJECT. ! You can get only one of them in a Perl interpreter. ! ! If you have either the source or a library that contains des_fcrypt(), ! enable the appropriate option in the makefile. des_fcrypt() is not ! bundled with the distribution due to US Government restrictions ! on the export of cryptographic software. Nevertheless, this routine ! is part of the "libdes" library (written by Ed Young) which is widely ! available worldwide, usually along with SSLeay (for example: ! "ftp://fractal.mta.ca/pub/crypto/SSLeay/DES/"). Set CRYPT_SRC to the ! name of the file that implements des_fcrypt(). Alternatively, if ! you have built a library that contains des_fcrypt(), you can set ! CRYPT_LIB to point to the library name. The location above contains ! many versions of the "libdes" library, all with slightly different ! implementations of des_fcrypt(). Older versions have a single, ! self-contained file (fcrypt.c) that implements crypt(), so they may be ! easier to use. A patch against the fcrypt.c found in libdes-3.06 is ! in des_fcrypt.patch. ! ! Perl will also build without des_fcrypt(), but the crypt() builtin will ! fail at run time. ! ! You will also have to make sure CCHOME points to wherever you installed ! your compiler. ! ! Other options are explained in the makefiles. Be sure to read the ! instructions carefully. ! ! =item * ! ! Type "dmake" (or "nmake" if you are using that make). ! ! This should build everything. Specifically, it will create perl.exe, ! perl.dll (or perlcore.dll), and perlglob.exe at the perl toplevel, and ! various other extension dll's under the lib\auto directory. If the build ! fails for any reason, make sure you have done the previous steps correctly. ! ! The build process may produce "harmless" compiler warnings (more or ! less copiously, depending on how picky your compiler gets). The ! maintainers are aware of these warnings, thankyouverymuch. :) ! ! When building using Visual C++, a perl95.exe will also get built. This ! executable is only needed on Windows95, and should be used instead of ! perl.exe, and then only if you want sockets to work properly on Windows95. ! This is necessitated by a bug in the Microsoft C Runtime that cannot be ! worked around in the "normal" perl.exe. perl95.exe gets built with its ! own private copy of the C Runtime that is not accessible to extensions ! (which see the DLL version of the CRT). Be aware, therefore, that this ! perl95.exe will have esoteric problems with extensions like perl/Tk that ! themselves use the C Runtime heavily, or want to free() pointers ! malloc()-ed by perl. ! ! You can avoid the perl95.exe problems completely if you use Borland ! C++ for building perl (perl95.exe is not needed and will not be built ! in that case). ! ! =back ! ! =head2 Testing ! ! Type "dmake test" (or "nmake test"). This will run most of the tests from ! the testsuite (many tests will be skipped, and but no test should fail). ! ! If some tests do fail, it may be because you are using a different command ! shell than the native "cmd.exe". ! ! If you used the Borland compiler, you may see a failure in op/taint.t ! arising from the inability to find the Borland Runtime DLLs on the system ! default path. You will need to copy the DLLs reported by the messages ! from where Borland chose to install it, into the Windows system directory ! (usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. ! ! The Visual C runtime apparently has a bug that causes posix.t to fail ! one it test#2. This usually happens only if you extracted the files in ! text mode. ! ! Please report any other failures as described under L. ! ! =head2 Installation ! ! Type "dmake install" (or "nmake install"). This will put the newly ! built perl and the libraries under whatever C points to in the ! Makefile. It will also install the pod documentation under ! C<$INST_TOP\$VERSION\lib\pod> and HTML versions of the same under ! C<$INST_TOP\$VERSION\lib\pod\html>. To use the Perl you just installed, ! you will need to add two components to your PATH environment variable, ! C<$INST_TOP\$VERSION\bin>, and C<$INST_TOP\$VERSION\bin\$ARCHNAME>. ! For example: ! ! set PATH c:\perl\5.005\bin;c:\perl\5.005\bin\MSWin32-x6;%PATH% ! ! ! =head2 Usage Hints ! ! =over 4 ! ! =item Environment Variables ! ! The installation paths that you set during the build get compiled ! into perl, so you don't have to do anything additional to start ! using that perl (except add its location to your PATH variable). ! ! If you put extensions in unusual places, you can set PERL5LIB ! to a list of paths separated by semicolons where you want perl ! to look for libraries. Look for descriptions of other environment ! variables you can set in L. ! ! You can also control the shell that perl uses to run system() and ! backtick commands via PERL5SHELL. See L. ! ! Currently, Perl does not depend on the registry, but can look up ! values if you choose to put them there. [XXX add registry locations ! that perl looks at here.] ! ! =item File Globbing ! ! By default, perl spawns an external program to do file globbing. ! The install process installs both a perlglob.exe and a perlglob.bat ! that perl can use for this purpose. Note that with the default ! installation, perlglob.exe will be found by the system before ! perlglob.bat. ! ! perlglob.exe relies on the argv expansion done by the C Runtime of ! the particular compiler you used, and therefore behaves very ! differently depending on the Runtime used to build it. To preserve ! compatiblity, perlglob.bat (a perl script that can be used portably) ! is installed. Besides being portable, perlglob.bat also offers ! enhanced globbing functionality. ! ! If you want perl to use perlglob.bat instead of perlglob.exe, just ! delete perlglob.exe from the install location (or move it somewhere ! perl cannot find). Using File::DosGlob.pm (which implements the core ! functionality of perlglob.bat) to override the internal CORE::glob() ! works about 10 times faster than spawing perlglob.exe, and you should ! take this approach when writing new modules. See File::DosGlob for ! details. ! ! =item Using perl from the command line ! ! If you are accustomed to using perl from various command-line ! shells found in UNIX environments, you will be less than pleased ! with what Windows NT offers by way of a command shell. ! ! The crucial thing to understand about the "cmd" shell (which is ! the default on Windows NT) is that it does not do any wildcard ! expansions of command-line arguments (so wildcards need not be ! quoted). It also provides only rudimentary quoting. The only ! (useful) quote character is the double quote ("). It can be used to ! protect spaces in arguments and other special characters. The ! Windows NT documentation has almost no description of how the ! quoting rules are implemented, but here are some general observations ! based on experiments: The shell breaks arguments at spaces and ! passes them to programs in argc/argv. Doublequotes can be used ! to prevent arguments with spaces in them from being split up. ! You can put a double quote in an argument by escaping it with ! a backslash and enclosing the whole argument within double quotes. ! The backslash and the pair of double quotes surrounding the ! argument will be stripped by the shell. ! ! The file redirection characters "<", ">", and "|" cannot be quoted ! by double quotes (there are probably more such). Single quotes ! will protect those three file redirection characters, but the ! single quotes don't get stripped by the shell (just to make this ! type of quoting completely useless). The caret "^" has also ! been observed to behave as a quoting character (and doesn't get ! stripped by the shell also). ! ! Here are some examples of usage of the "cmd" shell: ! ! This prints two doublequotes: ! ! perl -e "print '\"\"' " ! ! This does the same: ! ! perl -e "print \"\\\"\\\"\" " ! ! This prints "bar" and writes "foo" to the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" > blurch ! ! This prints "foo" ("bar" disappears into nowhereland): ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> nul ! ! This prints "bar" and writes "foo" into the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 1> blurch ! ! This pipes "foo" to the "less" pager and prints "bar" on the console: ! ! perl -e "print 'foo'; print STDERR 'bar'" | less ! ! This pipes "foo\nbar\n" to the less pager: ! ! perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less ! ! This pipes "foo" to the pager and writes "bar" in the file "blurch": ! ! perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! ! ! Discovering the usefulness of the "command.com" shell on Windows95 ! is left as an exercise to the reader :) ! ! =item Building Extensions ! ! The Comprehensive Perl Archive Network (CPAN) offers a wealth ! of extensions, some of which require a C compiler to build. ! Look in http://www.perl.com/ for more information on CPAN. ! ! Most extensions (whether they require a C compiler or not) can ! be built, tested and installed with the standard mantra: ! ! perl Makefile.PL ! $MAKE ! $MAKE test ! $MAKE install ! ! where $MAKE stands for NMAKE or DMAKE. Some extensions may not ! provide a testsuite (so "$MAKE test" may not do anything, or fail), ! but most serious ones do. ! ! If a module implements XSUBs, you will need one of the supported ! C compilers. You must make sure you have set up the environment for ! the compiler for command-line compilation. ! ! If a module does not build for some reason, look carefully for ! why it failed, and report problems to the module author. If ! it looks like the extension building support is at fault, report ! that with full details of how the build failed using the perlbug ! utility. ! ! =item Command-line Wildcard Expansion ! ! The default command shells on DOS descendant operating systems (such ! as they are) usually do not expand wildcard arguments supplied to ! programs. They consider it the application's job to handle that. ! This is commonly achieved by linking the application (in our case, ! perl) with startup code that the C runtime libraries usually provide. ! However, doing that results in incompatible perl versions (since the ! behavior of the argv expansion code differs depending on the ! compiler, and it is even buggy on some compilers). Besides, it may ! be a source of frustration if you use such a perl binary with an ! alternate shell that *does* expand wildcards. ! ! Instead, the following solution works rather well. The nice things ! about it: 1) you can start using it right away 2) it is more powerful, ! because it will do the right thing with a pattern like */*/*.c ! 3) you can decide whether you do/don't want to use it 4) you can ! extend the method to add any customizations (or even entirely ! different kinds of wildcard expansion). ! ! C:\> copy con c:\perl\lib\Wild.pm ! # Wild.pm - emulate shell @ARGV expansion on shells that don't ! use File::DosGlob; ! @ARGV = map { ! my @g = File::DosGlob::glob($_) if /[*?]/; ! @g ? @g : $_; ! } @ARGV; ! 1; ! ^Z ! C:\> set PERL5OPT=-MWild ! C:\> perl -le "for (@ARGV) { print }" */*/perl*.c ! p4view/perl/perl.c ! p4view/perl/perlio.c ! p4view/perl/perly.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! perl5.005/win32/perlglob.c ! perl5.005/win32/perllib.c ! ! Note there are two distinct steps there: 1) You'll have to create ! Wild.pm and put it in your perl lib directory. 2) You'll need to ! set the PERL5OPT environment variable. If you want argv expansion ! to be the default, just set PERL5OPT in your default startup ! environment. ! ! If you are using the Visual C compiler, you can get the C runtime's ! command line wildcard expansion built into perl binary. The resulting ! binary will always expand unquoted command lines, which may not be ! what you want if you use a shell that does that for you. The expansion ! done is also somewhat less powerful than the approach suggested above. ! ! =item Win32 Specific Extensions ! ! A number of extensions specific to the Win32 platform are available ! from CPAN. You may find that many of these extensions are meant to ! be used under the Activeware port of Perl, which used to be the only ! native port for the Win32 platform. Since the Activeware port does not ! have adequate support for Perl's extension building tools, these ! extensions typically do not support those tools either, and therefore ! cannot be built using the generic steps shown in the previous section. ! ! To ensure smooth transitioning of existing code that uses the ! ActiveState port, there is a bundle of Win32 extensions that contains ! all of the ActiveState extensions and most other Win32 extensions from ! CPAN in source form, along with many added bugfixes, and with MakeMaker ! support. This bundle is available at: ! ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.12.zip ! ! See the README in that distribution for building and installation ! instructions. Look for later versions that may be available at the ! same location. ! ! =item Running Perl Scripts ! ! Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to ! indicate to the OS that it should execute the file using perl. ! Win32 has no comparable means to indicate arbitrary files are ! executables. ! ! Instead, all available methods to execute plain text files on ! Win32 rely on the file "extension". There are three methods ! to use this to execute perl scripts: ! ! =over 8 ! ! =item 1 ! ! There is a facility called "file extension associations" that will ! work in Windows NT 4.0. This can be manipulated via the two ! commands "assoc" and "ftype" that come standard with Windows NT ! 4.0. Type "ftype /?" for a complete example of how to set this ! up for perl scripts (Say what? You thought Windows NT wasn't ! perl-ready? :). ! ! =item 2 ! ! Since file associations don't work everywhere, and there are ! reportedly bugs with file associations where it does work, the ! old method of wrapping the perl script to make it look like a ! regular batch file to the OS, may be used. The install process ! makes available the "pl2bat.bat" script which can be used to wrap ! perl scripts into batch files. For example: ! ! pl2bat foo.pl ! ! will create the file "FOO.BAT". Note "pl2bat" strips any ! .pl suffix and adds a .bat suffix to the generated file. ! ! If you use the 4DOS/NT or similar command shell, note that ! "pl2bat" uses the "%*" variable in the generated batch file to ! refer to all the command line arguments, so you may need to make ! sure that construct works in batch files. As of this writing, ! 4DOS/NT users will need a "ParameterChar = *" statement in their ! 4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT ! startup file to enable this to work. ! ! =item 3 ! ! Using "pl2bat" has a few problems: the file name gets changed, ! so scripts that rely on C<$0> to find what they must do may not ! run properly; running "pl2bat" replicates the contents of the ! original script, and so this process can be maintenance intensive ! if the originals get updated often. A different approach that ! avoids both problems is possible. ! ! A script called "runperl.bat" is available that can be copied ! to any filename (along with the .bat suffix). For example, ! if you call it "foo.bat", it will run the file "foo" when it is ! executed. Since you can run batch files on Win32 platforms simply ! by typing the name (without the extension), this effectively ! runs the file "foo", when you type either "foo" or "foo.bat". ! With this method, "foo.bat" can even be in a different location ! than the file "foo", as long as "foo" is available somewhere on ! the PATH. If your scripts are on a filesystem that allows symbolic ! links, you can even avoid copying "runperl.bat". ! ! Here's a diversion: copy "runperl.bat" to "runperl", and type ! "runperl". Explain the observed behavior, or lack thereof. :) ! Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH ! ! =back ! ! =item Miscellaneous Things ! ! A full set of HTML documentation is installed, so you should be ! able to use it if you have a web browser installed on your ! system. ! ! C is also a useful tool for browsing information contained ! in the documentation, especially in conjunction with a pager ! like C (recent versions of which have Win32 support). You may ! have to set the PAGER environment variable to use a specific pager. ! "perldoc -f foo" will print information about the perl operator ! "foo". ! ! If you find bugs in perl, you can run C to create a ! bug report (you may have to send it manually if C cannot ! find a mailer on your system). ! ! =back ! ! =head1 BUGS AND CAVEATS ! ! An effort has been made to ensure that the DLLs produced by the two ! supported compilers are compatible with each other (despite the ! best efforts of the compiler vendors). Extension binaries produced ! by one compiler should also coexist with a perl binary built by ! a different compiler. In order to accomplish this, PERL.DLL provides ! a layer of runtime code that uses the C Runtime that perl was compiled ! with. Extensions which include "perl.h" will transparently access ! the functions in this layer, thereby ensuring that both perl and ! extensions use the same runtime functions. ! ! If you have had prior exposure to Perl on Unix platforms, you will notice ! this port exhibits behavior different from what is documented. Most of the ! differences fall under one of these categories. We do not consider ! any of them to be serious limitations (especially when compared to the ! limited nature of some of the Win32 OSes themselves :) ! ! =over 8 ! ! =item * ! ! C and C functions may not behave as documented. They ! may return values that bear no resemblance to those reported on Unix ! platforms, and some fields (like the the one for inode) may be completely ! bogus. ! ! =item * ! ! The following functions are currently unavailable: C, ! C, C, C, C, C, ! C and related security functions, C, ! C, C, C, C, ! C, C, C, C, C, ! C<*netent()>, C<*protoent()>, C<*servent()>, C<*hostent()>, ! C. ! This list is possibly incomplete. ! ! =item * ! ! Various C related calls are supported, but they may not ! behave as on Unix platforms. ! ! =item * ! ! The four-argument C call is only supported on sockets. ! ! =item * ! ! The C call is only supported on sockets (where it provides the ! functionality of ioctlsocket() in the Winsock API). ! ! =item * ! ! Failure to spawn() a subprocess is indicated by setting $? to "255 << 8". ! C<$?> is set in a way compatible with Unix (i.e. the exitstatus of the ! subprocess is obtained by "$? >> 8", as described in the documentation). ! ! =item * ! ! You can expect problems building modules available on CPAN if you ! build perl itself with -DUSE_THREADS. These problems should be resolved ! as we get closer to 5.005. ! ! =item * ! ! C, C and process-related functions may not ! behave as described in the documentation, and some of the ! returned values or effects may be bogus. ! ! =item * ! ! Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). For instance, calling C ! or C from signal handlers will cause an exception, since most ! implementations of C on Win32 are severely crippled. ! Thus, signals may work only for simple things like setting a flag ! variable in the handler. Using signals under this port should ! currently be considered unsupported. ! ! =item * ! ! C is implemented, but doesn't have the semantics of ! C, i.e. it doesn't send a signal to the identified process ! like it does on Unix platforms. Instead it immediately calls ! C. Thus the signal argument is ! used to set the exit-status of the terminated process. This behavior ! may change in future. ! ! =item * ! ! File globbing may not behave as on Unix platforms. In particular, ! if you don't use perlglob.bat for globbing, it will understand ! wildcards only in the filename component (and not in the pathname). ! In other words, something like "print <*/*.pl>" will not print all the ! perl scripts in all the subdirectories one level under the current one ! (like it does on UNIX platforms). perlglob.exe is also dependent on ! the particular implementation of wildcard expansion in the vendor ! libraries used to build it (which varies wildly at the present time). ! Using perlglob.bat (or File::DosGlob) avoids these limitations, but ! still only provides DOS semantics (read "warts") for globbing. ! ! =back ! ! Please send detailed descriptions of any problems and solutions that ! you may find to >, along with the output produced ! by C. ! ! =head1 AUTHORS ! ! =over 4 ! ! Gary Ng E71564.1743@CompuServe.COME ! ! Gurusamy Sarathy Egsar@umich.eduE ! ! Nick Ing-Simmons Enick@ni-s.u-net.comE ! ! =back ! ! This document is maintained by Gurusamy Sarathy. ! ! =head1 SEE ALSO ! ! L ! ! =head1 HISTORY ! ! This port was originally contributed by Gary Ng around 5.003_24, ! and borrowed from the Hip Communications port that was available ! at the time. ! ! Nick Ing-Simmons and Gurusamy Sarathy have made numerous and ! sundry hacks since then. ! ! Borland support was added in 5.004_01 (Gurusamy Sarathy). ! ! Last updated: 12 July 1998 ! ! =cut ! Index: configure.com ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/configure.com Thu Jul 23 23:59:43 1998 --- perl5.005_02/configure.com Sun Aug 2 01:07:00 1998 *************** *** 1,23 **** $ sav_ver = 'F$VERIFY(0)' $! SET VERIFY $! - $! Installation and usage: COPY this file into you perl source tree - at or - $! below where the main MANIFEST. file is located. - $! $! For example, if you unpacked perl into: [USER.PERL5_00n...] then you will ! $! want to: ! $! ! $! $ COPY Configure.com [USER.PERL5_00n.VMS] ! $! ! $! Now cd into the tree and execute Configure: $! $! $ SET DEFAULT [USER.PERL5_00n] ! $! $ @[.vms]Configure $! $! or $! $! $ SET DEFAULT [USER.PERL5_00n] ! $! $ @[.vms]Configure "-des" $! $! That's it. If you get into a bind trying to build perl on VMS then $! definitely read through the README.VMS file. --- 1,16 ---- $ sav_ver = 'F$VERIFY(0)' $! SET VERIFY $! $! For example, if you unpacked perl into: [USER.PERL5_00n...] then you will ! $! want to cd into the tree and execute Configure: $! $! $ SET DEFAULT [USER.PERL5_00n] ! $! $ @Configure $! $! or $! $! $ SET DEFAULT [USER.PERL5_00n] ! $! $ @Configure "-des" $! $! That's it. If you get into a bind trying to build perl on VMS then $! definitely read through the README.VMS file. *************** *** 388,393 **** --- 381,388 ---- $ ELSE $! MANIFEST. has been found and we have set def'ed there - $! time to bail out before it's too late. + $ tmp = f$extract(1,3,f$edit(f$getsyi("VERSION"),"TRIM,COLLAPSE")) + $ IF tmp .GES. "7.2" THEN GOTO Beyond_depth_check $ IF (F$ELEMENT(max_allowed_dir_depth,".",F$ENVIRONMENT("Default")).nes.".") $ THEN $ TYPE SYS$INPUT: *************** *** 400,405 **** --- 395,401 ---- $ STOP $ EXIT !2 !$STATUS = "%X00000002" (error) $ ENDIF + $Beyond_depth_check: $! $! after finding MANIFEST let's create (but not yet enter) the UU subdirectory $! *************** *** 874,880 **** $ ENDIF $ IF (archname.EQS."VMS_AXP") $ THEN ! $ dflt = "N" $ rp = "Are you sharing your PERL_ROOT with a VAX? [''dflt'] " $ GOSUB myread $ if ans.NES."" --- 870,876 ---- $ ENDIF $ IF (archname.EQS."VMS_AXP") $ THEN ! $ dflt = "n" $ rp = "Are you sharing your PERL_ROOT with a VAX? [''dflt'] " $ GOSUB myread $ if ans.NES."" *************** *** 1657,1663 **** $ THEN $ dflt = "DECC" $ else ! $ dlft = "SOCKETSHR" $ endif $ rp = "Choose socket stack (NONE" $ if "''has_socketshr'".eqs."T" THEN rp = rp + ",SOCKETSHR" --- 1653,1659 ---- $ THEN $ dflt = "DECC" $ else ! $ dflt = "SOCKETSHR" $ endif $ rp = "Choose socket stack (NONE" $ if "''has_socketshr'".eqs."T" THEN rp = rp + ",SOCKETSHR" *************** *** 1700,1706 **** $ echo "unpatched 7.1 system. (Several OS patches were required when $ echo "this procedure was written) $ echo "" ! $ dflt = "N" $ rp = "Enable multiple kernel threads and upcalls? [''dflt'] " $ gosub myread $ if ans.eqs."" then ans="''dflt'" --- 1696,1702 ---- $ echo "unpatched 7.1 system. (Several OS patches were required when $ echo "this procedure was written) $ echo "" ! $ dflt = "n" $ rp = "Enable multiple kernel threads and upcalls? [''dflt'] " $ gosub myread $ if ans.eqs."" then ans="''dflt'" *************** *** 1727,1733 **** $ echo "a time penalty (to spawn the subprocess) every time you invoke $ echo "perl. Depending on your system, this might not be a big deal. $ echo "" ! $ dflt = "N" $ rp = "Populate %ENV at startup time? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" --- 1723,1729 ---- $ echo "a time penalty (to spawn the subprocess) every time you invoke $ echo "perl. Depending on your system, this might not be a big deal. $ echo "" ! $ dflt = "n" $ rp = "Populate %ENV at startup time? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" *************** *** 1740,1746 **** $ echo "system memory allocator. It also has the advantage of providing $ echo "memory allocation statistics, if you choose to enable them. $ echo "" ! $ dflt = "N" $ rp = "Build with perl's memory allocator? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" --- 1736,1742 ---- $ echo "system memory allocator. It also has the advantage of providing $ echo "memory allocation statistics, if you choose to enable them. $ echo "" ! $ dflt = "n" $ rp = "Build with perl's memory allocator? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" *************** *** 1754,1760 **** $ echo "them. This is useful for debugging, but does have some $ echo "performance overhead. $ echo "" ! $ dflt = "N" $ rp = "Do you want the debugging memory allocator? [''dflt'] " $ gosub myread $ if ans.eqs."" then ans="''dflt'" --- 1750,1756 ---- $ echo "them. This is useful for debugging, but does have some $ echo "performance overhead. $ echo "" ! $ dflt = "n" $ rp = "Do you want the debugging memory allocator? [''dflt'] " $ gosub myread $ if ans.eqs."" then ans="''dflt'" *************** *** 1935,1941 **** $! Invoke the subconfig piece $! $ echo "" ! $ echo4 "Generating config.h" $ dflt = F$ENVIRONMENT("DEFAULT") $ SET DEFAULT [-.vms] $ @subconfigure --- 1931,1937 ---- $! Invoke the subconfig piece $! $ echo "" ! $ echo4 "Checking the C Run time library" $ dflt = F$ENVIRONMENT("DEFAULT") $ SET DEFAULT [-.vms] $ @subconfigure Index: doio.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/doio.c Thu Jul 23 23:59:45 1998 --- perl5.005_02/doio.c Sun Aug 2 01:15:06 1998 *************** *** 125,146 **** } if (as_raw) { ! result = rawmode & 3; ! IoTYPE(io) = "<>++"[result]; writing = (result > 0); fd = PerlLIO_open3(name, rawmode, rawperm); if (fd == -1) fp = NULL; else { char *fpmode; ! if (result == 0) fpmode = "r"; #ifdef O_APPEND else if (rawmode & O_APPEND) ! fpmode = (result == 1) ? "a" : "a+"; #endif else ! fpmode = (result == 1) ? "w" : "r+"; fp = PerlIO_fdopen(fd, fpmode); if (!fp) PerlLIO_close(fd); --- 125,161 ---- } if (as_raw) { ! #ifndef O_ACCMODE ! #define O_ACCMODE 3 /* Assume traditional implementation */ ! #endif ! switch (result = rawmode & O_ACCMODE) { ! case O_RDONLY: ! IoTYPE(io) = '<'; ! break; ! case O_WRONLY: ! IoTYPE(io) = '>'; ! break; ! case O_RDWR: ! default: ! IoTYPE(io) = '+'; ! break; ! } ! writing = (result > 0); fd = PerlLIO_open3(name, rawmode, rawperm); + if (fd == -1) fp = NULL; else { char *fpmode; ! if (result == O_RDONLY) fpmode = "r"; #ifdef O_APPEND else if (rawmode & O_APPEND) ! fpmode = (result == O_WRONLY) ? "a" : "a+"; #endif else ! fpmode = (result == O_WRONLY) ? "w" : "r+"; fp = PerlIO_fdopen(fd, fpmode); if (!fp) PerlLIO_close(fd); *************** *** 400,406 **** sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); ! if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,0,0,Nullfp)) { if (PL_inplace) { TAINT_PROPER("inplace open"); if (oldlen == 1 && *PL_oldname == '-') { --- 415,421 ---- sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); ! if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) { if (PL_inplace) { TAINT_PROPER("inplace open"); if (oldlen == 1 && *PL_oldname == '-') { *************** *** 462,468 **** do_close(gv,FALSE); (void)PerlLIO_unlink(SvPVX(sv)); (void)PerlLIO_rename(PL_oldname,SvPVX(sv)); ! do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,0,0,Nullfp); #endif /* DOSISH */ #else (void)UNLINK(SvPVX(sv)); --- 477,483 ---- do_close(gv,FALSE); (void)PerlLIO_unlink(SvPVX(sv)); (void)PerlLIO_rename(PL_oldname,SvPVX(sv)); ! do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp); #endif /* DOSISH */ #else (void)UNLINK(SvPVX(sv)); Index: ebcdic.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ebcdic.c Sat Aug 8 00:41:28 1998 --- perl5.005_02/ebcdic.c Sun Aug 2 01:15:06 1998 *************** *** 0 **** --- 1,32 ---- + #include "EXTERN.h" + #include "perl.h" + + /* in ASCII order, not that it matters */ + static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; + + int + ebcdic_control(int ch) + { + if (ch > 'a') { + char *ctlp; + + if (islower(ch)) + ch = toupper(ch); + + if ((ctlp = strchr(controllablechars, ch)) == 0) { + die("unrecognised control character '%c'\n", ch); + } + + if (ctlp == controllablechars) + return('\177'); /* DEL */ + else + return((unsigned char)(ctlp - controllablechars - 1)); + } else { /* Want uncontrol */ + if (ch == '\177' || ch == -1) + return('?'); + else if (0 < ch && ch < (sizeof(controllablechars) - 1)) + return(controllablechars[ch+1]); + else + die("invalid control request: '\\%03o'\n", ch & 0xFF); + } + } Index: emacs/cperl-mode.el Prereq: 3.14 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/emacs/cperl-mode.el Thu Jul 23 23:59:53 1998 --- perl5.005_02/emacs/cperl-mode.el Wed Aug 5 05:18:12 1998 *************** *** 46,52 **** ;;; Commentary: ! ;; $Id: cperl-mode.el 3.14 1998/07/03 00:32:02 vera Exp vera $ ;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into ;;; your .emacs file: --- 46,52 ---- ;;; Commentary: ! ;; $Id: cperl-mode.el 4.5 1998/07/28 08:55:41 vera Exp vera $ ;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into ;;; your .emacs file: *************** *** 737,742 **** --- 737,805 ---- ;;; (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE ;;; made into a string. + ;;;; After 3.14: + ;;; (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step + ;;; Recognition of was wrong. + ;;; (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones + ;;; (`cperl-unwind-to-safe'): New function. + ;;; (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position. + + ;;;; After 3.15: + ;;; (`cperl-forward-re'): Highlight the trailing / in s/foo// as string. + ;;; Highlight the starting // in s//foo/ as function-name. + + ;;;; After 3.16: + ;;; (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword. + + ;;;; After 4.0: + ;;; (`cperl-find-pods-heres'): `qr' added + ;;; (`cperl-electric-keyword'): Likewise + ;;; (`cperl-electric-else'): Likewise + ;;; (`cperl-to-comment-or-eol'): Likewise + ;;; (`cperl-make-regexp-x'): Likewise + ;;; (`cperl-init-faces'): Likewise, and `lock' (as overridable?). + ;;; (`cperl-find-pods-heres'): Knows that split// is null-RE. + ;;; Highlights separators in 3-parts expressions + ;;; as labels. + + ;;;; After 4.1: + ;;; (`cperl-find-pods-heres'): <> was considered as a glob + ;;; (`cperl-syntaxify-unwind'): New configuration variable + ;;; (`cperl-fontify-m-as-s'): New configuration variable + + ;;;; After 4.2: + ;;; (`cperl-find-pods-heres'): of the last line being `=head1' fixed. + + ;;; Handling of a long construct is still buggy if only the part of + ;;; construct touches the updated region (we unwind to the start of + ;;; long construct, but the end may have residual properties). + + ;;; (`cperl-unwind-to-safe'): would not go to beginning of buffer. + ;;; (`cperl-electric-pod'): check for after-expr was performed + ;;; inside of POD too. + + ;;;; After 4.3: + ;;; (`cperl-backward-to-noncomment'): better treatment of PODs and HEREs. + + ;;; Indent-line works good, but indent-region does not - at toplevel... + ;;; (`cperl-unwind-to-safe'): Signature changed. + ;;; (`x-color-defined-p'): was defmacro'ed with a tick. Remove another def. + ;;; (`cperl-clobber-mode-lists'): New configuration variable. + ;;; (`cperl-array-face'): One of definitions was garbled. + + ;;;; After 4.4: + ;;; (`cperl-not-bad-regexp'): Updated. + ;;; (`cperl-make-regexp-x'): Misprint in a message. + ;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp. + ;;; `<< (' was considered a start of POD. + ;;; Init: `cperl-is-face' was busted. + ;;; (`cperl-make-face'): New macros. + ;;; (`cperl-force-face'): New macros. + ;;; (`cperl-init-faces'): Corrected to use new macros; + ;;; `if' for copying `reference-face' to + ;;; `constant-face' was backward. + ;;; (`font-lock-other-type-face'): Done via `defface' too. + ;;; Code: *************** *** 757,778 **** nil)) ;; Avoid warning (tmp definitions) (or (fboundp 'x-color-defined-p) ! (defmacro 'x-color-defined-p (col) (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) ;; XEmacs >= 19.12 ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) ;; XEmacs 19.11 (t (` (x-valid-color-name-p (, col))))))) ! (fset 'cperl-is-face (cond ((fboundp 'find-face) ! (symbol-function 'find-face)) ! ((and (fboundp 'face-list) ! (face-list)) ! (function (lambda (face) ! (member face (and (fboundp 'face-list) ! (face-list)))))) (t ! (function (lambda (face) (boundp face)))))))) (require 'custom) (defun cperl-choose-color (&rest list) --- 820,852 ---- nil)) ;; Avoid warning (tmp definitions) (or (fboundp 'x-color-defined-p) ! (defmacro x-color-defined-p (col) (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) ;; XEmacs >= 19.12 ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) ;; XEmacs 19.11 (t (` (x-valid-color-name-p (, col))))))) ! (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) ! (` (find-face (, arg)))) ! (;;(and (fboundp 'face-list) ! ;; (face-list)) ! (fboundp 'face-list) ! (` (member (, arg) (and (fboundp 'face-list) ! (face-list))))) (t ! (` (boundp (, arg)))))) ! (defmacro cperl-make-face (arg descr) ; Takes unquoted arg ! (cond ((fboundp 'make-face) ! (` (make-face (quote (, arg))))) ! (t ! (` (defconst (, arg) (quote (, arg)) (, descr)))))) ! (defmacro cperl-force-face (arg descr) ; Takes unquoted arg ! (` (progn ! (or (cperl-is-face (quote (, arg))) ! (cperl-make-face (, arg) (, descr))) ! (or (boundp (quote (, arg))) ; We use unquoted variants too ! (defconst (, arg) (quote (, arg)) (, descr)))))))) (require 'custom) (defun cperl-choose-color (&rest list) *************** *** 980,985 **** --- 1054,1069 ---- :type '(repeat (list symbol string)) :group 'cperl) + (defcustom cperl-clobber-mode-lists + (not + (and + (boundp 'interpreter-mode-alist) + (assoc "miniperl" interpreter-mode-alist) + (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) + "*Whether to install us into `interpreter-' and `extension' mode lists." + :type 'boolean + :group 'cperl) + (defcustom cperl-info-on-command-no-prompt nil "*Not-nil (and non-null) means not to prompt on C-h f. The opposite behaviour is always available if prefixed with C-c. *************** *** 1021,1026 **** --- 1105,1115 ---- :type 'boolean :group 'cperl-faces) + (defcustom cperl-fontify-m-as-s t + "*Not-nil means highlight 1arg regular expressions operators same as 2arg." + :type 'boolean + :group 'cperl-faces) + (defcustom cperl-pod-here-scan t "*Not-nil means look for pod and here-docs sections during startup. You can always make lookup from menu or using \\[cperl-find-pods-heres]." *************** *** 1131,1140 **** --- 1220,1251 ---- :type '(choice (const message) boolean) :group 'cperl-speed) + (defcustom cperl-syntaxify-unwind + t + "*Non-nil means that CPerl unwinds to a start of along construction + when syntaxifying a chunk of buffer." + :type 'boolean + :group 'cperl-speed) + (if window-system (progn (defvar cperl-dark-background (cperl-choose-color "navy" "os2blue" "darkgreen")) + (defvar cperl-dark-foreground + (cperl-choose-color "orchid1" "orange")) + + (defface font-lock-other-type-face + (` ((((class grayscale) (background light)) + (:background "Gray90" :italic t :underline t)) + (((class grayscale) (background dark)) + (:foreground "Gray80" :italic t :underline t :bold t)) + (((class color) (background light)) + (:foreground "chartreuse3")) + (((class color) (background dark)) + (:foreground (, cperl-dark-foreground))) + (t (:bold t :underline t)))) + "Font Lock mode face used to highlight array names." + :group 'cperl-faces) (defface cperl-array-face (` ((((class grayscale) (background light)) *************** *** 1358,1363 **** --- 1469,1477 ---- to B if A; + n) Highlights (by user-choice) either 3-delimiters constructs + (such as tr/a/b/), or regular expressions and `y/tr'. + 5) The indentation engine was very smart, but most of tricks may be not needed anymore with the support for `syntax-table' property. Has progress indicator for indentation (with `imenu' loaded). *************** *** 1414,1419 **** --- 1528,1536 ---- syntax-engine-helping scan, thus will make many more Perl constructs be wrongly recognized by CPerl, thus may lead to wrongly matched parentheses, wrong indentation, etc. + + One can unset `cperl-syntaxify-unwind'. This might speed up editing + of, say, long POD sections. ") *************** *** 1472,1480 **** 'lazy-lock) "Text property which inhibits refontification.") ! (defsubst cperl-put-do-not-fontify (from to) ! (put-text-property (max (point-min) (1- from)) ! to cperl-do-not-fontify t)) (defcustom cperl-mode-hook nil "Hook run by `cperl-mode'." --- 1589,1600 ---- 'lazy-lock) "Text property which inhibits refontification.") ! (defsubst cperl-put-do-not-fontify (from to &optional post) ! ;; If POST, do not do it with postponed fontification ! (if (and post cperl-syntaxify-by-font-lock) ! nil ! (put-text-property (max (point-min) (1- from)) ! to cperl-do-not-fontify t))) (defcustom cperl-mode-hook nil "Hook run by `cperl-mode'." *************** *** 1495,1505 **** ;;; Probably it is too late to set these guys already, but it can help later: ! (setq auto-mode-alist (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) ! (and (boundp 'interpreter-mode-alist) ! (setq interpreter-mode-alist (append interpreter-mode-alist ! '(("miniperl" . perl-mode))))) (if (fboundp 'eval-when-compile) (eval-when-compile (condition-case nil --- 1615,1626 ---- ;;; Probably it is too late to set these guys already, but it can help later: ! (and cperl-clobber-mode-lists ! (setq auto-mode-alist (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) ! (and (boundp 'interpreter-mode-alist) ! (setq interpreter-mode-alist (append interpreter-mode-alist ! '(("miniperl" . perl-mode)))))) (if (fboundp 'eval-when-compile) (eval-when-compile (condition-case nil *************** *** 1563,1576 **** (cperl-define-key "\177" 'cperl-electric-backspace) (cperl-define-key "\t" 'cperl-indent-command) ;; don't clobber the backspace binding: - (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command - [(control c) (control h) f]) (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command [(control c) (control h) F]) - (cperl-define-key "\C-c\C-hv" - ;;(concat (char-to-string help-char) "v") ; does not work - 'cperl-get-help - [(control c) (control h) v]) (if (cperl-val 'cperl-clobber-lisp-bindings) (progn (cperl-define-key "\C-hf" --- 1684,1691 ---- *************** *** 1580,1586 **** (cperl-define-key "\C-hv" ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help ! [(control h) v]))) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn --- 1695,1715 ---- (cperl-define-key "\C-hv" ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help ! [(control h) v]) ! (cperl-define-key "\C-c\C-hf" ! ;;(concat (char-to-string help-char) "f") ; does not work ! (key-binding "\C-hf") ! [(control c) (control h) f]) ! (cperl-define-key "\C-c\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! (key-binding "\C-hv") ! [(control c) (control h) v])) ! (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command ! [(control c) (control h) f]) ! (cperl-define-key "\C-c\C-hv" ! ;;(concat (char-to-string help-char) "v") ; does not work ! 'cperl-get-help ! [(control c) (control h) v])) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn *************** *** 2357,2363 **** (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (or --- 2486,2492 ---- (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (or *************** *** 2429,2434 **** --- 2558,2564 ---- (forward-char -1) (bolp)) (or + (get-text-property (point) 'in-pod) (cperl-after-expr-p nil "{;:") (and (re-search-backward "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t) *************** *** 2489,2495 **** (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (looking-at "=cut") --- 2619,2625 ---- (save-excursion (not (re-search-backward ! "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (looking-at "=cut") *************** *** 2846,2852 **** (backward-sexp) ;; Need take into account `bless', `return', `tr',... (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax ! (not (looking-at "\\(bless\\|return\\|qw\\|tr\\|[smy]\\)\\>"))) (progn (skip-chars-backward " \t\n\f") (and (memq (char-syntax (preceding-char)) '(?w ?_)) --- 2976,2982 ---- (backward-sexp) ;; Need take into account `bless', `return', `tr',... (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax ! (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>"))) (progn (skip-chars-backward " \t\n\f") (and (memq (char-syntax (preceding-char)) '(?w ?_)) *************** *** 2911,2917 **** (if parse-data (progn (setcar parse-data pre-indent-point) ! (setcar (cdr parse-data) state))) ;; (or parse-start (null symbol) ;; (setq parse-start (symbol-value symbol) ;; start-indent (nth 2 parse-start) --- 3041,3048 ---- (if parse-data (progn (setcar parse-data pre-indent-point) ! (setcar (cdr parse-data) state) ! (setq old-indent (nth 2 parse-data)))) ;; (or parse-start (null symbol) ;; (setq parse-start (symbol-value symbol) ;; start-indent (nth 2 parse-start) *************** *** 2962,2970 **** ;; in which case this line is the first argument decl. (skip-chars-forward " \t") (+ start-indent ! (if (= (following-char) ?{) cperl-continued-brace-offset 0) (progn ! (cperl-backward-to-noncomment (or (car parse-data) (point-min))) ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. --- 3093,3101 ---- ;; in which case this line is the first argument decl. (skip-chars-forward " \t") (+ start-indent ! (if (= char-after ?{) cperl-continued-brace-offset 0) (progn ! (cperl-backward-to-noncomment (or old-indent (point-min))) ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. *************** *** 2980,2986 **** (forward-sexp -1) (skip-chars-backward " \t") (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) ! 0 cperl-continued-statement-offset)))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: --- 3111,3122 ---- (forward-sexp -1) (skip-chars-backward " \t") (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) ! (progn ! (if (and parse-data ! (not (eq char-after ?\C-j))) ! (setcdr (cdr parse-data) ! (list pre-indent-point))) ! 0) cperl-continued-statement-offset)))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: *************** *** 3331,3337 **** "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" lim 'move) (setq stop-in t))) ! ((looking-at "\\(m\\|q\\([qxw]\\)?\\)\\>") (or (re-search-forward "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" lim 'move) --- 3467,3473 ---- "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" lim 'move) (setq stop-in t))) ! ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") (or (re-search-forward "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" lim 'move) *************** *** 3371,3379 **** (while (re-search-forward "^\\s(" e 'to-end) (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) ! (defun cperl-commentify (bb e string) (if cperl-use-syntax-table-text-property ! (progn ;; We suppose that e is _after_ the end of construction, as after eol. (setq string (if string cperl-st-sfence cperl-st-cfence)) (cperl-modify-syntax-type bb string) --- 3507,3516 ---- (while (re-search-forward "^\\s(" e 'to-end) (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct)))) ! (defun cperl-commentify (bb e string &optional noface) (if cperl-use-syntax-table-text-property ! (if (eq noface 'n) ; Only immediate ! nil ;; We suppose that e is _after_ the end of construction, as after eol. (setq string (if string cperl-st-sfence cperl-st-cfence)) (cperl-modify-syntax-type bb string) *************** *** 3381,3387 **** (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) ! (cperl-protect-defun-start bb e)))) (defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument &optional ostart oend) --- 3518,3533 ---- (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) ! (cperl-protect-defun-start bb e)) ! ;; Fontify ! (or noface ! (not cperl-pod-here-fontify) ! (put-text-property bb e 'face (if string 'font-lock-string-face ! 'font-lock-comment-face))))) ! (defvar cperl-starters '(( ?\( . ?\) ) ! ( ?\[ . ?\] ) ! ( ?\{ . ?\} ) ! ( ?\< . ?\> ))) (defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument &optional ostart oend) *************** *** 3392,3403 **** ;; ender means matching-char matcher. (setq b (point) starter (char-after b) ! ;; ender: ! ender (cdr (assoc starter '(( ?\( . ?\) ) ! ( ?\[ . ?\] ) ! ( ?\{ . ?\} ) ! ( ?\< . ?\> ) ! )))) ;; What if starter == ?\\ ???? (if set-st (if (car st-l) --- 3538,3544 ---- ;; ender means matching-char matcher. (setq b (point) starter (char-after b) ! ender (cdr (assoc starter cperl-starters))) ;; What if starter == ?\\ ???? (if set-st (if (car st-l) *************** *** 3419,3424 **** --- 3560,3567 ---- (modify-syntax-entry ender (concat ")" (list starter)) st))) (condition-case bb (progn + ;; We use `$' syntax class to find matching stuff, but $$ + ;; is recognized the same as $, so we need to check this manually. (if (and (eq starter (char-after (cperl-1+ b))) (not ender)) ;; $ has TeXish matching rules, so $$ equiv $... *************** *** 3434,3439 **** --- 3577,3583 ---- (forward-char -2) (= 0 (% (skip-chars-backward "\\\\") 2))) (forward-char -1))) + ;; Now we are after the first part. (and is-2arg ; Have trailing part (not ender) (eq (following-char) starter) ; Empty trailing part *************** *** 3456,3470 **** (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)) (setq set-st nil) ! (setq ! ender ! (cperl-forward-re lim end nil t st-l err-l argument starter ender) ! ender (nth 2 ender))))) (error (goto-char lim) (setq set-st nil) (or end (message ! "End of `%s%s%c ... %c' string not found: %s" argument (if ostart (format "%c ... %c" ostart (or oend ostart)) "") starter (or ender starter) bb) --- 3600,3613 ---- (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)) (setq set-st nil) ! (setq ender (cperl-forward-re lim end nil t st-l err-l ! argument starter ender) ! ender (nth 2 ender))))) (error (goto-char lim) (setq set-st nil) (or end (message ! "End of `%s%s%c ... %c' string/RE not found: %s" argument (if ostart (format "%c ... %c" ostart (or oend ostart)) "") starter (or ender starter) bb) *************** *** 3473,3483 **** (progn (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)))) (list i i2 ender starter go-forward))) (defvar font-lock-string-face) ! (defvar font-lock-reference-face) (defvar font-lock-constant-face) (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify --- 3616,3664 ---- (progn (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) (if ender (modify-syntax-entry ender "." st)))) + ;; i: have 2 args, after end of the first arg + ;; i2: start of the second arg, if any (before delim iff `ender'). + ;; ender: the last arg bounded by parens-like chars, the second one of them + ;; starter: the starting delimiter of the first arg + ;; go-forward: has 2 args, and the second part is empth (list i i2 ender starter go-forward))) (defvar font-lock-string-face) ! ;;(defvar font-lock-reference-face) (defvar font-lock-constant-face) + (defsubst cperl-postpone-fontification (b e type val &optional now) + ;; Do after syntactic fontification? + (if cperl-syntaxify-by-font-lock + (or now (put-text-property b e 'cperl-postpone (cons type val))) + (put-text-property b e type val))) + + ;;; Here is how the global structures (those which cannot be + ;;; recognized locally) are marked: + ;; a) PODs: + ;; Start-to-end is marked `in-pod' ==> t + ;; Each non-literal part is marked `syntax-type' ==> `pod' + ;; Each literal part is marked `syntax-type' ==> `in-pod' + ;; b) HEREs: + ;; Start-to-end is marked `here-doc-group' ==> t + ;; The body is marked `syntax-type' ==> `here-doc' + ;; The delimiter is marked `syntax-type' ==> `here-doc-delim' + ;; a) FORMATs: + ;; After-initial-line--to-end is marked `syntax-type' ==> `format' + + (defun cperl-unwind-to-safe (before) + (let ((pos (point))) + (while (and pos (get-text-property pos 'syntax-type)) + (setq pos (previous-single-property-change pos 'syntax-type)) + (if pos + (if before + (progn + (goto-char (cperl-1- pos)) + (beginning-of-line) + (setq pos (point))) + (goto-char (setq pos (cperl-1- pos)))) + ;; Up to the start + (goto-char (point-min)))))) + (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify *************** *** 3505,3510 **** --- 3686,3702 ---- (font-lock-string-face (if (boundp 'font-lock-string-face) font-lock-string-face 'font-lock-string-face)) + (font-lock-constant-face (if (boundp 'font-lock-constant-face) + font-lock-constant-face + 'font-lock-constant-face)) + (font-lock-function-name-face + (if (boundp 'font-lock-function-name-face) + font-lock-function-name-face + 'font-lock-function-name-face)) + (font-lock-other-type-face + (if (boundp 'font-lock-other-type-face) + font-lock-other-type-face + 'font-lock-other-type-face)) (stop-point (if ignore-max (point-max) max)) *************** *** 3533,3539 **** (concat "\\|" ;; 1+6+2=9 extra () before this: ! "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" "\\|" ;; 1+6+2+1=10 extra () before this: "\\([?/<]\\)" ; /blah/ or ?blah? or --- 3725,3731 ---- (concat "\\|" ;; 1+6+2=9 extra () before this: ! "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" "\\|" ;; 1+6+2+1=10 extra () before this: "\\([?/<]\\)" ; /blah/ or ?blah? or *************** *** 3562,3568 **** head-face cperl-pod-head-face here-face cperl-here-face)) (remove-text-properties min max ! '(syntax-type t in-pod t syntax-table t)) ;; Need to remove face as well... (goto-char min) (and (eq system-type 'emx) --- 3754,3761 ---- head-face cperl-pod-head-face here-face cperl-here-face)) (remove-text-properties min max ! '(syntax-type t in-pod t syntax-table t ! cperl-postpone t)) ;; Need to remove face as well... (goto-char min) (and (eq system-type 'emx) *************** *** 3586,3637 **** (setq b (point) bb b ! tb (match-beginning 0)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random (or (re-search-forward "\n\n=cut\\>" stop-point 'toend) (progn (message "End of a POD section not marked by =cut") (or (car err-l) (setcar err-l b)))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) ! (and (> e max) ! (progn ! (remove-text-properties ! max e '(syntax-type t in-pod t syntax-table t)) ! (setq tmpend tb))) ! (put-text-property b e 'in-pod t) ! (goto-char b) ! (while (re-search-forward "\n\n[ \t]" e t) ! ;; We start 'pod 1 char earlier to include the preceding line ! (beginning-of-line) ! (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) ! (cperl-put-do-not-fontify b (point)) ! (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) ! (re-search-forward "\n\n[^ \t\f\n]" e 'toend) ! (beginning-of-line) ! (setq b (point))) ! (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) ! (cperl-put-do-not-fontify (point) e) ! (if cperl-pod-here-fontify ! (progn (put-text-property (point) e 'face face) ! (goto-char bb) ! (if (looking-at ! "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ! (put-text-property ! (match-beginning 1) (match-end 1) ! 'face head-face)) ! (while (re-search-forward ! ;; One paragraph ! "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" ! e 'toend) ! (put-text-property ! (match-beginning 1) (match-end 1) ! 'face head-face)))) ! (cperl-commentify bb e nil) ! (goto-char e) ! (or (eq e (point-max)) ! (forward-char -1)))) ; Prepare for immediate pod start. ;; Here document ;; We do only one here-per-line ;; ;; One extra () before this: --- 3779,3843 ---- (setq b (point) bb b ! tb (match-beginning 0) ! b1 nil) ; error condition ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random (or (re-search-forward "\n\n=cut\\>" stop-point 'toend) (progn (message "End of a POD section not marked by =cut") + (setq b1 t) (or (car err-l) (setcar err-l b)))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) ! (if (and b1 (eobp)) ! ;; Unrecoverable error ! nil ! (and (> e max) ! (progn ! (remove-text-properties ! max e '(syntax-type t in-pod t syntax-table t ! 'cperl-postpone t)) ! (setq tmpend tb))) ! (put-text-property b e 'in-pod t) ! (put-text-property b e 'syntax-type 'in-pod) ! (goto-char b) ! (while (re-search-forward "\n\n[ \t]" e t) ! ;; We start 'pod 1 char earlier to include the preceding line ! (beginning-of-line) ! (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) ! (cperl-put-do-not-fontify b (point) t) ! ;; mark the non-literal parts as PODs ! (if cperl-pod-here-fontify ! (cperl-postpone-fontification b (point) 'face face t)) ! (re-search-forward "\n\n[^ \t\f\n]" e 'toend) ! (beginning-of-line) ! (setq b (point))) ! (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) ! (cperl-put-do-not-fontify (point) e t) ! (if cperl-pod-here-fontify ! (progn ! ;; mark the non-literal parts as PODs ! (cperl-postpone-fontification (point) e 'face face t) ! (goto-char bb) ! (if (looking-at ! "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ! ;; mark the headers ! (cperl-postpone-fontification ! (match-beginning 1) (match-end 1) ! 'face head-face)) ! (while (re-search-forward ! ;; One paragraph ! "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" ! e 'toend) ! ;; mark the headers ! (cperl-postpone-fontification ! (match-beginning 1) (match-end 1) ! 'face head-face)))) ! (cperl-commentify bb e nil) ! (goto-char e) ! (or (eq e (point-max)) ! (forward-char -1))))) ; Prepare for immediate pod start. ;; Here document ;; We do only one here-per-line ;; ;; One extra () before this: *************** *** 3661,3667 **** (match-beginning 5) (not (match-beginning 6)) ; Empty (looking-at ! "[ \t]*[=0-9$@%&]")))) (if c ; Not here-doc nil ; Skip it. (if (match-beginning 5) ;4 + 1 --- 3867,3873 ---- (match-beginning 5) (not (match-beginning 6)) ; Empty (looking-at ! "[ \t]*[=0-9$@%&(]")))) (if c ; Not here-doc nil ; Skip it. (if (match-beginning 5) ;4 + 1 *************** *** 3672,3679 **** (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify ! (put-text-property b1 e1 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b1 e1))) (forward-line) (setq b (point)) ;; We do not search to max, since we may be called from --- 3878,3886 ---- (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify ! ;; Highlight the starting delimiter ! (cperl-postpone-fontification b1 e1 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b1 e1 t))) (forward-line) (setq b (point)) ;; We do not search to max, since we may be called from *************** *** 3682,3691 **** stop-point 'toend) (if cperl-pod-here-fontify (progn ! (put-text-property (match-beginning 0) (match-end 0) 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b (match-end 0)) ! (put-text-property b (match-beginning 0) 'face here-face))) (setq e1 (cperl-1+ (match-end 0))) (put-text-property b (match-beginning 0) --- 3889,3900 ---- stop-point 'toend) (if cperl-pod-here-fontify (progn ! ;; Highlight the ending delimiter ! (cperl-postpone-fontification (match-beginning 0) (match-end 0) 'face font-lock-constant-face) ! (cperl-put-do-not-fontify b (match-end 0) t) ! ;; Highlight the HERE-DOC ! (cperl-postpone-fontification b (match-beginning 0) 'face here-face))) (setq e1 (cperl-1+ (match-end 0))) (put-text-property b (match-beginning 0) *************** *** 3695,3701 **** (put-text-property b e1 'here-doc-group t) (cperl-commentify b e1 nil) ! (cperl-put-do-not-fontify b (match-end 0)) (if (> e1 max) (setq tmpend tb))) (t (message "End of here-document `%s' not found." tag) --- 3904,3910 ---- (put-text-property b e1 'here-doc-group t) (cperl-commentify b e1 nil) ! (cperl-put-do-not-fontify b (match-end 0) t) (if (> e1 max) (setq tmpend tb))) (t (message "End of here-document `%s' not found." tag) *************** *** 3726,3745 **** (setq b1 (point)) (setq argument (looking-at "^[^\n]*[@^]")) (end-of-line) ! (put-text-property b1 (point) 'face font-lock-string-face) (cperl-commentify b1 (point) nil) ! (cperl-put-do-not-fontify b1 (point))))) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random (re-search-forward "^[.;]$" stop-point 'toend)) (beginning-of-line) ! (if (looking-at "^[.;]$") (progn ! (put-text-property (point) (+ (point) 2) 'face font-lock-string-face) (cperl-commentify (point) (+ (point) 2) nil) ! (cperl-put-do-not-fontify (point) (+ (point) 2))) (message "End of format `%s' not found." name) (or (car err-l) (setcar err-l b))) (forward-line) --- 3935,3956 ---- (setq b1 (point)) (setq argument (looking-at "^[^\n]*[@^]")) (end-of-line) ! ;; Highlight the format line ! (cperl-postpone-fontification b1 (point) 'face font-lock-string-face) (cperl-commentify b1 (point) nil) ! (cperl-put-do-not-fontify b1 (point) t)))) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random (re-search-forward "^[.;]$" stop-point 'toend)) (beginning-of-line) ! (if (looking-at "^\\.$") ; ";" is not supported yet (progn ! ;; Highlight the ending delimiter ! (cperl-postpone-fontification (point) (+ (point) 2) 'face font-lock-string-face) (cperl-commentify (point) (+ (point) 2) nil) ! (cperl-put-do-not-fontify (point) (+ (point) 2) t)) (message "End of format `%s' not found." name) (or (car err-l) (setcar err-l b))) (forward-line) *************** *** 3749,3755 **** ;; Regexp: ((or (match-beginning 10) (match-beginning 11)) ;; 1+6+2=9 extra () before this: ! ;; "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" ;; "\\|" ;; "\\([?/<]\\)" ; /blah/ or ?blah? or (setq b1 (if (match-beginning 10) 10 11) --- 3960,3966 ---- ;; Regexp: ((or (match-beginning 10) (match-beginning 11)) ;; 1+6+2=9 extra () before this: ! ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ;; "\\|" ;; "\\([?/<]\\)" ; /blah/ or ?blah? or (setq b1 (if (match-beginning 10) 10 11) *************** *** 3759,3773 **** i b c (char-after (match-beginning b1)) bb (char-after (1- (match-beginning b1))) ; tmp holder ! bb (and ; user variables/whatever ! (match-beginning 10) ! (or ! (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y ! (and (eq bb ?-) (eq c ?s)) ; -s file test ! (and (eq bb ?\&) ; &&m/blah/ ! (not (eq (char-after ! (- (match-beginning b1) 2)) ! ?\&))))) tb (match-beginning 0)) (goto-char (match-beginning b1)) (cperl-backward-to-noncomment (point-min)) --- 3970,3988 ---- i b c (char-after (match-beginning b1)) bb (char-after (1- (match-beginning b1))) ; tmp holder ! bb (if (eq b1 10) ; user variables/whatever ! (or ! (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y ! (and (eq bb ?-) (eq c ?s)) ; -s file test ! (and (eq bb ?\&) ; &&m/blah/ ! (not (eq (char-after ! (- (match-beginning b1) 2)) ! ?\&)))) ! ;; or <$file> ! (and (eq c ?\<) ! (save-match-data ! (looking-at ! "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>")))) tb (match-beginning 0)) (goto-char (match-beginning b1)) (cperl-backward-to-noncomment (point-min)) *************** *** 3793,3799 **** ;;; functions/builtins which expect an argument, but ... (if (eq (preceding-char) ?-) ;; -d ?foo? is a RE ! (looking-at "\\w\\>") (looking-at "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))) (and (eq (preceding-char) ?.) --- 4008,4014 ---- ;;; functions/builtins which expect an argument, but ... (if (eq (preceding-char) ?-) ;; -d ?foo? is a RE ! (looking-at "[a-zA-Z]\\>") (looking-at "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))) (and (eq (preceding-char) ?.) *************** *** 3806,3816 **** (not (bobp)) (progn (forward-char -1) ! (looking-at "\\s|")))) ! ;; or <$file> ! (not ! (and (eq c ?\<) ! (looking-at "\\s *\\$?[_a-zA-Z:][_a-zA-Z0-9:]*\\s *>")))))) b (1- b)) ;; s y tr m ;; Check for $a->y --- 4021,4027 ---- (not (bobp)) (progn (forward-char -1) ! (looking-at "\\s|"))))))) b (1- b)) ;; s y tr m ;; Check for $a->y *************** *** 3831,3875 **** ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. (setq b (point) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random i (cperl-forward-re stop-point end ! (string-match "^\\([sy]\\|tr\\)$" argument) t st-l err-l argument) ! i2 (nth 1 i) ; start of the second part ! e1 (nth 2 i) ; ender, true if matching second part go (nth 4 i) ; There is a 1-char part after the end i (car i) ; intermediate point ! tail (if (and i (not e1)) (1- (point))) ! e nil) ; need to preserve backslashitis ;; Commenting \\ is dangerous, what about ( ? (and i tail (eq (char-after i) ?\\) ! (setq e t)) (if (null i) (progn (cperl-commentify b (point) t) ! (if go (forward-char 1))) (cperl-commentify b i t) (if (looking-at "\\sw*e") ; s///e (progn (and ;; silent: ! (cperl-find-pods-heres i2 (1- (point)) t end) ;; Error (goto-char (1+ max))) ! (if (and e1 (eq (preceding-char) ?\>)) (progn (cperl-modify-syntax-type (1- (point)) cperl-st-ket) (cperl-modify-syntax-type i cperl-st-bra)))) ! (cperl-commentify i2 (point) t) ! (if e (cperl-modify-syntax-type (1+ i) cperl-st-punct)) (setq tail nil))) (if (eq (char-syntax (following-char)) ?w) (progn (forward-word 1) ; skip modifiers s///s ! (if tail (cperl-commentify tail (point) t)))) (if (> (point) max) (setq tmpend tb)))) ((match-beginning 13) ; sub with prototypes --- 4042,4133 ---- ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. (setq b (point) + ;; has 2 args + i2 (string-match "^\\([sy]\\|tr\\)$" argument) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random i (cperl-forward-re stop-point end ! i2 t st-l err-l argument) ! ;; Note that if `go', then it is considered as 1-arg ! b1 (nth 1 i) ; start of the second part ! tag (nth 2 i) ; ender-char, true if second part ! ; is with matching chars [] go (nth 4 i) ; There is a 1-char part after the end i (car i) ; intermediate point ! e1 (point) ; end ! ;; Before end of the second part if non-matching: /// ! tail (if (and i (not tag)) ! (1- e1)) ! e (if i i e1) ; end of the first part ! qtag nil) ; need to preserve backslashitis ;; Commenting \\ is dangerous, what about ( ? (and i tail (eq (char-after i) ?\\) ! (setq qtag t)) (if (null i) + ;; Considered as 1arg form (progn (cperl-commentify b (point) t) ! (and go ! (setq e1 (1+ e1)) ! (forward-char 1))) (cperl-commentify b i t) (if (looking-at "\\sw*e") ; s///e (progn (and ;; silent: ! (cperl-find-pods-heres b1 (1- (point)) t end) ;; Error (goto-char (1+ max))) ! (if (and tag (eq (preceding-char) ?\>)) (progn (cperl-modify-syntax-type (1- (point)) cperl-st-ket) (cperl-modify-syntax-type i cperl-st-bra)))) ! (cperl-commentify b1 (point) t) ! (if qtag (cperl-modify-syntax-type (1+ i) cperl-st-punct)) (setq tail nil))) + ;; Now: tail: if the second part is non-matching without ///e (if (eq (char-syntax (following-char)) ?w) (progn (forward-word 1) ; skip modifiers s///s ! (if tail (cperl-commentify tail (point) t)) ! (cperl-postpone-fontification ! e1 (point) 'face font-lock-other-type-face))) ! ;; Check whether it is m// which means "previous match" ! ;; and highlight differently ! (if (and (eq e (+ 2 b)) ! (string-match "^\\([sm]?\\|qr\\)$" argument) ! ;; <> is already filtered out ! ;; split // *is* using zero-pattern ! (save-excursion ! (condition-case nil ! (progn ! (goto-char tb) ! (forward-sexp -1) ! (not (looking-at "split\\>"))) ! (error t)))) ! (cperl-postpone-fontification ! b e 'face font-lock-function-name-face) ! (if (or i2 ; Has 2 args ! (and cperl-fontify-m-as-s ! (or ! (string-match "^\\(m\\|qr\\)$" argument) ! (and (eq 0 (length argument)) ! (not (eq ?\< (char-after b))))))) ! (progn ! (cperl-postpone-fontification ! b (1+ b) 'face font-lock-constant-face) ! (cperl-postpone-fontification ! (1- e) e 'face font-lock-constant-face)))) ! (if i2 ! (progn ! (cperl-postpone-fontification ! (1- e1) e1 'face font-lock-constant-face) ! (if (assoc (char-after b) cperl-starters) ! (cperl-postpone-fontification ! b1 (1+ b1) 'face font-lock-constant-face)))) (if (> (point) max) (setq tmpend tb)))) ((match-beginning 13) ; sub with prototypes *************** *** 3947,3964 **** (defun cperl-backward-to-noncomment (lim) ;; Stops at lim or after non-whitespace that is not in comment ! (let (stop p) (while (and (not stop) (> (point) (or lim 1))) (skip-chars-backward " \t\n\f" lim) (setq p (point)) (beginning-of-line) ! (if (or (looking-at "^[ \t]*\\(#\\|$\\)") ! (progn (cperl-to-comment-or-eol) (bolp))) ! nil ; Only comment, skip ! ;; Else ! (skip-chars-backward " \t") ! (if (< p (point)) (goto-char p)) ! (setq stop t))))) (defun cperl-after-block-p (lim) ;; We suppose that the preceding char is }. --- 4205,4225 ---- (defun cperl-backward-to-noncomment (lim) ;; Stops at lim or after non-whitespace that is not in comment ! (let (stop p pr) (while (and (not stop) (> (point) (or lim 1))) (skip-chars-backward " \t\n\f" lim) (setq p (point)) (beginning-of-line) ! (if (memq (setq pr (get-text-property (point) 'syntax-type)) ! '(pod here-doc here-doc-delim)) ! (cperl-unwind-to-safe nil) ! (if (or (looking-at "^[ \t]*\\(#\\|$\\)") ! (progn (cperl-to-comment-or-eol) (bolp))) ! nil ; Only comment, skip ! ;; Else ! (skip-chars-backward " \t") ! (if (< p (point)) (goto-char p)) ! (setq stop t)))))) (defun cperl-after-block-p (lim) ;; We suppose that the preceding char is }. *************** *** 4259,4265 **** (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) (let (st comm old-comm-indent new-comm-indent p pp i (indent-info (if cperl-emacs-can-parse ! '(nil nil) nil)) after-change-functions ; Speed it up! (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) --- 4520,4526 ---- (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) (let (st comm old-comm-indent new-comm-indent p pp i (indent-info (if cperl-emacs-can-parse ! (list nil nil) ; Cannot use '(), since will modify nil)) after-change-functions ; Speed it up! (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) *************** *** 4659,4665 **** (setq font-lock-constant-face 'font-lock-constant-face))) (defun cperl-init-faces () ! (condition-case nil (progn (require 'font-lock) (and (fboundp 'font-lock-fontify-anchored-keywords) --- 4920,4926 ---- (setq font-lock-constant-face 'font-lock-constant-face))) (defun cperl-init-faces () ! (condition-case errs (progn (require 'font-lock) (and (fboundp 'font-lock-fontify-anchored-keywords) *************** *** 4704,4710 **** ;; "getservbyport" "getservent" "getsockname" ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" ! ;; "link" "listen" "localtime" "log" "lstat" "lt" ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" ;; "quotemeta" "rand" "read" "readdir" "readline" --- 4965,4971 ---- ;; "getservbyport" "getservent" "getsockname" ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length" ! ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt" ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne" ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe" ;; "quotemeta" "rand" "read" "readdir" "readline" *************** *** 4736,4742 **** "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|" "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|" "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e" ! "\\(\\|ngth\\)\\|o\\(caltime\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|" "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|" "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|" "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin" --- 4997,5003 ---- "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|" "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|" "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e" ! "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|" "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|" "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|" "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin" *************** *** 4772,4778 **** "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|" "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|" "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" ! "q\\(\\|q\\|w\\|x\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually --- 5033,5039 ---- "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|" "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|" "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" ! "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually *************** *** 4852,4861 **** ;; (if (cperl-slash-is-regexp) ;; font-lock-function-name-face 'default) nil t)) ))) ! (setq perl-font-lock-keywords-1 t-font-lock-keywords perl-font-lock-keywords perl-font-lock-keywords-1 perl-font-lock-keywords-2 (append ! t-font-lock-keywords t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) --- 5113,5126 ---- ;; (if (cperl-slash-is-regexp) ;; font-lock-function-name-face 'default) nil t)) ))) ! (setq perl-font-lock-keywords-1 ! (if cperl-syntaxify-by-font-lock ! (cons 'cperl-fontify-update ! t-font-lock-keywords) ! t-font-lock-keywords) perl-font-lock-keywords perl-font-lock-keywords-1 perl-font-lock-keywords-2 (append ! perl-font-lock-keywords-1 t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) *************** *** 4935,5003 **** t t nil)))) (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") ! (or (fboundp 'x-color-defined-p) ! (defalias 'x-color-defined-p ! (cond ((fboundp 'color-defined-p) 'color-defined-p) ! ;; XEmacs >= 19.12 ! ((fboundp 'valid-color-name-p) 'valid-color-name-p) ! ;; XEmacs 19.11 ! (t 'x-valid-color-name-p)))) ! (defvar font-lock-constant-face 'font-lock-constant-face) ! (defvar font-lock-variable-name-face 'font-lock-variable-name-face) ! (or (boundp 'font-lock-type-face) ! (defconst font-lock-type-face ! 'font-lock-type-face ! "Face to use for data types.")) ! (or (boundp 'font-lock-other-type-face) ! (defconst font-lock-other-type-face ! 'font-lock-other-type-face ! "Face to use for data types from another group.")) ! (if (not cperl-xemacs-p) nil ! (or (boundp 'font-lock-comment-face) ! (defconst font-lock-comment-face ! 'font-lock-comment-face ! "Face to use for comments.")) ! (or (boundp 'font-lock-keyword-face) ! (defconst font-lock-keyword-face ! 'font-lock-keyword-face ! "Face to use for keywords.")) ! (or (boundp 'font-lock-function-name-face) ! (defconst font-lock-function-name-face ! 'font-lock-function-name-face ! "Face to use for function names."))) (if (and (not (cperl-is-face 'cperl-array-face)) (cperl-is-face 'font-lock-emphasized-face)) ! (copy-face 'font-lock-emphasized-face 'cperl-emphasized-face)) (if (and (not (cperl-is-face 'cperl-hash-face)) (cperl-is-face 'font-lock-other-emphasized-face)) (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) ! (or (boundp 'cperl-hash-face) ! (defconst cperl-hash-face ! 'cperl-hash-face ! "Face to use for another type of emphasizing.")) ! (or (boundp 'cperl-emphasized-face) ! (defconst cperl-emphasized-face ! 'cperl-emphasized-face ! "Face to use for emphasizing.")) ;; Here we try to guess background (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode 'light)) (face-list (and (fboundp 'face-list) (face-list))) ! cperl-is-face) ! (fset 'cperl-is-face ! (cond ((fboundp 'find-face) ! (symbol-function 'find-face)) ! (face-list ! (function (lambda (face) (member face face-list)))) ! (t ! (function (lambda (face) (boundp face)))))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) --- 5200,5288 ---- t t nil)))) + ;; Do it the dull way, without choose-color (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") ! ;; (or (fboundp 'x-color-defined-p) ! ;; (defalias 'x-color-defined-p ! ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) ! ;; ;; XEmacs >= 19.12 ! ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) ! ;; ;; XEmacs 19.11 ! ;; (t 'x-valid-color-name-p)))) ! (cperl-force-face font-lock-constant-face ! "Face for constant and label names") ! (cperl-force-face font-lock-variable-name-face ! "Face for variable names") ! (cperl-force-face font-lock-type-face ! "Face for data types") ! (cperl-force-face font-lock-other-type-face ! "Face for data types from another group") ! (cperl-force-face font-lock-comment-face ! "Face for comments") ! (cperl-force-face font-lock-keyword-face ! "Face for keywords") ! (cperl-force-face font-lock-function-name-face ! "Face for function names") ! (cperl-force-face cperl-hash-face ! "Face for hashes") ! (cperl-force-face cperl-array-face ! "Face for arrays") ! ;;(defvar font-lock-constant-face 'font-lock-constant-face) ! ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) ! ;;(or (boundp 'font-lock-type-face) ! ;; (defconst font-lock-type-face ! ;; 'font-lock-type-face ! ;; "Face to use for data types.")) ! ;;(or (boundp 'font-lock-other-type-face) ! ;; (defconst font-lock-other-type-face ! ;; 'font-lock-other-type-face ! ;; "Face to use for data types from another group.")) ! ;;(if (not cperl-xemacs-p) nil ! ;; (or (boundp 'font-lock-comment-face) ! ;; (defconst font-lock-comment-face ! ;; 'font-lock-comment-face ! ;; "Face to use for comments.")) ! ;; (or (boundp 'font-lock-keyword-face) ! ;; (defconst font-lock-keyword-face ! ;; 'font-lock-keyword-face ! ;; "Face to use for keywords.")) ! ;; (or (boundp 'font-lock-function-name-face) ! ;; (defconst font-lock-function-name-face ! ;; 'font-lock-function-name-face ! ;; "Face to use for function names."))) (if (and (not (cperl-is-face 'cperl-array-face)) (cperl-is-face 'font-lock-emphasized-face)) ! (copy-face 'font-lock-emphasized-face 'cperl-array-face)) (if (and (not (cperl-is-face 'cperl-hash-face)) (cperl-is-face 'font-lock-other-emphasized-face)) (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) ! ;;(or (boundp 'cperl-hash-face) ! ;; (defconst cperl-hash-face ! ;; 'cperl-hash-face ! ;; "Face to use for hashes.")) ! ;;(or (boundp 'cperl-array-face) ! ;; (defconst cperl-array-face ! ;; 'cperl-array-face ! ;; "Face to use for arrays.")) ;; Here we try to guess background (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode 'light)) (face-list (and (fboundp 'face-list) (face-list))) ! ;; cperl-is-face ! ) ! ;;;; (fset 'cperl-is-face ! ;;;; (cond ((fboundp 'find-face) ! ;;;; (symbol-function 'find-face)) ! ;;;; (face-list ! ;;;; (function (lambda (face) (member face face-list)))) ! ;;;; (t ! ;;;; (function (lambda (face) (boundp face)))))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) *************** *** 5007,5013 **** (if (and (not (cperl-is-face 'font-lock-constant-face)) (cperl-is-face 'font-lock-reference-face)) - nil (copy-face 'font-lock-reference-face 'font-lock-constant-face)) (if (cperl-is-face 'font-lock-type-face) nil (copy-face 'default 'font-lock-type-face) --- 5292,5297 ---- *************** *** 5077,5083 **** (if (cperl-is-face 'font-lock-constant-face) nil (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) ! (error nil))) (defun cperl-ps-print-init () --- 5361,5367 ---- (if (cperl-is-face 'font-lock-constant-face) nil (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) ! (error (message "cperl-init-faces (ignored): %s" errs)))) (defun cperl-ps-print-init () *************** *** 5969,5982 **** "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) "<\\$?\\sw+\\(\\.\\sw+\\)?>" ; ! "-[a-zA-Z][ \t]+[_$\"'`]" ; -f file "-[0-9]" ; -5 "\\+\\+" ; ++var "--" ; --var ".->" ; a->b "->" ; a SPACE ->b "\\[-" ; a[-1] "^=" ; =head "||" "&&" "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C --- 6253,6269 ---- "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) "<\\$?\\sw+\\(\\.\\sw+\\)?>" ; ! "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN "-[0-9]" ; -5 "\\+\\+" ; ++var "--" ; --var ".->" ; a->b "->" ; a SPACE ->b "\\[-" ; a[-1] + "\\\\[&$@*\\\\]" ; \&func "^=" ; =head + "\\$." ; $| + "<<[a-zA-Z_'\"`]" ; <" ; C *************** *** 6247,6252 **** --- 6534,6540 ---- $^H The current set of syntax checks enabled by `use strict'. $^I The value of the in-place edit extension (perl -i option). $^L What formats output to perform a formfeed. Default is \f. + $^M A buffer for emergency memory allocation when running out of memory. $^O The operating system name under which this copy of Perl was built. $^P Internal debugging flag. $^T The time the script was started. Used by -A/-M/-C file tests. *************** *** 6785,6795 **** ;; Returns position of the start (save-excursion (or cperl-use-syntax-table-text-property ! (error "I need to have regex marked!")) ;; Find the start (if (looking-at "\\s|") nil ; good already ! (if (looking-at "[smy]\\s|") (forward-char 1) (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) --- 7073,7083 ---- ;; Returns position of the start (save-excursion (or cperl-use-syntax-table-text-property ! (error "I need to have a regexp marked!")) ;; Find the start (if (looking-at "\\s|") nil ; good already ! (if (looking-at "\\([smy]\\|qr\\)\\s|") (forward-char 1) (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) *************** *** 7100,7105 **** --- 7388,7395 ---- (defvar cperl-d-l nil) (defun cperl-fontify-syntaxically (end) + (and cperl-syntaxify-unwind + (cperl-unwind-to-safe t)) (let ((start (point)) (dbg (point))) (or cperl-syntax-done-to (setq cperl-syntax-done-to (point-min))) *************** *** 7124,7129 **** --- 7414,7428 ---- dbg end start cperl-syntax-done-to (car cperl-syntax-state))) ; For debugging nil)) ; Do not iterate + + (defun cperl-fontify-update (end) + (let ((pos (point)) prop posend) + (while (< pos end) + (setq prop (get-text-property pos 'cperl-postpone)) + (setq posend (next-single-property-change pos 'cperl-postpone nil end)) + (and prop (put-text-property pos posend (car prop) (cdr prop))) + (setq pos posend))) + nil) ; Do not iterate (defun cperl-update-syntaxification (from to) (if (and cperl-use-syntax-table-text-property Index: embed.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/embed.h Thu Jul 23 23:59:54 1998 --- perl5.005_02/embed.h Tue Aug 4 16:16:27 1998 *************** *** 816,822 **** #define push_return Perl_push_return #define push_scope Perl_push_scope #define q Perl_q - #define rcsid Perl_rcsid #define reall_srchlen Perl_reall_srchlen #define ref Perl_ref #define refkids Perl_refkids --- 816,821 ---- Index: ext/B/B/Bytecode.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/B/B/Bytecode.pm Thu Jul 23 23:59:56 1998 --- perl5.005_02/ext/B/B/Bytecode.pm Sun Aug 2 03:11:09 1998 *************** *** 887,893 **** =back ! =head EXAMPLES perl -MO=Bytecode,-O6,-o,foo.plc foo.pl --- 887,893 ---- =back ! =head1 EXAMPLES perl -MO=Bytecode,-O6,-o,foo.plc foo.pl Index: ext/Data/Dumper/Dumper.xs ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/Data/Dumper/Dumper.xs Fri Jul 24 00:00:04 1998 --- perl5.005_02/ext/Data/Dumper/Dumper.xs Sun Aug 2 03:01:28 1998 *************** *** 5,11 **** static SV *freezer; static SV *toaster; ! static I32 num_q _((char *s)); static I32 esc_q _((char *dest, char *src, STRLEN slen)); static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n)); static I32 DD_dump _((SV *val, char *name, STRLEN namelen, SV *retval, --- 5,11 ---- static SV *freezer; static SV *toaster; ! static I32 num_q _((char *s, STRLEN slen)); static I32 esc_q _((char *dest, char *src, STRLEN slen)); static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n)); static I32 DD_dump _((SV *val, char *name, STRLEN namelen, SV *retval, *************** *** 42,55 **** /* count the number of "'"s and "\"s in string */ static I32 ! num_q(register char *s) { register I32 ret = 0; ! ! while (*s) { if (*s == '\'' || *s == '\\') ++ret; ++s; } return ret; } --- 42,56 ---- /* count the number of "'"s and "\"s in string */ static I32 ! num_q(register char *s, register STRLEN slen) { register I32 ret = 0; ! ! while (slen > 0) { if (*s == '\'' || *s == '\\') ++ret; ++s; + --slen; } return ret; } *************** *** 380,386 **** hval = hv_iterval((HV*)ival, entry); if (quotekeys || needs_quote(key)) { ! nticks = num_q(key); New(0, nkey, klen+nticks+3, char); nkey[0] = '\''; if (nticks) --- 381,387 ---- hval = hv_iterval((HV*)ival, entry); if (quotekeys || needs_quote(key)) { ! nticks = num_q(key, klen); New(0, nkey, klen+nticks+3, char); nkey[0] = '\''; if (nticks) Index: ext/Errno/Errno_pm.PL ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/Errno/Errno_pm.PL Fri Jul 24 00:00:06 1998 --- perl5.005_02/ext/Errno/Errno_pm.PL Sun Aug 2 01:15:06 1998 *************** *** 53,58 **** --- 53,61 ---- } elsif ($Config{vms_cc_type} eq 'gcc') { $file{'gnu_cc_include:[000000]errno.h'} = 1; } + } elsif ($^O eq 'os390') { + # OS/390 C compiler doesn't generate #file or #line directives + $file{'/usr/include/errno.h'} = 1; } else { open(CPPI,"> errno.c") or die "Cannot open errno.c"; *************** *** 104,110 **** $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; ! } elsif($^O eq 'next') { # NeXT will do syntax checking unless it is reading from stdin my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; open(CPPO,"$cpp < errno.c |") --- 107,113 ---- $cpp =~ s/sys\$input//i; open(CPPO,"$cpp errno.c |") or die "Cannot exec $Config{cppstdin}"; ! } elsif(!$Config{'cpprun'} or $^O eq 'next') { # NeXT will do syntax checking unless it is reading from stdin my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; open(CPPO,"$cpp < errno.c |") Index: ext/IPC/SysV/SysV.xs ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/IPC/SysV/SysV.xs Fri Jul 24 00:00:08 1998 --- perl5.005_02/ext/IPC/SysV/SysV.xs Tue Aug 4 22:30:03 1998 *************** *** 15,21 **** #include #endif #ifdef HAS_SHM ! #ifdef PERL_SCO5 #include #endif #include --- 15,21 ---- #include #endif #ifdef HAS_SHM ! #if defined(PERL_SCO5) || defined(PERL_ISC) #include #endif #include *************** *** 41,46 **** --- 41,47 ---- SV * obj PPCODE: { + #ifdef HAS_MSG SV *sv; struct msqid_ds ds; AV *list = (AV*)SvRV(obj); *************** *** 50,55 **** --- 51,59 ---- sv = *av_fetch(list,6,TRUE); ds.msg_qbytes = SvIV(sv); ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds))); XSRETURN(1); + #else + croak("System V msgxxx is not implemented on this machine"); + #endif } void *************** *** 58,63 **** --- 62,68 ---- SV * buf PPCODE: { + #ifdef HAS_MSG STRLEN len; SV **sv_ptr; struct msqid_ds *ds = (struct msqid_ds *)SvPV(buf,len); *************** *** 92,97 **** --- 97,105 ---- sv_ptr = av_fetch(list,11,TRUE); sv_setiv(*sv_ptr, ds->msg_ctime); XSRETURN(1); + #else + croak("System V msgxxx is not implemented on this machine"); + #endif } MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat *************** *** 102,107 **** --- 110,116 ---- SV * ds PPCODE: { + #ifdef HAS_SEM STRLEN len; AV *list = (AV*)SvRV(obj); struct semid_ds *data = (struct semid_ds *)SvPV(ds,len); *************** *** 122,127 **** --- 131,139 ---- sv_setiv(*av_fetch(list,6,TRUE), data[0].sem_otime); sv_setiv(*av_fetch(list,7,TRUE), data[0].sem_nsems); XSRETURN(1); + #else + croak("System V semxxx is not implemented on this machine"); + #endif } void *************** *** 129,134 **** --- 141,147 ---- SV * obj PPCODE: { + #ifdef HAS_SEM SV **sv_ptr; SV *sv; struct semid_ds ds; *************** *** 154,159 **** --- 167,175 ---- ds.sem_nsems = SvIV(*sv_ptr); ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds))); XSRETURN(1); + #else + croak("System V semxxx is not implemented on this machine"); + #endif } MODULE=IPC::SysV PACKAGE=IPC::SysV Index: ext/POSIX/POSIX.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/POSIX/POSIX.pm Fri Jul 24 00:00:09 1998 --- perl5.005_02/ext/POSIX/POSIX.pm Sat Aug 1 23:56:30 1998 *************** *** 68,74 **** _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX ! _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)], locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME NULL localeconv setlocale)], --- 68,74 ---- _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX ! _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)], locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME NULL localeconv setlocale)], Index: ext/POSIX/POSIX.xs ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/POSIX/POSIX.xs Fri Jul 24 00:00:12 1998 --- perl5.005_02/ext/POSIX/POSIX.xs Sun Aug 2 00:03:23 1998 *************** *** 822,827 **** --- 822,829 ---- #else goto not_there; #endif + break; + case 'L': if (strEQ(name, "ELOOP")) #ifdef ELOOP return ELOOP; *************** *** 2954,2960 **** #ifdef HAS_LOCALECONV struct lconv *lcbuf; RETVAL = newHV(); - SET_NUMERIC_LOCAL(); if (lcbuf = localeconv()) { /* the strings */ if (lcbuf->decimal_point && *lcbuf->decimal_point) --- 2956,2961 ---- Index: ext/SDBM_File/sdbm/pair.c Prereq: 1.10 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/SDBM_File/sdbm/pair.c Fri Jul 24 00:00:14 1998 --- perl5.005_02/ext/SDBM_File/sdbm/pair.c Tue Aug 4 16:09:16 1998 *************** *** 7,16 **** * page-level routines */ - #ifndef lint - static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; - #endif - #include "config.h" #include "EXTERN.h" #include "sdbm.h" --- 7,12 ---- Index: ext/SDBM_File/sdbm/sdbm.c Prereq: 1.16 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/SDBM_File/sdbm/sdbm.c Fri Jul 24 00:00:14 1998 --- perl5.005_02/ext/SDBM_File/sdbm/sdbm.c Tue Aug 4 16:09:27 1998 *************** *** 7,16 **** * core routines */ - #ifndef lint - static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; - #endif - #include "INTERN.h" #include "config.h" #include "sdbm.h" --- 7,12 ---- Index: ext/Thread/Thread/Specific.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/Thread/Thread/Specific.pm Fri Jul 24 00:00:15 1998 --- perl5.005_02/ext/Thread/Thread/Specific.pm Sun Aug 2 03:15:34 1998 *************** *** 9,14 **** --- 9,18 ---- use Thread::Specific; my $k = key_create Thread::Specific; + =head1 DESCRIPTION + + C returns a unique thread-specific key. + =cut sub import { Index: ext/Thread/Thread.xs ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/Thread/Thread.xs Fri Jul 24 00:00:15 1998 --- perl5.005_02/ext/Thread/Thread.xs Sun Aug 2 02:09:57 1998 *************** *** 23,29 **** remove_thread(struct perl_thread *t) { #ifdef USE_THREADS ! DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: remove_thread %p\n", thr, t))); MUTEX_LOCK(&PL_threads_mutex); MUTEX_DESTROY(&t->mutex); --- 23,29 ---- remove_thread(struct perl_thread *t) { #ifdef USE_THREADS ! DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: remove_thread %p\n", thr, t))); MUTEX_LOCK(&PL_threads_mutex); MUTEX_DESTROY(&t->mutex); *************** *** 48,54 **** AV *av; int i; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; --- 48,54 ---- AV *av; int i; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; *************** *** 67,73 **** myop.op_flags |= OPf_KNOW; myop.op_flags |= OPf_WANT_LIST; PL_op = pp_entersub(ARGS); ! DEBUG_L(if (!PL_op) PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); /* * When this thread is next scheduled, we start in the right --- 67,73 ---- myop.op_flags |= OPf_KNOW; myop.op_flags |= OPf_WANT_LIST; PL_op = pp_entersub(ARGS); ! DEBUG_S(if (!PL_op) PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); /* * When this thread is next scheduled, we start in the right *************** *** 88,94 **** AV *av = newAV(); int i, ret; dJMPENV; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", thr)); /* Don't call *anything* requiring dTHR until after SET_THR() */ --- 88,94 ---- AV *av = newAV(); int i, ret; dJMPENV; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", thr)); /* Don't call *anything* requiring dTHR until after SET_THR() */ *************** *** 110,116 **** SET_THR(thr); /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); sv = POPs; --- 110,116 ---- SET_THR(thr); /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); sv = POPs; *************** *** 125,134 **** MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", thr, SvPV(thr->errsv, PL_na))); } else { ! DEBUG_L(STMT_START { for (i = 1; i <= retval; i++) { PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", thr, i, SvPEEK(SP[i - 1])); --- 125,134 ---- MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", thr, SvPV(thr->errsv, PL_na))); } else { ! DEBUG_S(STMT_START { for (i = 1; i <= retval; i++) { PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", thr, i, SvPEEK(SP[i - 1])); *************** *** 177,204 **** /*SvREFCNT_dec(PL_defoutgv);*/ MUTEX_LOCK(&thr->mutex); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: threadstart finishing: state is %u\n", thr, ThrSTATE(thr))); switch (ThrSTATE(thr)) { case THRf_R_JOINABLE: ThrSETSTATE(thr, THRf_ZOMBIE); MUTEX_UNLOCK(&thr->mutex); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINABLE thread finished\n", thr)); break; case THRf_R_JOINED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); remove_thread(thr); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINED thread finished\n", thr)); break; case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); SvREFCNT_dec(av); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: DETACHED thread finished\n", thr)); remove_thread(thr); /* This might trigger main thread to finish */ break; --- 177,204 ---- /*SvREFCNT_dec(PL_defoutgv);*/ MUTEX_LOCK(&thr->mutex); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: threadstart finishing: state is %u\n", thr, ThrSTATE(thr))); switch (ThrSTATE(thr)) { case THRf_R_JOINABLE: ThrSETSTATE(thr, THRf_ZOMBIE); MUTEX_UNLOCK(&thr->mutex); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINABLE thread finished\n", thr)); break; case THRf_R_JOINED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); remove_thread(thr); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: R_JOINED thread finished\n", thr)); break; case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); SvREFCNT_dec(av); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: DETACHED thread finished\n", thr)); remove_thread(thr); /* This might trigger main thread to finish */ break; *************** *** 234,240 **** savethread = thr; thr = new_struct_thread(thr); SPAGAIN; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: newthread (%p), tid is %u, preparing stack\n", savethread, thr, thr->tid)); /* The following pushes the arg list and startsv onto the *new* stack */ --- 234,240 ---- savethread = thr; thr = new_struct_thread(thr); SPAGAIN; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: newthread (%p), tid is %u, preparing stack\n", savethread, thr, thr->tid)); /* The following pushes the arg list and startsv onto the *new* stack */ *************** *** 283,289 **** MUTEX_UNLOCK(&thr->mutex); #endif if (err) { ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ --- 283,289 ---- MUTEX_UNLOCK(&thr->mutex); #endif if (err) { ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ *************** *** 322,328 **** * so don't be surprised if this isn't robust while debugging * with -DL. */ ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "handle_thread_signal: got signal %d\n", sig);); write(sig_pipe[1], &c, 1); } --- 322,328 ---- * so don't be surprised if this isn't robust while debugging * with -DL. */ ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "handle_thread_signal: got signal %d\n", sig);); write(sig_pipe[1], &c, 1); } *************** *** 345,351 **** int i = NO_INIT PPCODE: #ifdef USE_THREADS ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { --- 345,351 ---- int i = NO_INIT PPCODE: #ifdef USE_THREADS ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { *************** *** 372,378 **** XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); } else { char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: join propagating die message: %s\n", thr, mess)); croak(mess); --- 372,378 ---- XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); } else { char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: join propagating die message: %s\n", thr, mess)); croak(mess); *************** *** 384,390 **** Thread t CODE: #ifdef USE_THREADS ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { --- 384,390 ---- Thread t CODE: #ifdef USE_THREADS ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { *************** *** 476,482 **** sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); --- 476,482 ---- sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); *************** *** 500,506 **** sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); --- 500,506 ---- sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); *************** *** 520,526 **** sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { --- 520,526 ---- sv = SvRV(sv); mg = condpair_magic(sv); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { *************** *** 623,629 **** ST(0) = sv_newmortal(); if (ret) sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "await_signal returning %s\n", SvPEEK(ST(0)));); MODULE = Thread PACKAGE = Thread::Specific --- 623,629 ---- ST(0) = sv_newmortal(); if (ret) sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "await_signal returning %s\n", SvPEEK(ST(0)));); MODULE = Thread PACKAGE = Thread::Specific Index: ext/Thread/typemap ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/ext/Thread/typemap Fri Jul 24 00:00:15 1998 --- perl5.005_02/ext/Thread/typemap Sun Aug 2 02:08:10 1998 *************** *** 13,19 **** || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); $var = ($type) SvPVX(mg->mg_obj); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), \"XSUB ${func_name}: %p\\n\", $var);) } STMT_END T_IVREF --- 13,19 ---- || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); $var = ($type) SvPVX(mg->mg_obj); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), \"XSUB ${func_name}: %p\\n\", $var);) } STMT_END T_IVREF Index: global.sym ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/global.sym Fri Jul 24 00:00:16 1998 --- perl5.005_02/global.sym Tue Aug 4 16:16:12 1998 *************** *** 79,85 **** ppaddr psig_name psig_ptr - rcsid reall_srchlen regkind repeat_amg --- 79,84 ---- Index: gv.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/gv.c Fri Jul 24 00:00:17 1998 --- perl5.005_02/gv.c Tue Aug 4 16:07:44 1998 *************** *** 19,26 **** #include "EXTERN.h" #include "perl.h" - EXT char rcsid[]; - GV * gv_AVadd(register GV *gv) { --- 19,24 ---- *************** *** 502,526 **** bool global = FALSE; if (isUPPER(*name)) { ! if (*name > 'I') { ! if (*name == 'S' && ( ! strEQ(name, "SIG") || ! strEQ(name, "STDIN") || ! strEQ(name, "STDOUT") || ! strEQ(name, "STDERR") )) ! global = TRUE; ! } ! else if (*name > 'E') { ! if (*name == 'I' && strEQ(name, "INC")) ! global = TRUE; ! } ! else if (*name > 'A') { ! if (*name == 'E' && strEQ(name, "ENV")) ! global = TRUE; ! } else if (*name == 'A' && ( strEQ(name, "ARGV") || ! strEQ(name, "ARGVOUT") )) global = TRUE; } else if (*name == '_' && !name[1]) --- 500,518 ---- bool global = FALSE; if (isUPPER(*name)) { ! if (*name == 'S' && ( ! strEQ(name, "SIG") || ! strEQ(name, "STDIN") || ! strEQ(name, "STDOUT") || ! strEQ(name, "STDERR"))) ! global = TRUE; ! else if (*name == 'I' && strEQ(name, "INC")) ! global = TRUE; ! else if (*name == 'E' && strEQ(name, "ENV")) ! global = TRUE; else if (*name == 'A' && ( strEQ(name, "ARGV") || ! strEQ(name, "ARGVOUT"))) global = TRUE; } else if (*name == '_' && !name[1]) *************** *** 759,766 **** case '\005': case '\006': case '\010': case '\017': - case '\t': case '\020': case '\024': case '\027': --- 751,758 ---- case '\005': case '\006': case '\010': + case '\011': /* NOT \t in EBCDIC */ case '\017': case '\020': case '\024': case '\027': *************** *** 1154,1160 **** CV **cvp=NULL, **ocvp=NULL; AMT *amtp, *oamtp; int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; ! int postpr=0, inc_dec_ass=0, assignshift=assign?1:0; HV* stash; if (!(AMGf_noleft & flags) && SvAMAGIC(left) && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) --- 1146,1152 ---- CV **cvp=NULL, **ocvp=NULL; AMT *amtp, *oamtp; int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; ! int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; HV* stash; if (!(AMGf_noleft & flags) && SvAMAGIC(left) && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) *************** *** 1171,1186 **** int logic; /* look for substituted methods */ switch (method) { case inc_amg: ! if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1)) ! || ((cv = cvp[off=add_amg]) && (postpr=1))) { right = &PL_sv_yes; lr = -1; assign = 1; } break; case dec_amg: ! if (((cv = cvp[off=subtr_ass_amg]) && (inc_dec_ass=1)) ! || ((cv = cvp[off=subtr_amg]) && (postpr=1))) { right = &PL_sv_yes; lr = -1; assign = 1; } break; --- 1163,1181 ---- int logic; /* look for substituted methods */ + /* In all the covered cases we should be called with assign==0. */ switch (method) { case inc_amg: ! force_cpy = 1; ! if ((cv = cvp[off=add_ass_amg]) ! || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) { right = &PL_sv_yes; lr = -1; assign = 1; } break; case dec_amg: ! force_cpy = 1; ! if ((cv = cvp[off = subtr_ass_amg]) ! || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) { right = &PL_sv_yes; lr = -1; assign = 1; } break; *************** *** 1327,1332 **** --- 1322,1328 ---- } return NULL; } + force_cpy = force_cpy || assign; } } if (!notfound) { *************** *** 1343,1356 **** flags & AMGf_unary? " for argument" : "", HvNAME(stash), fl? ",\n\tassignment variant used": "") ); /* Since we use shallow copy during assignment, we need * to dublicate the contents, probably calling user-supplied * version of copy operator */ ! if ((method + assignshift==off ! && (assign || method==inc_amg || method==dec_amg)) ! || inc_dec_ass) RvDEEPCP(left); ! } { dSP; BINOP myop; --- 1339,1371 ---- flags & AMGf_unary? " for argument" : "", HvNAME(stash), fl? ",\n\tassignment variant used": "") ); + } /* Since we use shallow copy during assignment, we need * to dublicate the contents, probably calling user-supplied * version of copy operator */ ! /* We need to copy in following cases: ! * a) Assignment form was called. ! * assignshift==1, assign==T, method + 1 == off ! * b) Increment or decrement, called directly. ! * assignshift==0, assign==0, method + 0 == off ! * c) Increment or decrement, translated to assignment add/subtr. ! * assignshift==0, assign==T, ! * force_cpy == T ! * d) Increment or decrement, translated to nomethod. ! * assignshift==0, assign==0, ! * force_cpy == T ! * e) Assignment form translated to nomethod. ! * assignshift==1, assign==T, method + 1 != off ! * force_cpy == T ! */ ! /* off is method, method+assignshift, or a result of opcode substitution. ! * In the latter case assignshift==0, so only notfound case is important. ! */ ! if (( (method + assignshift == off) ! && (assign || (method == inc_amg) || (method == dec_amg))) ! || force_cpy) ! RvDEEPCP(left); { dSP; BINOP myop; Index: handy.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/handy.h Fri Jul 24 00:00:18 1998 --- perl5.005_02/handy.h Sun Aug 2 01:15:06 1998 *************** *** 183,193 **** #define isSPACE(c) \ ((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f') #define isDIGIT(c) ((c) >= '0' && (c) <= '9') ! #define isUPPER(c) ((c) >= 'A' && (c) <= 'Z') ! #define isLOWER(c) ((c) >= 'a' && (c) <= 'z') ! #define isPRINT(c) (((c) > 32 && (c) < 127) || isSPACE(c)) ! #define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c)) ! #define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c)) #ifdef USE_NEXT_CTYPE --- 183,202 ---- #define isSPACE(c) \ ((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f') #define isDIGIT(c) ((c) >= '0' && (c) <= '9') ! #ifdef EBCDIC ! /* In EBCDIC we do not do locales: therefore() isupper() is fine. */ ! # define isUPPER(c) isupper(c) ! # define isLOWER(c) islower(c) ! # define isPRINT(c) isprint(c) ! # define toUPPER(c) toupper(c) ! # define toLOWER(c) tolower(c) ! #else ! # define isUPPER(c) ((c) >= 'A' && (c) <= 'Z') ! # define isLOWER(c) ((c) >= 'a' && (c) <= 'z') ! # define isPRINT(c) (((c) > 32 && (c) < 127) || isSPACE(c)) ! # define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c)) ! # define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c)) ! #endif #ifdef USE_NEXT_CTYPE *************** *** 238,245 **** # endif #endif /* USE_NEXT_CTYPE */ ! /* This conversion works both ways, strangely enough. */ ! #define toCTRL(c) (toUPPER(c) ^ 64) /* Line numbers are unsigned, 16 bits. */ typedef U16 line_t; --- 247,259 ---- # endif #endif /* USE_NEXT_CTYPE */ ! #ifdef EBCDIC ! EXT int ebcdic_control _((int)); ! # define toCTRL(c) ebcdic_control(c) ! #else ! /* This conversion works both ways, strangely enough. */ ! # define toCTRL(c) (toUPPER(c) ^ 64) ! #endif /* Line numbers are unsigned, 16 bits. */ typedef U16 line_t; Index: hints/isc.sh ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/hints/isc.sh Fri Jul 24 00:00:20 1998 --- perl5.005_02/hints/isc.sh Tue Aug 4 22:30:03 1998 *************** *** 34,39 **** --- 34,42 ---- # rename(2) can't rename long filenames d_rename=undef + # for ext/IPC/SysV/SysV.xs + ccflags="$ccflags -DPERL_ISC" + # You can also include -D_SYSV3 to pick up "traditionally visible" # symbols hidden by name-space pollution rules. This raises some # compilation "redefinition" warnings, but they appear harmless. Index: hints/isc_2.sh ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/hints/isc_2.sh Fri Jul 24 00:00:20 1998 --- perl5.005_02/hints/isc_2.sh Tue Aug 4 22:30:03 1998 *************** *** 20,22 **** --- 20,25 ---- # Compensate for conflicts in doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' pp_sys_cflags='ccflags="$ccflags -DENOTSOCK=103"' + + # for ext/IPC/SysV/SysV.xs + ccflags="$ccflags -DPERL_ISC" Index: hints/machten.sh ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/hints/machten.sh Fri Jul 24 00:00:20 1998 --- perl5.005_02/hints/machten.sh Fri Aug 7 17:38:53 1998 *************** *** 13,18 **** --- 13,22 ---- # Martijn Koster # Richard Yeh # + # For now, explicitly disable dynamic loading -- MT 4.1.1 has it, + # but these hints do not yet support it. + # Define NOTEDEF_MACHTEN to undo gratuitous Tenon hack to signal.h. + # -- Dominic Dunlop 9800802 # Completely disable SysV IPC pending more complete support from Tenon # -- Dominic Dunlop 980712 # Use vfork and perl's malloc by default *************** *** 32,39 **** # # Comments, questions, and improvements welcome! # ! # MachTen 4.X does support dynamic loading, but perl doesn't # know how to use it yet. # Power MachTen is a real memory system and its standard malloc # has been optimized for this. Using this malloc instead of Perl's --- 36,51 ---- # # Comments, questions, and improvements welcome! # ! # MachTen 4.1.1 does support dynamic loading, but perl doesn't # know how to use it yet. + usedl=${usedl:-undef} + + # MachTen 4.1.1 may have an unhelpful hack in /usr/include/signal.h. + # Undo it if so. + if grep NOTDEF_MACHTEN /usr/include/signal.h > /dev/null + then + ccflags="$ccflags -DNOTDEF_MACHTEN" + fi # Power MachTen is a real memory system and its standard malloc # has been optimized for this. Using this malloc instead of Perl's Index: hints/os390.sh ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/hints/os390.sh Fri Jul 24 00:00:21 1998 --- perl5.005_02/hints/os390.sh Sun Aug 2 01:15:07 1998 *************** *** 1,4 **** --- 1,7 ---- # hints/os390.sh + # + # OS/390 hints by David J. Fiander + # # OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to: # # John Pfuntner *************** *** 11,33 **** # as well as the authors of the aix.sh file # cc='c89' ! ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE' optimize='none' alignbytes=8 ! usemymalloc='y' so='a' dlext='none' d_shmatprototype='define' usenm='false' i_time='define' i_systime='define' - d_select='undef' # (from aix.sh) # uname -m output is too specific and not appropriate here # case "$archname" in '') archname="$osname" ;; esac --- 14,56 ---- # as well as the authors of the aix.sh file # + # To get ANSI C, we need to use c89, and ld doesn't exist cc='c89' ! ld='c89' ! # c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again, ! # YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant. ! # -DEBCDIC should come from Configure. ! ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC' ! # Turning on optimization breaks perl optimize='none' + alignbytes=8 ! ! usemymalloc='n' ! so='a' + + # On OS/390, libc.a doesn't really hold anything at all, + # so running nm on it is pretty useless. + usenm='n' + + # Dynamic loading doesn't work on OS/390 quite yet + usedl='n' dlext='none' + + # Configure can't figure this out for some reason d_shmatprototype='define' + usenm='false' i_time='define' i_systime='define' # (from aix.sh) # uname -m output is too specific and not appropriate here + # osname should come from Configure # case "$archname" in '') archname="$osname" ;; esac + archobjs=ebcdic.o Index: hints/solaris_2.sh ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/hints/solaris_2.sh Fri Jul 24 00:00:22 1998 --- perl5.005_02/hints/solaris_2.sh Sun Aug 2 00:50:40 1998 *************** *** 173,182 **** # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. # Recompute $verbose since we may have just changed $cc. ! verbose=`${cc:-cc} -v -o try try.c 2>&1` if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then : else cat <&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. --- 173,200 ---- # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. # Recompute $verbose since we may have just changed $cc. ! verbose=`${cc:-cc} -v -o try try.c 2>&1 | grep ld 2>&1` if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then : else + # It's not /usr/ccs/bin/ld - but it might be egcs's ld wrapper, + # which calls /usr/ccs/bin/ld in turn. Passing -V to it will + # make it show its true colors. + + myld=`echo $verbose| grep ld | awk '/\/ld/ {print $1}'` + # This assumes that gcc's output will not change, and that + # /full/path/to/ld will be the first word of the output. + + # all Solaris versions of ld I've seen contain the magic + # string used in the grep below. + if $myld -V 2>&1 | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then + cat <&2 + + Aha. You're using egcs and /usr/ccs/bin/ld. + + END + + else cat <&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. *************** *** 185,190 **** --- 203,209 ---- END cc="${cc:-cc} -B/usr/ccs/bin/" + fi fi else Index: lib/Benchmark.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Benchmark.pm Fri Jul 24 00:00:25 1998 --- perl5.005_02/lib/Benchmark.pm Fri Aug 7 23:02:41 1998 *************** *** 238,243 **** --- 238,250 ---- =cut + # evaluate something in a clean lexical environment + sub _doeval { eval shift } + + # + # put any lexicals at file scope AFTER here + # + use Carp; use Exporter; @ISA=(Exporter); *************** *** 280,286 **** sub timediff { my($a, $b) = @_; my @r; ! for ($i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; --- 287,293 ---- sub timediff { my($a, $b) = @_; my @r; ! for (my $i=0; $i < @$a; ++$i) { push(@r, $a->[$i] - $b->[$i]); } bless \@r; *************** *** 329,338 **** last if $pack ne $curpack; } ! my $subcode = (ref $c eq 'CODE') ! ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }" ! : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; ! my $subref = eval $subcode; croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; --- 336,350 ---- last if $pack ne $curpack; } ! my ($subcode, $subref); ! if (ref $c eq 'CODE') { ! $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }"; ! $subref = eval $subcode; ! } ! else { ! $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }"; ! $subref = _doeval($subcode); ! } croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; Index: lib/Class/Struct.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Class/Struct.pm Fri Jul 24 00:00:33 1998 --- perl5.005_02/lib/Class/Struct.pm Sun Aug 2 00:33:12 1998 *************** *** 40,45 **** --- 40,50 ---- $self->[$index]; } + sub FETCHSIZE { + my $self = shift; + return scalar(@$self); + } + sub DESTROY { } } Index: lib/ExtUtils/Liblist.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/ExtUtils/Liblist.pm Fri Jul 24 00:00:35 1998 --- perl5.005_02/lib/ExtUtils/Liblist.pm Wed Aug 5 19:02:22 1998 *************** *** 191,200 **** # (caller should probably use the list in $Config{libs}) return ("", "", "", "") unless $potential_libs; ! my($so) = $Config{'so'}; ! my($libs) = $Config{'libs'}; ! my($libpth) = $Config{'libpth'}; ! my($libext) = $Config{'lib_ext'} || ".lib"; if ($libs and $potential_libs !~ /:nodefault/i) { # If Config.pm defines a set of default libs, we always --- 191,204 ---- # (caller should probably use the list in $Config{libs}) return ("", "", "", "") unless $potential_libs; ! my $cc = $Config{cc}; ! my $VC = 1 if $cc =~ /^cl/i; ! my $BC = 1 if $cc =~ /^bcc/i; ! my $GC = 1 if $cc =~ /^gcc/i; ! my $so = $Config{'so'}; ! my $libs = $Config{'libs'}; ! my $libpth = $Config{'libpth'}; ! my $libext = $Config{'lib_ext'} || ".lib"; if ($libs and $potential_libs !~ /:nodefault/i) { # If Config.pm defines a set of default libs, we always *************** *** 212,272 **** # compute $extralibs from $potential_libs ! my(@searchpath); # from "-L/path" entries in $potential_libs ! my(@libpath) = Text::ParseWords::quotewords('\s+', 0, $libpth); ! my(@extralibs); my($fullname, $thislib, $thispth); ! my($pwd) = cwd(); # from Cwd.pm ! my($lib) = ''; ! my($found) = 0; ! ! foreach $thislib (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ ! ! # Handle possible linker path arguments. ! if ($thislib =~ s/^-L// and not -d $thislib) { ! warn "-L$thislib ignored, directory does not exist\n" if $verbose; next; } ! elsif (-d $thislib) { ! unless ($self->file_name_is_absolute($thislib)) { ! warn "Warning: '-L$thislib' changed to '-L$pwd/$thislib'\n"; ! $thislib = $self->catdir($pwd,$thislib); } ! push(@searchpath, $thislib); next; } ! # Handle possible library arguments. ! if ($thislib =~ s/^-l// and $thislib !~ /^lib/i) { ! $thislib = "lib$thislib"; } ! $thislib .= $libext if $thislib !~ /\Q$libext\E$/i; # look for the file itself ! if (-f $thislib) { ! warn "'$thislib' found\n" if $verbose; $found++; ! push(@extralibs, $thislib); next; } ! my($found_lib)=0; foreach $thispth (@searchpath, @libpath){ ! unless (-f ($fullname="$thispth\\$thislib")) { ! warn "$thislib not found in $thispth\n" if $verbose; next; } ! warn "'$thislib' found at $fullname\n" if $verbose; $found++; $found_lib++; push(@extralibs, $fullname); last; } warn "Note (probably harmless): " ."No library found for '$thislib'\n" unless $found_lib>0; } return ('','','','') unless $found; # make sure paths with spaces are properly quoted --- 216,315 ---- # compute $extralibs from $potential_libs ! my @searchpath; # from "-L/path" in $potential_libs ! my @libpath = Text::ParseWords::quotewords('\s+', 0, $libpth); ! my @extralibs; ! my $pwd = cwd(); # from Cwd.pm ! my $lib = ''; ! my $found = 0; ! my $search = 1; my($fullname, $thislib, $thispth); ! ! foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ ! ! $thislib = $_; ! ! # see if entry is a flag ! if (/^:\w+$/) { ! $search = 0 if lc eq ':nosearch'; ! $search = 1 if lc eq ':search'; ! warn "Ignoring unknown flag '$thislib'\n" ! if $verbose and !/^:(no)?(search|default)$/i; ! next; ! } ! ! # if searching is disabled, do compiler-specific translations ! unless ($search) { ! s/^-L/-libpath:/ if $VC; ! s/^-l(.+)$/$1.lib/ unless $GC; ! push(@extralibs, $_); ! $found++; ! next; ! } ! ! # handle possible linker path arguments ! if (s/^-L// and not -d) { ! warn "$thislib ignored, directory does not exist\n" if $verbose; next; } ! elsif (-d) { ! unless ($self->file_name_is_absolute($_)) { ! warn "Warning: '$thislib' changed to '-L$pwd/$_'\n"; ! $_ = $self->catdir($pwd,$_); } ! push(@searchpath, $_); next; } ! # handle possible library arguments ! if (s/^-l// and $GC and !/^lib/i) { ! $_ = "lib$_"; } ! $_ .= $libext if !/\Q$libext\E$/i; ! ! my $secondpass = 0; ! LOOKAGAIN: # look for the file itself ! if (-f) { ! warn "'$thislib' found as '$_'\n" if $verbose; $found++; ! push(@extralibs, $_); next; } ! my $found_lib = 0; foreach $thispth (@searchpath, @libpath){ ! unless (-f ($fullname="$thispth\\$_")) { ! warn "'$thislib' not found as '$fullname'\n" if $verbose; next; } ! warn "'$thislib' found as '$fullname'\n" if $verbose; $found++; $found_lib++; push(@extralibs, $fullname); last; } + + # do another pass with (or without) leading 'lib' if they used -l + if (!$found_lib and $thislib =~ /^-l/ and !$secondpass++) { + if ($GC) { + goto LOOKAGAIN if s/^lib//i; + } + elsif (!/^lib/i) { + $_ = "lib$_"; + goto LOOKAGAIN; + } + } + + # give up warn "Note (probably harmless): " ."No library found for '$thislib'\n" unless $found_lib>0; + } + return ('','','','') unless $found; # make sure paths with spaces are properly quoted *************** *** 579,594 **** =item * Input library and path specifications are accepted with or without the ! C<-l> and C<-L> prefices used by Unix linkers. C<-lfoo> specifies the ! library C (unless C already starts with C), and ! C<-Ls:ome\dir> specifies a directory to look for the libraries that follow. ! If neither prefix is present, a token is considered a directory to search ! if it is in fact a directory, and a library to search for otherwise. The ! C<$Config{lib_ext}> suffix will be appended to any entries that are not ! directories and don't already have the suffix. Authors who wish their ! extensions to be portable to Unix or OS/2 should use the Unix prefixes, ! since the Unix-OS/2 version of ext() requires them. =item * --- 622,659 ---- =item * + If C<$potential_libs> is empty, the return value will be empty. + Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a + space-separated list of fully qualified library pathnames is generated. + + =item * + Input library and path specifications are accepted with or without the ! C<-l> and C<-L> prefices used by Unix linkers. ! ! An entry of the form C<-La:\foo> specifies the C directory to look ! for the libraries that follow. ! ! An entry of the form C<-lfoo> specifies the library C, which may be ! spelled differently depending on what kind of compiler you are using. If ! you are using GCC, it gets translated to C, but for other win32 ! compilers, it becomes C. If no files are found by those translated ! names, one more attempt is made to find them using either C or ! C, depending on whether GCC or some other win32 compiler is ! being used, respectively. ! ! If neither the C<-L> or C<-l> prefix is present in an entry, the entry is ! considered a directory to search if it is in fact a directory, and a ! library to search for otherwise. The C<$Config{lib_ext}> suffix will ! be appended to any entries that are not directories and don't already have ! the suffix. ! ! Note that the C<-L> and <-l> prefixes are B, but authors ! who wish their extensions to be portable to Unix or OS/2 should use the ! prefixes, since the Unix-OS/2 version of ext() requires them. =item * *************** *** 597,611 **** =item * ! If C<$potential_libs> is empty, the return value will be empty. ! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) ! will be appended to the list of C<$potential_libs>. The libraries ! will be searched for in the directories specified in C<$potential_libs> ! as well as in C<$Config{libpth}>. For each library that is found, a ! space-separated list of fully qualified library pathnames is generated. ! You may specify an entry that matches C in ! C<$potential_libs> to disable the appending of default libraries ! found in C<$Config{libs}> (this should be only needed very rarely). =item * --- 662,682 ---- =item * ! Entries in C<$potential_libs> beginning with a colon and followed by ! alphanumeric characters are treated as flags. Unknown flags will be ignored. ! ! An entry that matches C disables the appending of default ! libraries found in C<$Config{libs}> (this should be only needed very rarely). ! ! An entry that matches C disables all searching for ! the libraries specified after it. Translation of C<-Lfoo> and ! C<-lfoo> still happens as appropriate (depending on compiler being used, ! as reflected by C<$Config{cc}>), but the entries are not verified to be ! valid files or directories. ! ! An entry that matches C reenables searching for ! the libraries specified after it. You can put it at the end to ! enable searching for default libraries specified by C<$Config{libs}>. =item * *************** *** 629,634 **** --- 700,743 ---- Note how the first and last entries are protected by quotes in order to protect the spaces. + + =item * + + Since this module is most often used only indirectly from extension + C files, here is an example C entry to add + a library to the build process for an extension: + + LIBS => ['-lgl'] + + When using GCC, that entry specifies that MakeMaker should first look + for C (followed by C) in all the locations specified by + C<$Config{libpth}>. + + When using a compiler other than GCC, the above entry will search for + C (followed by C). + + If the library happens to be in a location not in C<$Config{libpth}>, + you need: + + LIBS => ['-Lc:\gllibs -lgl'] + + Here is a less often used example: + + LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32'] + + This specifies a search for library C as before. If that search + fails to find the library, it looks at the next item in the list. The + C<:nosearch> flag will prevent searching for the libraries that follow, + so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>, + since GCC can use that value as is with its linker. + + When using the Visual C compiler, the second item is returned as + C<-libpath:d:\mesalibs mesa.lib user32.lib>. + + When using the Borland compiler, the second item is returned as + C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of + moving the C<-Ld:\mesalibs> to the correct place in the linker + command line. =back Index: lib/ExtUtils/MM_Win32.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/ExtUtils/MM_Win32.pm Fri Jul 24 00:00:39 1998 --- perl5.005_02/lib/ExtUtils/MM_Win32.pm Wed Aug 5 18:34:20 1998 *************** *** 67,73 **** sub maybe_command { my($self,$file) = @_; ! return "$file.exe" if -e "$file.exe"; return; } --- 67,87 ---- sub maybe_command { my($self,$file) = @_; ! my @e = exists($ENV{'PATHEXT'}) ! ? split(/;/, $ENV{PATHEXT}) ! : qw(.com .exe .bat .cmd); ! my $e = ''; ! for (@e) { $e .= "\Q$_\E|" } ! chop $e; ! # see if file ends in one of the known extensions ! if ($file =~ /($e)$/i) { ! return $file if -e $file; ! } ! else { ! for (@e) { ! return "$file$_" if -e "$file$_"; ! } ! } return; } *************** *** 155,175 **** $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f'; $self->{'LD'} = $Config{'ld'} || 'link'; $self->{'AR'} = $Config{'ar'} || 'lib'; ! if ($GCC) ! { ! $self->{'LDLOADLIBS'} ||= ' '; ! } ! else ! { ! $self->{'LDLOADLIBS'} ! ||= ( $BORLAND ! ? 'import32.lib' ! : # compiler adds msvcrtd?.lib according to debug switches ! 'oldnames.lib kernel32.lib comdlg32.lib winspool.lib gdi32.lib ' ! .'advapi32.lib user32.lib shell32.lib netapi32.lib ole32.lib ' ! .'oleaut32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib' ! ) . ' $(LIBC) odbc32.lib odbccp32.lib'; ! } $self->{'DEV_NULL'} = '> NUL'; # $self->{'NOECHO'} = ''; # till we have it working } --- 169,187 ---- $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f'; $self->{'LD'} = $Config{'ld'} || 'link'; $self->{'AR'} = $Config{'ar'} || 'lib'; ! $self->{'LDLOADLIBS'} ||= $Config{'libs'}; ! # -Lfoo must come first for Borland, so we put it in LDDLFLAGS ! if ($BORLAND) { ! my $libs = $self->{'LDLOADLIBS'}; ! my $libpath = ''; ! while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) { ! $libpath .= ' ' if length $libpath; ! $libpath .= $1; ! } ! $self->{'LDLOADLIBS'} = $libs; ! $self->{'LDDLFLAGS'} ||= $Config{'lddlflags'}; ! $self->{'LDDLFLAGS'} .= " $libpath"; ! } $self->{'DEV_NULL'} = '> NUL'; # $self->{'NOECHO'} = ''; # till we have it working } *************** *** 718,723 **** --- 730,736 ---- =cut sub manifypods { + my($self) = shift; return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n"; } Index: lib/File/DosGlob.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/File/DosGlob.pm Fri Jul 24 00:00:43 1998 --- perl5.005_02/lib/File/DosGlob.pm Fri Aug 7 17:58:39 1998 *************** *** 97,113 **** sub glob { my $pat = shift; my $cxix = shift; # glob without args defaults to $_ $pat = $_ unless defined $pat; # assume global context if not provided one $cxix = '_G_' unless defined $cxix; $iter{$cxix} = 0 unless exists $iter{$cxix}; # if we're just beginning, do it all first if ($iter{$cxix} == 0) { ! $entries{$cxix} = [doglob(1,$pat)]; } # chuck it all out, quick or slow --- 97,123 ---- sub glob { my $pat = shift; my $cxix = shift; + my @pat; # glob without args defaults to $_ $pat = $_ unless defined $pat; + # extract patterns + if ($pat =~ /\s/) { + require Text::ParseWords; + @pat = Text::ParseWords::parse_line('\s+',0,$pat); + } + else { + push @pat, $pat; + } + # assume global context if not provided one $cxix = '_G_' unless defined $cxix; $iter{$cxix} = 0 unless exists $iter{$cxix}; # if we're just beginning, do it all first if ($iter{$cxix} == 0) { ! $entries{$cxix} = [doglob(1,@pat)]; } # chuck it all out, quick or slow *************** *** 174,179 **** --- 184,198 ---- You may have to double the backslashes if you are putting them in literally, due to double-quotish parsing of the pattern by perl. + Spaces in the argument delimit distinct patterns, so + C globs all filenames that end in C<.exe> + or C<.dll>. If you want to put in literal spaces in the glob + pattern, you can escape them with either double quotes, or backslashes. + e.g. C, or + C. The argument is tokenized using + C, so see L for details + of the quoting rules used. + Extending it to csh patterns is left as an exercise to the reader. =head1 EXPORTS (by request only) *************** *** 223,228 **** --- 242,249 ---- perl perlglob.bat + + Text::ParseWords =cut Index: lib/Math/Complex.pm Prereq: 1.25 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Math/Complex.pm Fri Jul 24 00:00:46 1998 --- perl5.005_02/lib/Math/Complex.pm Sat Aug 1 23:42:27 1998 *************** *** 179,185 **** # # The number defined as pi = 180 degrees # ! use constant pi => 4 * atan2(1, 1); # # pit2 --- 179,185 ---- # # The number defined as pi = 180 degrees # ! use constant pi => 4 * CORE::atan2(1, 1); # # pit2 *************** *** 208,214 **** # # Used in log10(). # ! use constant uplog10 => 1 / log(10); # # i --- 208,214 ---- # # Used in log10(). # ! use constant uplog10 => 1 / CORE::log(10); # # i *************** *** 246,252 **** my $self = shift; my ($r, $t) = @{$self->{'polar'}}; $self->{c_dirty} = 0; ! return $self->{'cartesian'} = [$r * cos $t, $r * sin $t]; } # --- 246,252 ---- my $self = shift; my ($r, $t) = @{$self->{'polar'}}; $self->{c_dirty} = 0; ! return $self->{'cartesian'} = [$r * CORE::cos($t), $r * CORE::sin($t)]; } # *************** *** 260,266 **** my ($x, $y) = @{$self->{'cartesian'}}; $self->{p_dirty} = 0; return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0; ! return $self->{'polar'} = [sqrt($x*$x + $y*$y), atan2($y, $x)]; } # --- 260,266 ---- my ($x, $y) = @{$self->{'cartesian'}}; $self->{p_dirty} = 0; return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0; ! return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y), CORE::atan2($y, $x)]; } # *************** *** 432,438 **** return 0 if ($z1z); return 1 if ($z2z or $z1 == 1); } ! my $w = $inverted ? exp($z1 * log $z2) : exp($z2 * log $z1); # If both arguments cartesian, return cartesian, else polar. return $z1->{c_dirty} == 0 && (not ref $z2 or $z2->{c_dirty} == 0) ? --- 432,438 ---- return 0 if ($z1z); return 1 if ($z2z or $z1 == 1); } ! my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) : CORE::exp($z2 * CORE::log($z1)); # If both arguments cartesian, return cartesian, else polar. return $z1->{c_dirty} == 0 && (not ref $z2 or $z2->{c_dirty} == 0) ? *************** *** 548,556 **** sub sqrt { my ($z) = @_; my ($re, $im) = ref $z ? @{$z->cartesian} : ($z, 0); ! return $re < 0 ? cplx(0, sqrt(-$re)) : sqrt($re) if $im == 0; my ($r, $t) = @{$z->polar}; ! return (ref $z)->emake(sqrt($r), $t/2); } # --- 548,556 ---- sub sqrt { my ($z) = @_; my ($re, $im) = ref $z ? @{$z->cartesian} : ($z, 0); ! return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) if $im == 0; my ($r, $t) = @{$z->polar}; ! return (ref $z)->emake(CORE::sqrt($r), $t/2); } # *************** *** 562,571 **** # sub cbrt { my ($z) = @_; ! return $z < 0 ? -exp(log(-$z)/3) : ($z > 0 ? exp(log($z)/3): 0) unless ref $z; my ($r, $t) = @{$z->polar}; ! return (ref $z)->emake(exp(log($r)/3), $t/3); } # --- 562,571 ---- # sub cbrt { my ($z) = @_; ! return $z < 0 ? -CORE::exp(CORE::log(-$z)/3) : ($z > 0 ? CORE::exp(CORE::log($z)/3): 0) unless ref $z; my ($r, $t) = @{$z->polar}; ! return (ref $z)->emake(CORE::exp(CORE::log($r)/3), $t/3); } # *************** *** 596,602 **** sub root { my ($z, $n) = @_; _rootbad($n) if ($n < 1 or int($n) != $n); ! my ($r, $t) = ref $z ? @{$z->polar} : (abs($z), $z >= 0 ? 0 : pi); my @root; my $k; my $theta_inc = pit2 / $n; --- 596,602 ---- sub root { my ($z, $n) = @_; _rootbad($n) if ($n < 1 or int($n) != $n); ! my ($r, $t) = ref $z ? @{$z->polar} : (CORE::abs($z), $z >= 0 ? 0 : pi); my @root; my $k; my $theta_inc = pit2 / $n; *************** *** 671,677 **** sub exp { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! return (ref $z)->emake(exp($x), $y); } # --- 671,677 ---- sub exp { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! return (ref $z)->emake(CORE::exp($x), $y); } # *************** *** 704,716 **** my ($z) = @_; unless (ref $z) { _logofzero("log") if $z == 0; ! return $z > 0 ? log($z) : cplx(log(-$z), pi); } my ($r, $t) = @{$z->polar}; _logofzero("log") if $r == 0; if ($t > pi()) { $t -= pit2 } elsif ($t <= -pi()) { $t += pit2 } ! return (ref $z)->make(log($r), $t); } # --- 704,716 ---- my ($z) = @_; unless (ref $z) { _logofzero("log") if $z == 0; ! return $z > 0 ? CORE::log($z) : cplx(CORE::log(-$z), pi); } my ($r, $t) = @{$z->polar}; _logofzero("log") if $r == 0; if ($t > pi()) { $t -= pit2 } elsif ($t <= -pi()) { $t += pit2 } ! return (ref $z)->make(CORE::log($r), $t); } # *************** *** 739,746 **** my ($z, $n) = @_; $z = cplx($z, 0) unless ref $z; my $logn = $logn{$n}; ! $logn = $logn{$n} = log($n) unless defined $logn; # Cache log(n) ! return log($z) / $logn; } # --- 739,746 ---- my ($z, $n) = @_; $z = cplx($z, 0) unless ref $z; my $logn = $logn{$n}; ! $logn = $logn{$n} = CORE::log($n) unless defined $logn; # Cache log(n) ! return CORE::log($z) / $logn; } # *************** *** 751,760 **** sub cos { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! my $ey = exp($y); my $ey_1 = 1 / $ey; ! return (ref $z)->make(cos($x) * ($ey + $ey_1)/2, ! sin($x) * ($ey_1 - $ey)/2); } # --- 751,760 ---- sub cos { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! my $ey = CORE::exp($y); my $ey_1 = 1 / $ey; ! return (ref $z)->make(CORE::cos($x) * ($ey + $ey_1)/2, ! CORE::sin($x) * ($ey_1 - $ey)/2); } # *************** *** 765,774 **** sub sin { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! my $ey = exp($y); my $ey_1 = 1 / $ey; ! return (ref $z)->make(sin($x) * ($ey + $ey_1)/2, ! cos($x) * ($ey - $ey_1)/2); } # --- 765,774 ---- sub sin { my ($z) = @_; my ($x, $y) = @{$z->cartesian}; ! my $ey = CORE::exp($y); my $ey_1 = 1 / $ey; ! return (ref $z)->make(CORE::sin($x) * ($ey + $ey_1)/2, ! CORE::cos($x) * ($ey - $ey_1)/2); } # *************** *** 778,786 **** # sub tan { my ($z) = @_; ! my $cz = cos($z); ! _divbyzero "tan($z)", "cos($z)" if (abs($cz) < $eps); ! return sin($z) / $cz; } # --- 778,786 ---- # sub tan { my ($z) = @_; ! my $cz = CORE::cos($z); ! _divbyzero "tan($z)", "cos($z)" if (CORE::abs($cz) < $eps); ! return CORE::sin($z) / $cz; } # *************** *** 790,796 **** # sub sec { my ($z) = @_; ! my $cz = cos($z); _divbyzero "sec($z)", "cos($z)" if ($cz == 0); return 1 / $cz; } --- 790,796 ---- # sub sec { my ($z) = @_; ! my $cz = CORE::cos($z); _divbyzero "sec($z)", "cos($z)" if ($cz == 0); return 1 / $cz; } *************** *** 802,808 **** # sub csc { my ($z) = @_; ! my $sz = sin($z); _divbyzero "csc($z)", "sin($z)" if ($sz == 0); return 1 / $sz; } --- 802,808 ---- # sub csc { my ($z) = @_; ! my $sz = CORE::sin($z); _divbyzero "csc($z)", "sin($z)" if ($sz == 0); return 1 / $sz; } *************** *** 821,829 **** # sub cot { my ($z) = @_; ! my $sz = sin($z); _divbyzero "cot($z)", "sin($z)" if ($sz == 0); ! return cos($z) / $sz; } # --- 821,829 ---- # sub cot { my ($z) = @_; ! my $sz = CORE::sin($z); _divbyzero "cot($z)", "sin($z)" if ($sz == 0); ! return CORE::cos($z) / $sz; } # *************** *** 840,856 **** # sub acos { my $z = $_[0]; ! return atan2(sqrt(1-$z*$z), $z) if (! ref $z) && abs($z) <= 1; my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); ! my $t1 = sqrt(($x+1)*($x+1) + $y*$y); ! my $t2 = sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; my $beta = ($t1 - $t2)/2; $alpha = 1 if $alpha < 1; if ($beta > 1) { $beta = 1 } elsif ($beta < -1) { $beta = -1 } ! my $u = atan2(sqrt(1-$beta*$beta), $beta); ! my $v = log($alpha + sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); return $package->make($u, $v); } --- 840,856 ---- # sub acos { my $z = $_[0]; ! return CORE::atan2(CORE::sqrt(1-$z*$z), $z) if (! ref $z) && CORE::abs($z) <= 1; my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); ! my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y); ! my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; my $beta = ($t1 - $t2)/2; $alpha = 1 if $alpha < 1; if ($beta > 1) { $beta = 1 } elsif ($beta < -1) { $beta = -1 } ! my $u = CORE::atan2(CORE::sqrt(1-$beta*$beta), $beta); ! my $v = CORE::log($alpha + CORE::sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); return $package->make($u, $v); } *************** *** 862,878 **** # sub asin { my $z = $_[0]; ! return atan2($z, sqrt(1-$z*$z)) if (! ref $z) && abs($z) <= 1; my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); ! my $t1 = sqrt(($x+1)*($x+1) + $y*$y); ! my $t2 = sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; my $beta = ($t1 - $t2)/2; $alpha = 1 if $alpha < 1; if ($beta > 1) { $beta = 1 } elsif ($beta < -1) { $beta = -1 } ! my $u = atan2($beta, sqrt(1-$beta*$beta)); ! my $v = -log($alpha + sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); return $package->make($u, $v); } --- 862,878 ---- # sub asin { my $z = $_[0]; ! return CORE::atan2($z, CORE::sqrt(1-$z*$z)) if (! ref $z) && CORE::abs($z) <= 1; my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); ! my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y); ! my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; my $beta = ($t1 - $t2)/2; $alpha = 1 if $alpha < 1; if ($beta > 1) { $beta = 1 } elsif ($beta < -1) { $beta = -1 } ! my $u = CORE::atan2($beta, CORE::sqrt(1-$beta*$beta)); ! my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); return $package->make($u, $v); } *************** *** 884,893 **** # sub atan { my ($z) = @_; ! return atan2($z, 1) unless ref $z; _divbyzero "atan(i)" if ( $z == i); _divbyzero "atan(-i)" if (-$z == i); ! my $log = log((i + $z) / (i - $z)); $ip2 = 0.5 * i unless defined $ip2; return $ip2 * $log; } --- 884,893 ---- # sub atan { my ($z) = @_; ! return CORE::atan2($z, 1) unless ref $z; _divbyzero "atan(i)" if ( $z == i); _divbyzero "atan(-i)" if (-$z == i); ! my $log = CORE::log((i + $z) / (i - $z)); $ip2 = 0.5 * i unless defined $ip2; return $ip2 * $log; } *************** *** 928,937 **** # sub acot { my ($z) = @_; ! _divbyzero "acot(0)" if (abs($z) < $eps); ! return ($z >= 0) ? atan2(1, $z) : atan2(-1, -$z) unless ref $z; ! _divbyzero "acot(i)" if (abs($z - i) < $eps); ! _logofzero "acot(-i)" if (abs($z + i) < $eps); return atan(1 / $z); } --- 928,937 ---- # sub acot { my ($z) = @_; ! _divbyzero "acot(0)" if (CORE::abs($z) < $eps); ! return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z) unless ref $z; ! _divbyzero "acot(i)" if (CORE::abs($z - i) < $eps); ! _logofzero "acot(-i)" if (CORE::abs($z + i) < $eps); return atan(1 / $z); } *************** *** 951,964 **** my ($z) = @_; my $ex; unless (ref $z) { ! $ex = exp($z); return ($ex + 1/$ex)/2; } my ($x, $y) = @{$z->cartesian}; ! $ex = exp($x); my $ex_1 = 1 / $ex; ! return (ref $z)->make(cos($y) * ($ex + $ex_1)/2, ! sin($y) * ($ex - $ex_1)/2); } # --- 951,964 ---- my ($z) = @_; my $ex; unless (ref $z) { ! $ex = CORE::exp($z); return ($ex + 1/$ex)/2; } my ($x, $y) = @{$z->cartesian}; ! $ex = CORE::exp($x); my $ex_1 = 1 / $ex; ! return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2, ! CORE::sin($y) * ($ex - $ex_1)/2); } # *************** *** 970,983 **** my ($z) = @_; my $ex; unless (ref $z) { ! $ex = exp($z); return ($ex - 1/$ex)/2; } my ($x, $y) = @{$z->cartesian}; ! $ex = exp($x); my $ex_1 = 1 / $ex; ! return (ref $z)->make(cos($y) * ($ex - $ex_1)/2, ! sin($y) * ($ex + $ex_1)/2); } # --- 970,983 ---- my ($z) = @_; my $ex; unless (ref $z) { ! $ex = CORE::exp($z); return ($ex - 1/$ex)/2; } my ($x, $y) = @{$z->cartesian}; ! $ex = CORE::exp($x); my $ex_1 = 1 / $ex; ! return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2, ! CORE::sin($y) * ($ex + $ex_1)/2); } # *************** *** 1050,1064 **** sub acosh { my ($z) = @_; unless (ref $z) { ! return log($z + sqrt($z*$z-1)) if $z >= 1; $z = cplx($z, 0); } my ($re, $im) = @{$z->cartesian}; if ($im == 0) { ! return cplx(log($re + sqrt($re*$re - 1)), 0) if $re >= 1; ! return cplx(0, atan2(sqrt(1-$re*$re), $re)) if abs($re) <= 1; } ! return log($z + sqrt($z*$z - 1)); } # --- 1050,1064 ---- sub acosh { my ($z) = @_; unless (ref $z) { ! return CORE::log($z + CORE::sqrt($z*$z-1)) if $z >= 1; $z = cplx($z, 0); } my ($re, $im) = @{$z->cartesian}; if ($im == 0) { ! return cplx(CORE::log($re + CORE::sqrt($re*$re - 1)), 0) if $re >= 1; ! return cplx(0, CORE::atan2(CORE::sqrt(1-$re*$re), $re)) if CORE::abs($re) <= 1; } ! return CORE::log($z + CORE::sqrt($z*$z - 1)); } # *************** *** 1068,1074 **** # sub asinh { my ($z) = @_; ! return log($z + sqrt($z*$z + 1)); } # --- 1068,1074 ---- # sub asinh { my ($z) = @_; ! return CORE::log($z + CORE::sqrt($z*$z + 1)); } # *************** *** 1079,1090 **** sub atanh { my ($z) = @_; unless (ref $z) { ! return log((1 + $z)/(1 - $z))/2 if abs($z) < 1; $z = cplx($z, 0); } _divbyzero 'atanh(1)', "1 - $z" if ($z == 1); _logofzero 'atanh(-1)' if ($z == -1); ! return 0.5 * log((1 + $z) / (1 - $z)); } # --- 1079,1090 ---- sub atanh { my ($z) = @_; unless (ref $z) { ! return CORE::log((1 + $z)/(1 - $z))/2 if CORE::abs($z) < 1; $z = cplx($z, 0); } _divbyzero 'atanh(1)', "1 - $z" if ($z == 1); _logofzero 'atanh(-1)' if ($z == -1); ! return 0.5 * CORE::log((1 + $z) / (1 - $z)); } # *************** *** 1123,1136 **** # sub acoth { my ($z) = @_; ! _divbyzero 'acoth(0)' if (abs($z) < $eps); unless (ref $z) { ! return log(($z + 1)/($z - 1))/2 if abs($z) > 1; $z = cplx($z, 0); } ! _divbyzero 'acoth(1)', "$z - 1" if (abs($z - 1) < $eps); ! _logofzero 'acoth(-1)', "1 / $z" if (abs($z + 1) < $eps); ! return log((1 + $z) / ($z - 1)) / 2; } # --- 1123,1136 ---- # sub acoth { my ($z) = @_; ! _divbyzero 'acoth(0)' if (CORE::abs($z) < $eps); unless (ref $z) { ! return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1; $z = cplx($z, 0); } ! _divbyzero 'acoth(1)', "$z - 1" if (CORE::abs($z - 1) < $eps); ! _logofzero 'acoth(-1)', "1 / $z" if (CORE::abs($z + 1) < $eps); ! return CORE::log((1 + $z) / ($z - 1)) / 2; } # *************** *** 1156,1162 **** ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0); } if ($im2 == 0) { ! return cplx(atan2($re1, $re2), 0) if $im1 == 0; return cplx(($im1<=>0) * pip2, 0) if $re2 == 0; } my $w = atan($z1/$z2); --- 1156,1162 ---- ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0); } if ($im2 == 0) { ! return cplx(CORE::atan2($re1, $re2), 0) if $im1 == 0; return cplx(($im1<=>0) * pip2, 0) if $re2 == 0; } my $w = atan($z1/$z2); *************** *** 1232,1245 **** my ($re, $im); $x = int($x + ($x < 0 ? -1 : 1) * $eps) ! if int(abs($x)) != int(abs($x) + $eps); $y = int($y + ($y < 0 ? -1 : 1) * $eps) ! if int(abs($y)) != int(abs($y) + $eps); ! $re = "$x" if abs($x) >= $eps; if ($y == 1) { $im = 'i' } elsif ($y == -1) { $im = '-i' } ! elsif (abs($y) >= $eps) { $im = $y . "i" } my $str = ''; $str = $re if defined $re; --- 1232,1245 ---- my ($re, $im); $x = int($x + ($x < 0 ? -1 : 1) * $eps) ! if int(CORE::abs($x)) != int(CORE::abs($x) + $eps); $y = int($y + ($y < 0 ? -1 : 1) * $eps) ! if int(CORE::abs($y)) != int(CORE::abs($y) + $eps); ! $re = "$x" if CORE::abs($x) >= $eps; if ($y == 1) { $im = 'i' } elsif ($y == -1) { $im = '-i' } ! elsif (CORE::abs($y) >= $eps) { $im = $y . "i" } my $str = ''; $str = $re if defined $re; *************** *** 1298,1312 **** $nt = ($nt - int($nt)) * pit2; $nt += pit2 if $nt < 0; # Range [0, 2pi] ! if (abs($nt) <= $eps) { $theta = 0 } ! elsif (abs(pi-$nt) <= $eps) { $theta = 'pi' } if (defined $theta) { $r = int($r + ($r < 0 ? -1 : 1) * $eps) ! if int(abs($r)) != int(abs($r) + $eps); $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) if ($theta ne 'pi' and ! int(abs($theta)) != int(abs($theta) + $eps)); return "\[$r,$theta\]"; } --- 1298,1312 ---- $nt = ($nt - int($nt)) * pit2; $nt += pit2 if $nt < 0; # Range [0, 2pi] ! if (CORE::abs($nt) <= $eps) { $theta = 0 } ! elsif (CORE::abs(pi-$nt) <= $eps) { $theta = 'pi' } if (defined $theta) { $r = int($r + ($r < 0 ? -1 : 1) * $eps) ! if int(CORE::abs($r)) != int(CORE::abs($r) + $eps); $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) if ($theta ne 'pi' and ! int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps)); return "\[$r,$theta\]"; } *************** *** 1316,1328 **** $nt -= pit2 if $nt > pi; ! if (abs($nt) >= deg1) { my ($n, $k, $kpi); for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) { $n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5); ! if (abs($kpi/$n - $nt) <= $eps) { ! $n = abs $n; my $gcd = gcd($k, $n); if ($gcd > 1) { $k /= $gcd; --- 1316,1328 ---- $nt -= pit2 if $nt > pi; ! if (CORE::abs($nt) >= deg1) { my ($n, $k, $kpi); for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) { $n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5); ! if (CORE::abs($kpi/$n - $nt) <= $eps) { ! $n = CORE::abs($n); my $gcd = gcd($k, $n); if ($gcd > 1) { $k /= $gcd; *************** *** 1340,1349 **** $theta = $nt unless defined $theta; $r = int($r + ($r < 0 ? -1 : 1) * $eps) ! if int(abs($r)) != int(abs($r) + $eps); $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) if ($theta !~ m(^-?\d*pi/\d+$) and ! int(abs($theta)) != int(abs($theta) + $eps)); return "\[$r,$theta\]"; } --- 1340,1349 ---- $theta = $nt unless defined $theta; $r = int($r + ($r < 0 ? -1 : 1) * $eps) ! if int(CORE::abs($r)) != int(CORE::abs($r) + $eps); $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) if ($theta !~ m(^-?\d*pi/\d+$) and ! int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps)); return "\[$r,$theta\]"; } Index: lib/Pod/Html.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Pod/Html.pm Fri Jul 24 00:00:49 1998 --- perl5.005_02/lib/Pod/Html.pm Tue Aug 4 15:59:32 1998 *************** *** 1293,1299 **** } elsif ($word =~ m,^\w+://\w,) { # looks like a URL $word = qq($word); ! } elsif ($word =~ /[\w.-]+\@\w+\.\w/) { # looks like an e-mail address my ($w1, $w2, $w3) = ("", $word, ""); ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/; --- 1293,1299 ---- } elsif ($word =~ m,^\w+://\w,) { # looks like a URL $word = qq($word); ! } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) { # looks like an e-mail address my ($w1, $w2, $w3) = ("", $word, ""); ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/; Index: lib/Test/Harness.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Test/Harness.pm Fri Jul 24 00:00:51 1998 --- perl5.005_02/lib/Test/Harness.pm Tue Aug 4 23:15:42 1998 *************** *** 16,21 **** --- 16,23 ---- # Some experimental versions of OS/2 build have broken $? my $ignore_exitcode = $ENV{HARNESS_IGNORE_EXITCODE}; + my $files_in_dir = $ENV{HARNESS_FILELEAK_IN_DIR}; + my $tests_skipped = 0; my $subtests_skipped = 0; *************** *** 46,51 **** --- 48,55 ---- $verbose = 0; $switches = "-w"; + sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f } + sub runtests { my(@tests) = @_; local($|) = 1; *************** *** 62,67 **** --- 66,72 ---- if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g } + my @dir_files = globdir $files_in_dir if defined $files_in_dir; my $t_start = new Benchmark; while ($test = shift(@tests)) { $te = $test; *************** *** 212,217 **** --- 217,233 ---- }; } $subtests_skipped += $skipped; + if (defined $files_in_dir) { + my @new_dir_files = globdir $files_in_dir; + if (@new_dir_files != @dir_files) { + my %f; + @f{@new_dir_files} = (1) x @new_dir_files; + delete @f{@dir_files}; + my @f = sort keys %f; + print "LEAKED FILES: @f\n"; + @dir_files = @new_dir_files; + } + } } my $t_total = timediff(new Benchmark, $t_start); *************** *** 421,428 **** =head1 ENVIRONMENT ! Setting C makes it ignore the exit status of child processes. =head1 SEE ALSO --- 437,454 ---- =head1 ENVIRONMENT ! Setting C makes harness ignore the exit status of child processes. + + If C is set to the name of a directory, harness + will check after each test whether new files appeared in that directory, + and report them as + + LEAKED FILES: scr.tmp 0 my.db + + If relative, directory name is with respect to the current directory at + the moment runtests() was called. Putting absolute path into + C may give more predicatable results. =head1 SEE ALSO Index: lib/Test.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/Test.pm Fri Jul 24 00:00:51 1998 --- perl5.005_02/lib/Test.pm Fri Aug 7 17:40:39 1998 *************** *** 225,231 **** =head1 AUTHOR ! Copyright © 1998 Joshua Nathaniel Pritikin. All rights reserved. This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified --- 225,231 ---- =head1 AUTHOR ! Copyright (C) 1998 Joshua Nathaniel Pritikin. All rights reserved. This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified Index: lib/bigint.pl ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/bigint.pl Fri Jul 24 00:00:53 1998 --- perl5.005_02/lib/bigint.pl Sun Aug 2 01:15:07 1998 *************** *** 74,80 **** sub main'bneg { #(num_str) return num_str local($_) = &'bnorm(@_); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0'; ! s/^H/N/; $_; } --- 74,80 ---- sub main'bneg { #(num_str) return num_str local($_) = &'bnorm(@_); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0'; ! s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC $_; } Index: lib/dumpvar.pl ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/dumpvar.pl Fri Jul 24 00:00:54 1998 --- perl5.005_02/lib/dumpvar.pl Sat Aug 1 15:42:47 1998 *************** *** 23,28 **** --- 23,29 ---- $unctrl = 'quote' unless defined $unctrl; $subdump = 1; $dumpReused = 0 unless defined $dumpReused; + $bareStringify = 1 unless defined $bareStringify; sub main::dumpValue { local %address; *************** *** 50,55 **** --- 51,60 ---- return 'undef' unless defined $_ or not $printUndef; return $_ . "" if ref \$_ eq 'GLOB'; + $_ = &{'overload::StrVal'}($_) + if $bareStringify and ref $_ + and defined %overload:: and defined &{'overload::StrVal'}; + if ($tick eq 'auto') { if (/[\000-\011\013-\037\177]/) { $tick = '"'; *************** *** 110,116 **** return if $DB::signal; local($v) = shift ; local($s) = shift ; # extra no of spaces ! local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ; local($tHashDepth,$tArrayDepth) ; $sp = " " x $s ; --- 115,121 ---- return if $DB::signal; local($v) = shift ; local($s) = shift ; # extra no of spaces ! local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ; local($tHashDepth,$tArrayDepth) ; $sp = " " x $s ; *************** *** 118,126 **** # Check for reused addresses if (ref $v) { ! ($address) = $v =~ /(0x[0-9a-f]+)\)$/ ; if (!$dumpReused && defined $address) { - ($type) = $v =~ /=(.*?)\([^=]+$/ ; $address{$address}++ ; if ( $address{$address} > 1 ) { print "${sp}-> REUSED_ADDRESS\n" ; --- 123,133 ---- # Check for reused addresses if (ref $v) { ! my $val = $v; ! $val = &{'overload::StrVal'}($v) ! if defined %overload:: and defined &{'overload::StrVal'}; ! ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; if (!$dumpReused && defined $address) { $address{$address}++ ; if ( $address{$address} > 1 ) { print "${sp}-> REUSED_ADDRESS\n" ; Index: lib/overload.pm ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/overload.pm Fri Jul 24 00:00:56 1998 --- perl5.005_02/lib/overload.pm Sat Aug 1 15:58:04 1998 *************** *** 62,68 **** my $package = shift; $package = ref $package if ref $package; #$package->can('(""') ! ov_method mycan($package, '(""'), $package; } sub Method { --- 62,71 ---- my $package = shift; $package = ref $package if ref $package; #$package->can('(""') ! ov_method mycan($package, '(""'), $package ! or ov_method mycan($package, '(0+'), $package ! or ov_method mycan($package, '(bool'), $package ! or ov_method mycan($package, '(nomethod'), $package; } sub Method { *************** *** 108,113 **** --- 111,128 ---- 'qr' => 0x10000, ); + %ops = ( with_assign => "+ - * / % ** << >> x .", + assign => "+= -= *= /= %= **= <<= >>= x= .=", + str_comparison => "< <= > >= == !=", + '3way_comparison'=> "<=> cmp", + num_comparison => "lt le gt ge eq ne", + binary => "& | ^", + unary => "neg ! ~", + mutators => '++ --', + func => "atan2 cos sin exp abs log sqrt", + conversion => 'bool "" 0+', + special => 'nomethod fallback ='); + sub constant { # Arguments: what, sub while (@_) { *************** *** 220,226 **** the current operation is an assignment variant (as in C<$a+=7>), but the usual function is called instead. This additional ! information can be used to generate some optimizations. =back --- 235,242 ---- the current operation is an assignment variant (as in C<$a+=7>), but the usual function is called instead. This additional ! information can be used to generate some optimizations. Compare ! L. =back *************** *** 230,238 **** argument being C. Thus the functions that overloads C<{"++"}> is called with arguments C<($a,undef,'')> when $a++ is executed. =head2 Overloadable Operations ! The following symbols can be specified in C: =over 5 --- 246,312 ---- argument being C. Thus the functions that overloads C<{"++"}> is called with arguments C<($a,undef,'')> when $a++ is executed. + =head2 Calling Conventions for Mutators + + Two types of mutators have different calling conventions: + + =over + + =item C<++> and C<--> + + The routines which implement these operators are expected to actually + I their arguments. So, assuming that $obj is a reference to a + number, + + sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n} + + is an appropriate implementation of overloaded C<++>. Note that + + sub incr { ++$ {$_[0]} ; shift } + + is OK if used with preincrement and with postincrement. (In the case + of postincrement a copying will be performed, see L.) + + =item C and other assignment versions + + There is nothing special about these methods. They may change the + value of their arguments, and may leave it as is. The result is going + to be assigned to the value in the left-hand-side if different from + this value. + + This allows for the same method to be used as averloaded C<+=> and + C<+>. Note that this is I, but not recommended, since by the + semantic of L<"Fallback"> Perl will call the method for C<+> anyway, + if C<+=> is not overloaded. + + =back + + B Due to the presense of assignment versions of operations, + routines which may be called in assignment context may create + self-referencial structures. Currently Perl will not free self-referential + structures until cycles are C broken. You may get problems + when traversing your structures too. + + Say, + + use overload '+' => sub { bless [ \$_[0], \$_[1] ] }; + + is asking for trouble, since for code C<$obj += $foo> the subroutine + is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj, + \$foo]>. If using such a subroutine is an important optimization, one + can overload C<+=> explicitly by a non-"optimized" version, or switch + to non-optimized version if C (see + L). + + Even if no I assignment-variants of operators are present in + the script, they may be generated by the optimizer. Say, C<",$obj,"> or + C<',' . $obj . ','> may be both optimized to + + my $tmp = ',' . $obj; $tmp .= ','; + =head2 Overloadable Operations ! The following symbols can be specified in C directive: =over 5 *************** *** 247,252 **** --- 321,330 ---- increment and decrement methods. The operation "C<->" can be used to autogenerate missing methods for unary minus or C. + See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and + L<"Calling Conventions for Binary Operations">) for details of these + substitutions. + =item * I "<", "<=", ">", ">=", "==", "!=", "<=>", *************** *** 298,304 **** =back ! See L<"Fallback"> for an explanation of when a missing method can be autogenerated. =head2 Inheritance and overloading --- 376,398 ---- =back ! See L<"Fallback"> for an explanation of when a missing method can be ! autogenerated. ! ! A computer-readable form of the above table is available in the hash ! %overload::ops, with values being space-separated lists of names: ! ! with_assign => '+ - * / % ** << >> x .', ! assign => '+= -= *= /= %= **= <<= >>= x= .=', ! str_comparison => '< <= > >= == !=', ! '3way_comparison'=> '<=> cmp', ! num_comparison => 'lt le gt ge eq ne', ! binary => '& | ^', ! unary => 'neg ! ~', ! mutators => '++ --', ! func => 'atan2 cos sin exp abs log sqrt', ! conversion => 'bool "" 0+', ! special => 'nomethod fallback =' =head2 Inheritance and overloading *************** *** 401,415 **** as $a=$b; ! $a++; To make this change $a and not change $b, a copy of C<$$a> is made, and $a is assigned a reference to this new object. This operation is ! done during execution of the C<$a++>, and not during the assignment, (so before the increment C<$$a> coincides with C<$$b>). This is only ! done if C<++> is expressed via a method for C<'++'> or C<'+='>. Note ! that if this operation is expressed via C<'+'> a nonmutator, i.e., as ! in $a=$b; $a=$a+1; --- 495,509 ---- as $a=$b; ! ++$a; To make this change $a and not change $b, a copy of C<$$a> is made, and $a is assigned a reference to this new object. This operation is ! done during execution of the C<++$a>, and not during the assignment, (so before the increment C<$$a> coincides with C<$$b>). This is only ! done if C<++> is expressed via a method for C<'++'> or C<'+='> (or ! C). Note that if this operation is expressed via C<'+'> ! a nonmutator, i.e., as in $a=$b; $a=$a+1; *************** *** 443,448 **** --- 537,545 ---- =back + Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for + C<$b = $a; ++$a>. + =head1 MAGIC AUTOGENERATION If a method for an operation is not found, and the value for C<"fallback"> is *************** *** 499,505 **** =back ! =head1 WARNING The restriction for the comparison operation is that even if, for example, `C' should return a blessed reference, the autogenerated `C' --- 596,602 ---- =back ! =head1 Losing overloading The restriction for the comparison operation is that even if, for example, `C' should return a blessed reference, the autogenerated `C' *************** *** 661,666 **** --- 758,1173 ---- It is expected that arguments to methods that are not explicitly supposed to be changed are constant (but this is not enforced). + =head1 Metaphor clash + + One may wonder why the semantic of overloaded C<=> is so counterintuive. + If it I counterintuive to you, you are subject to a metaphor + clash. + + Here is a Perl object metaphor: + + I< object is a reference to blessed data> + + and an arithmetic metaphor: + + I< object is a thing by itself>. + + The I
problem of overloading C<=> is the fact that these metaphors + imply different actions on the assignment C<$a = $b> if $a and $b are + objects. Perl-think implies that $a becomes a reference to whatever + $b was referencing. Arithmetic-think implies that the value of "object" + $a is changed to become the value of the object $b, preserving the fact + that $a and $b are separate entities. + + The difference is not relevant in the absence of mutators. After + a Perl-way assignment an operation which mutates the data referenced by $a + would change the data referenced by $b too. Effectively, after + C<$a = $b> values of $a and $b become I. + + On the other hand, anyone who has used algebraic notation knows the + expressive power of the arithmetic metaphor. Overloading works hard + to enable this metaphor while preserving the Perlian way as far as + possible. Since it is not not possible to freely mix two contradicting + metaphors, overloading allows the arithmetic way to write things I. The + way it is done is described in L. + + If some mutator methods are directly applied to the overloaded values, + one may need to I other values which references the + same value: + + $a = new Data 23; + ... + $b = $a; # $b is "linked" to $a + ... + $a = $a->clone; # Unlink $b from $a + $a->increment_by(4); + + Note that overloaded access makes this transparent: + + $a = new Data 23; + $b = $a; # $b is "linked" to $a + $a += 4; # would unlink $b automagically + + However, it would not make + + $a = new Data 23; + $a = 4; # Now $a is a plain 4, not 'Data' + + preserve "objectness" of $a. But Perl I a way to make assignments + to an object do whatever you want. It is just not the overload, but + tie()ing interface (see L). Adding a FETCH() method + which returns the object itself, and STORE() method which changes the + value of the object, one can reproduce the arithmetic metaphor in its + completeness, at least for variables which were tie()d from the start. + + (Note that a workaround for a bug may be needed, see L<"BUGS">.) + + =head1 Cookbook + + Please add examples to what follows! + + =head2 Two-face scalars + + Put this in F in your Perl library directory: + + package two_face; # Scalars with separate string and + # numeric values. + sub new { my $p = shift; bless [@_], $p } + use overload '""' => \&str, '0+' => \&num, fallback => 1; + sub num {shift->[1]} + sub str {shift->[0]} + + Use it as follows: + + require two_face; + my $seven = new two_face ("vii", 7); + printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1; + print "seven contains `i'\n" if $seven =~ /i/; + + (The second line creates a scalar which has both a string value, and a + numeric value.) This prints: + + seven=vii, seven=7, eight=8 + seven contains `i' + + =head2 Symbolic calculator + + Put this in F in your Perl library directory: + + package symbolic; # Primitive symbolic calculator + use overload nomethod => \&wrap; + + sub new { shift; bless ['n', @_] } + sub wrap { + my ($obj, $other, $inv, $meth) = @_; + ($obj, $other) = ($other, $obj) if $inv; + bless [$meth, $obj, $other]; + } + + This module is very unusual as overloaded modules go: it does not + provide any usual overloaded operators, instead it provides the L operator C. In this example the corresponding + subroutine returns an object which encupsulates operations done over + the objects: C contains C<['n', 3]>, C<2 + new + symbolic 3> contains C<['+', 2, ['n', 3]]>. + + Here is an example of the script which "calculates" the side of + circumscribed octagon using the above package: + + require symbolic; + my $iter = 1; # 2**($iter+2) = 8 + my $side = new symbolic 1; + my $cnt = $iter; + + while ($cnt--) { + $side = (sqrt(1 + $side**2) - 1)/$side; + } + print "OK\n"; + + The value of $side is + + ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]], + undef], 1], ['n', 1]] + + Note that while we obtained this value using a nice little script, + there is no simple way to I this value. In fact this value may + be inspected in debugger (see L), but ony if + C Bption is set, and not via C

command. + + If one attempts to print this value, then the overloaded operator + C<""> will be called, which will call C operator. The + result of this operator will be stringified again, but this result is + again of type C, which will lead to an infinite loop. + + Add a pretty-printer method to the module F: + + sub pretty { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + $b = 'u' unless defined $b; + $a = $a->pretty if ref $a; + $b = $b->pretty if ref $b; + "[$meth $a $b]"; + } + + Now one can finish the script by + + print "side = ", $side->pretty, "\n"; + + The method C is doing object-to-string conversion, so it + is natural to overload the operator C<""> using this method. However, + inside such a method it is not necessary to pretty-print the + I $a and $b of an object. In the above subroutine + C<"[$meth $a $b]"> is a catenation of some strings and components $a + and $b. If these components use overloading, the catenation operator + will look for an overloaded operator C<.>, if not present, it will + look for an overloaded operator C<"">. Thus it is enough to use + + use overload nomethod => \&wrap, '""' => \&str; + sub str { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + $b = 'u' unless defined $b; + "[$meth $a $b]"; + } + + Now one can change the last line of the script to + + print "side = $side\n"; + + which outputs + + side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]] + + and one can inspect the value in debugger using all the possible + methods. + + Something is is still amiss: consider the loop variable $cnt of the + script. It was a number, not an object. We cannot make this value of + type C, since then the loop will not terminate. + + Indeed, to terminate the cycle, the $cnt should become false. + However, the operator C for checking falsity is overloaded (this + time via overloaded C<"">), and returns a long string, thus any object + of type C is true. To overcome this, we need a way to + compare an object to 0. In fact, it is easier to write a numeric + conversion routine. + + Here is the text of F with such a routine added (and + slightly modifed str()): + + package symbolic; # Primitive symbolic calculator + use overload + nomethod => \&wrap, '""' => \&str, '0+' => \# + + sub new { shift; bless ['n', @_] } + sub wrap { + my ($obj, $other, $inv, $meth) = @_; + ($obj, $other) = ($other, $obj) if $inv; + bless [$meth, $obj, $other]; + } + sub str { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + if (defined $b) { + "[$meth $a $b]"; + } else { + "[$meth $a]"; + } + } + my %subr = ( n => sub {$_[0]}, + sqrt => sub {sqrt $_[0]}, + '-' => sub {shift() - shift()}, + '+' => sub {shift() + shift()}, + '/' => sub {shift() / shift()}, + '*' => sub {shift() * shift()}, + '**' => sub {shift() ** shift()}, + ); + sub num { + my ($meth, $a, $b) = @{+shift}; + my $subr = $subr{$meth} + or die "Do not know how to ($meth) in symbolic"; + $a = $a->num if ref $a eq __PACKAGE__; + $b = $b->num if ref $b eq __PACKAGE__; + $subr->($a,$b); + } + + All the work of numeric conversion is done in %subr and num(). Of + course, %subr is not complete, it contains only operators used in teh + example below. Here is the extra-credit question: why do we need an + explicit recursion in num()? (Answer is at the end of this section.) + + Use this module like this: + + require symbolic; + my $iter = new symbolic 2; # 16-gon + my $side = new symbolic 1; + my $cnt = $iter; + + while ($cnt) { + $cnt = $cnt - 1; # Mutator `--' not implemented + $side = (sqrt(1 + $side**2) - 1)/$side; + } + printf "%s=%f\n", $side, $side; + printf "pi=%f\n", $side*(2**($iter+2)); + + It prints (without so many line breaks) + + [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] + [n 1]] 2]]] 1] + [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912 + pi=3.182598 + + The above module is very primitive. It does not implement + mutator methods (C<++>, C<-=> and so on), does not do deep copying + (not required without mutators!), and implements only those arithmetic + operations which are used in the example. + + To implement most arithmetic operattions is easy, one should just use + the tables of operations, and change the code which fills %subr to + + my %subr = ( 'n' => sub {$_[0]} ); + foreach my $op (split " ", $overload::ops{with_assign}) { + $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}"; + } + my @bins = qw(binary 3way_comparison num_comparison str_comparison); + foreach my $op (split " ", "@overload::ops{ @bins }") { + $subr{$op} = eval "sub {shift() $op shift()}"; + } + foreach my $op (split " ", "@overload::ops{qw(unary func)}") { + print "defining `$op'\n"; + $subr{$op} = eval "sub {$op shift()}"; + } + + Due to L, we do not need anything + special to make C<+=> and friends work, except filling C<+=> entry of + %subr, and defining a copy constructor (needed since Perl has no + way to know that the implementation of C<'+='> does not mutate + the argument, compare L). + + To implement a copy constructor, add C<'=' => \&cpy> to C + line, and code (this code assumes that mutators change things one level + deep only, so recursive copying is not needed): + + sub cpy { + my $self = shift; + bless [@$self], ref $self; + } + + To make C<++> and C<--> work, we need to implement actual mutators, + either directly, or in C. We continue to do things inside + C, thus add + + if ($meth eq '++' or $meth eq '--') { + @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference + return $obj; + } + + after the first line of wrap(). This is not a most effective + implementation, one may consider + + sub inc { $_[0] = bless ['++', shift, 1]; } + + instead. + + As a final remark, note that one can fill %subr by + + my %subr = ( 'n' => sub {$_[0]} ); + foreach my $op (split " ", $overload::ops{with_assign}) { + $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}"; + } + my @bins = qw(binary 3way_comparison num_comparison str_comparison); + foreach my $op (split " ", "@overload::ops{ @bins }") { + $subr{$op} = eval "sub {shift() $op shift()}"; + } + foreach my $op (split " ", "@overload::ops{qw(unary func)}") { + $subr{$op} = eval "sub {$op shift()}"; + } + $subr{'++'} = $subr{'+'}; + $subr{'--'} = $subr{'-'}; + + This finishes implementation of a primitive symbolic calculator in + 50 lines of Perl code. Since the numeric values of subexpressions + are not cached, the calculator is very slow. + + Here is the answer for the exercise: In the case of str(), we need no + explicit recursion since the overloaded C<.>-operator will fall back + to an existing overloaded operator C<"">. Overloaded arithmetic + operators I fall back to numeric conversion if C is + not explicitly requested. Thus without an explicit recursion num() + would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild + the argument of num(). + + If you wonder why defaults for conversion are different for str() and + num(), note how easy it was to write the symbolic calculator. This + simplicity is due to an appropriate choice of defaults. One extra + note: due to teh explicit recursion num() is more fragile than sym(): + we need to explicitly check for the type of $a and $b. If componets + $a and $b happen to be of some related type, this may lead to problems. + + =head2 I symbolic calculator + + One may wonder why we call the above calculator symbolic. The reason + is that the actual calculation of the value of expression is postponed + until the value is I. + + To see it in action, add a method + + sub STORE { + my $obj = shift; + $#$obj = 1; + @$obj->[0,1] = ('=', shift); + } + + to the package C. After this change one can do + + my $a = new symbolic 3; + my $b = new symbolic 4; + my $c = sqrt($a**2 + $b**2); + + and the numeric value of $c becomes 5. However, after calling + + $a->STORE(12); $b->STORE(5); + + the numeric value of $c becomes 13. There is no doubt now that the module + symbolic provides a I calculator indeed. + + To hide the rough edges under the hood, provide a tie()d interface to the + package C (compare with L). Add methods + + sub TIESCALAR { my $pack = shift; $pack->new(@_) } + sub FETCH { shift } + sub nop { } # Around a bug + + (the bug is described in L<"BUGS">). One can use this new interface as + + tie $a, 'symbolic', 3; + tie $b, 'symbolic', 4; + $a->nop; $b->nop; # Around a bug + + my $c = sqrt($a**2 + $b**2); + + Now numeric value of $c is 5. After C<$a = 12; $b = 5> the numeric value + of $c becomes 13. To insulate the user of the module add a method + + sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; } + + Now + + my ($a, $b); + symbolic->vars($a, $b); + my $c = sqrt($a**2 + $b**2); + + $a = 3; $b = 4; + printf "c5 %s=%f\n", $c, $c; + + $a = 12; $b = 5; + printf "c13 %s=%f\n", $c, $c; + + shows that the numeric value of $c follows changes to the values of $a + and $b. + =head1 AUTHOR Ilya Zakharevich EFE. *************** *** 676,682 **** is shown by debugger. The method C<()> corresponds to the C key (in fact a presence of this method shows that this package has overloading enabled, and it is what is used by the C ! function). =head1 BUGS --- 1183,1189 ---- is shown by debugger. The method C<()> corresponds to the C key (in fact a presence of this method shows that this package has overloading enabled, and it is what is used by the C ! function of module C). =head1 BUGS *************** *** 689,697 **** interesting effects if some package is not overloaded, but inherits from two overloaded packages. Barewords are not covered by overloaded string constants. ! This document is confusing. =cut --- 1196,1216 ---- interesting effects if some package is not overloaded, but inherits from two overloaded packages. + Relation between overloading and tie()ing is broken. Overloading is + triggered or not basing on the I class of tie()d value. + + This happens because the presence of overloading is checked too early, + before any tie()d access is attempted. If the FETCH()ed class of the + tie()d value does not change, a simple workaround is to access the value + immediately after tie()ing, so that after this call the I class + coincides with the current one. + + B a way to fix this without a speed penalty. + Barewords are not covered by overloaded string constants. ! This document is confusing. There are grammos and misleading language ! used in places. It would seem a total rewrite is needed. =cut Index: lib/perl5db.pl ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/lib/perl5db.pl Fri Jul 24 00:00:57 1998 --- perl5.005_02/lib/perl5db.pl Sun Aug 2 00:38:35 1998 *************** *** 2,8 **** # Debugger for Perl 5.00x; perl5db.pl patch level: ! $VERSION = 1.03; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) --- 2,8 ---- # Debugger for Perl 5.00x; perl5db.pl patch level: ! $VERSION = 1.0401; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) *************** *** 179,185 **** TTY noTTY ReadLine NonStop LineInfo maxTraceLen recallCommand ShellBang pager tkRunning ornaments signalLevel warnLevel dieLevel inhibit_exit ! ImmediateStop); %optionVars = ( hashDepth => \$dumpvar::hashDepth, --- 179,185 ---- TTY noTTY ReadLine NonStop LineInfo maxTraceLen recallCommand ShellBang pager tkRunning ornaments signalLevel warnLevel dieLevel inhibit_exit ! ImmediateStop bareStringify); %optionVars = ( hashDepth => \$dumpvar::hashDepth, *************** *** 191,196 **** --- 191,197 ---- undefPrint => \$dumpvar::printUndef, globPrint => \$dumpvar::globPrint, UsageOnly => \$dumpvar::usageOnly, + bareStringify => \$dumpvar::bareStringify, frame => \$frame, AutoTrace => \$trace, inhibit_exit => \$inhibit_exit, *************** *** 390,395 **** --- 391,397 ---- if ($trace & 2) { for (my $n = 0; $n <= $#to_watch; $n++) { $evalarg = $to_watch[$n]; + local $onetimeDump; # Do not output results my ($val) = &eval; # Fix context (&eval is doing array)? $val = ( (defined $val) ? "'$val'" : 'undef' ); if ($val ne $old_watch[$n]) { *************** *** 1823,1828 **** --- 1825,1831 ---- I: dump symbol tables of packages; I: dump contents of \"reused\" addresses; I, I, I: change style of string dump; + I: Do not print the overload-stringified value; Option I affects printing of return value after B command, I affects printing messages on entry and exit from subroutines. I affects printing messages on every possible breaking point. Index: malloc.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/malloc.c Fri Jul 24 00:00:59 1998 --- perl5.005_02/malloc.c Sun Aug 2 05:35:23 1998 *************** *** 101,106 **** --- 101,111 ---- # This many continuous sbrk()s compensate for one discontinuous one. SBRK_FAILURE_PRICE 50 + # Some configurations may ask for 12-byte-or-so allocations which + # require 8-byte alignment (?!). In such situation one needs to + # define this to disable 12-byte bucket (will increase memory footprint) + STRICT_ALIGNMENT undef + This implementation assumes that calling PerlIO_printf() does not result in any memory allocation calls (used during a panic). *************** *** 281,286 **** --- 286,292 ---- #endif static void morecore _((int bucket)); static int findbucket _((union overhead *freep, int srchlen)); + static void add_to_chain(void *p, MEM_SIZE size, MEM_SIZE chip); #define MAGIC 0xff /* magic # on accounting info */ #define RMAGIC 0x55555555 /* magic # on range info */ *************** *** 571,616 **** emergency_sbrk(size) MEM_SIZE size; { if (size >= BIG_SIZE) { /* Give the possibility to recover: */ MUTEX_UNLOCK(&PL_malloc_mutex); croak("Out of memory during \"large\" request for %i bytes", size); } ! if (!emergency_buffer) { dTHR; /* First offense, give a possibility to recover by dieing. */ /* No malloc involved here: */ GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0); SV *sv; char *pv; if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0); if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) ! || (SvLEN(sv) < (1<= size) { ! emergency_buffer_size -= size; ! return emergency_buffer + emergency_buffer_size; } ! ! return (char *)-1; /* poor guy... */ } #else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ --- 577,635 ---- emergency_sbrk(size) MEM_SIZE size; { + MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<= BIG_SIZE) { /* Give the possibility to recover: */ MUTEX_UNLOCK(&PL_malloc_mutex); croak("Out of memory during \"large\" request for %i bytes", size); } ! if (emergency_buffer_size >= rsize) { ! char *old = emergency_buffer; ! ! emergency_buffer_size -= rsize; ! emergency_buffer += rsize; ! return old; ! } else { dTHR; /* First offense, give a possibility to recover by dieing. */ /* No malloc involved here: */ GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0); SV *sv; char *pv; + int have = 0; + if (emergency_buffer_size) { + add_to_chain(emergency_buffer, emergency_buffer_size, 0); + emergency_buffer_size = 0; + emergency_buffer = Nullch; + have = 1; + } if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0); if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) ! || (SvLEN(sv) < (1< (1 << LOG_OF_MIN_ARENA))) { MEM_SIZE require, newarena = nbytes, pow; *************** *** 1380,1385 **** --- 1409,1418 ---- } else { hard_way: MUTEX_UNLOCK(&PL_malloc_mutex); + DEBUG_m(PerlIO_printf(Perl_debug_log, + "0x%lx: (%05lu) realloc %ld bytes the hard way\n", + (unsigned long)cp,(unsigned long)(PL_an++), + (long)size)); if ((res = (char*)malloc(nbytes)) == NULL) return (NULL); if (cp != res) /* common optimization */ *************** *** 1387,1399 **** if (was_alloced) free(cp); } - - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lu: (%05lu) rfree\n", - (unsigned long)res,(unsigned long)(PL_an++))); - DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) realloc %ld bytes\n", - (unsigned long)res,(unsigned long)(PL_an++), - (long)size)); return ((Malloc_t)res); } --- 1420,1425 ---- Index: mg.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/mg.c Fri Jul 24 00:01:00 1998 --- perl5.005_02/mg.c Sun Aug 2 02:08:10 1998 *************** *** 422,428 **** case '\010': /* ^H */ sv_setiv(sv, (IV)PL_hints); break; ! case '\t': /* ^I */ if (PL_inplace) sv_setpv(sv, PL_inplace); else --- 422,428 ---- case '\010': /* ^H */ sv_setiv(sv, (IV)PL_hints); break; ! case '\011': /* ^I */ /* NOT \t in EBCDIC */ if (PL_inplace) sv_setpv(sv, PL_inplace); else *************** *** 520,526 **** break; case '?': { - dTHR; sv_setiv(sv, (IV)STATUS_CURRENT); #ifdef COMPLEX_STATUS LvTARGOFF(sv) = PL_statusvalue; --- 520,525 ---- *************** *** 1398,1409 **** if (mg->mg_obj) { SV *ahv = LvTARG(sv); if (SvTYPE(ahv) == SVt_PVHV) { ! HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0); if (he) value = HeVAL(he); } else { ! SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, FALSE, 0); if (svp) value = *svp; } --- 1397,1408 ---- if (mg->mg_obj) { SV *ahv = LvTARG(sv); if (SvTYPE(ahv) == SVt_PVHV) { ! HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0); if (he) value = HeVAL(he); } else { ! SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, TRUE, 0); if (svp) value = *svp; } *************** *** 1521,1527 **** case '\010': /* ^H */ PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; ! case '\t': /* ^I */ if (PL_inplace) Safefree(PL_inplace); if (SvOK(sv)) --- 1520,1526 ---- case '\010': /* ^H */ PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; ! case '\011': /* ^I */ /* NOT \t in EBCDIC */ if (PL_inplace) Safefree(PL_inplace); if (SvOK(sv)) *************** *** 1846,1852 **** magic_mutexfree(SV *sv, MAGIC *mg) { dTHR; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) if (MgOWNER(mg)) croak("panic: magic_mutexfree"); --- 1845,1851 ---- magic_mutexfree(SV *sv, MAGIC *mg) { dTHR; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) if (MgOWNER(mg)) croak("panic: magic_mutexfree"); Index: op.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/op.c Fri Jul 24 00:01:04 1998 --- perl5.005_02/op.c Mon Aug 3 12:36:04 1998 *************** *** 92,98 **** assertref(OP *o) { int type = o->op_type; ! if (type != OP_AELEM && type != OP_HELEM) { yyerror(form("Can't use subscript on %s", op_desc[type])); if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) { dTHR; --- 92,98 ---- assertref(OP *o) { int type = o->op_type; ! if (type != OP_AELEM && type != OP_HELEM && type != OP_GELEM) { yyerror(form("Can't use subscript on %s", op_desc[type])); if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) { dTHR; *************** *** 548,554 **** default: sv_magic(sv, 0, 0, name, 1); } ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "find_threadsv: new SV %p for $%s%c\n", sv, (*name < 32) ? "^" : "", (*name < 32) ? toCTRL(*name) : *name)); --- 548,554 ---- default: sv_magic(sv, 0, 0, name, 1); } ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "find_threadsv: new SV %p for $%s%c\n", sv, (*name < 32) ? "^" : "", (*name < 32) ? toCTRL(*name) : *name)); *************** *** 582,587 **** --- 582,591 ---- o->op_targ = 0; /* Was holding hints. */ break; #ifdef USE_THREADS + case OP_ENTERITER: + if (!(o->op_flags & OPf_SPECIAL)) + break; + /* FALL THROUGH */ case OP_THREADSV: o->op_targ = 0; /* Was holding index into thr->threadsv AV. */ break; Index: opcode.pl ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/opcode.pl Fri Jul 24 00:01:06 1998 --- perl5.005_02/opcode.pl Fri Aug 7 20:03:54 1998 *************** *** 189,195 **** $argsum |= 64 if $flags =~ /d/; # danger, unknown side effects $argsum |= 128 if $flags =~ /u/; # defaults to $_ ! $flags =~ /([^a-zA-Z])/ or die qq[Opcode "$_" has no class indicator]; $argsum |= $opclass{$1} << 8; $mul = 4096; # 2 ^ OASHIFT for $arg (split(' ',$args{$_})) { --- 189,195 ---- $argsum |= 64 if $flags =~ /d/; # danger, unknown side effects $argsum |= 128 if $flags =~ /u/; # defaults to $_ ! $flags =~ /([\W\d_])/ or die qq[Opcode "$_" has no class indicator]; $argsum |= $opclass{$1} << 8; $mul = 4096; # 2 ^ OASHIFT for $arg (split(' ',$args{$_})) { Index: os2/os2ish.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/os2/os2ish.h Fri Jul 24 00:01:10 1998 --- perl5.005_02/os2/os2ish.h Sun Aug 2 02:28:28 1998 *************** *** 169,179 **** /* XXX This code hideously puts env inside: */ ! #define PERL_SYS_INIT(argcp, argvp) STMT_START { \ _response(argcp, argvp); \ _wildcard(argcp, argvp); \ Perl_OS2_init(env); } STMT_END ! #define PERL_SYS_TERM() MALLOC_TERM /* #define PERL_SYS_TERM() STMT_START { \ --- 169,184 ---- /* XXX This code hideously puts env inside: */ ! #ifdef __EMX__ ! # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ _response(argcp, argvp); \ _wildcard(argcp, argvp); \ Perl_OS2_init(env); } STMT_END ! #else /* Compiling embedded Perl with non-EMX compiler */ ! # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ ! Perl_OS2_init(env); } STMT_END ! # define PERL_CALLCONV _System ! #endif #define PERL_SYS_TERM() MALLOC_TERM /* #define PERL_SYS_TERM() STMT_START { \ Index: perl.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perl.c Fri Jul 24 00:01:12 1998 --- perl5.005_02/perl.c Fri Aug 7 18:28:48 1998 *************** *** 31,38 **** #include #endif - dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; - #ifdef IAMSUID #ifndef DOSUID #define DOSUID --- 31,36 ---- *************** *** 256,262 **** /* Pass 1 on any remaining threads: detach joinables, join zombies */ retry_cleanup: MUTEX_LOCK(&PL_threads_mutex); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: waiting for %d threads...\n", PL_nthreads - 1)); for (t = thr->next; t != thr; t = t->next) { --- 254,260 ---- /* Pass 1 on any remaining threads: detach joinables, join zombies */ retry_cleanup: MUTEX_LOCK(&PL_threads_mutex); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: waiting for %d threads...\n", PL_nthreads - 1)); for (t = thr->next; t != thr; t = t->next) { *************** *** 264,270 **** switch (ThrSTATE(t)) { AV *av; case THRf_ZOMBIE: ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joining zombie %p\n", t)); ThrSETSTATE(t, THRf_DEAD); MUTEX_UNLOCK(&t->mutex); --- 262,268 ---- switch (ThrSTATE(t)) { AV *av; case THRf_ZOMBIE: ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joining zombie %p\n", t)); ThrSETSTATE(t, THRf_DEAD); MUTEX_UNLOCK(&t->mutex); *************** *** 278,288 **** MUTEX_UNLOCK(&PL_threads_mutex); JOIN(t, &av); SvREFCNT_dec((SV*)av); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joined zombie %p OK\n", t)); goto retry_cleanup; case THRf_R_JOINABLE: ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: detaching thread %p\n", t)); ThrSETSTATE(t, THRf_R_DETACHED); /* --- 276,286 ---- MUTEX_UNLOCK(&PL_threads_mutex); JOIN(t, &av); SvREFCNT_dec((SV*)av); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: joined zombie %p OK\n", t)); goto retry_cleanup; case THRf_R_JOINABLE: ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: detaching thread %p\n", t)); ThrSETSTATE(t, THRf_R_DETACHED); /* *************** *** 296,302 **** MUTEX_UNLOCK(&t->mutex); goto retry_cleanup; default: ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: ignoring %p (state %u)\n", t, ThrSTATE(t))); MUTEX_UNLOCK(&t->mutex); --- 294,300 ---- MUTEX_UNLOCK(&t->mutex); goto retry_cleanup; default: ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: ignoring %p (state %u)\n", t, ThrSTATE(t))); MUTEX_UNLOCK(&t->mutex); *************** *** 308,321 **** /* Pass 2 on remaining threads: wait for the thread count to drop to one */ while (PL_nthreads > 1) { ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: final wait for %d threads\n", PL_nthreads - 1)); COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex); } /* At this point, we're the last thread */ MUTEX_UNLOCK(&PL_threads_mutex); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n")); MUTEX_DESTROY(&PL_threads_mutex); COND_DESTROY(&PL_nthreads_cond); #endif /* !defined(FAKE_THREADS) */ --- 306,319 ---- /* Pass 2 on remaining threads: wait for the thread count to drop to one */ while (PL_nthreads > 1) { ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: final wait for %d threads\n", PL_nthreads - 1)); COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex); } /* At this point, we're the last thread */ MUTEX_UNLOCK(&PL_threads_mutex); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n")); MUTEX_DESTROY(&PL_threads_mutex); COND_DESTROY(&PL_nthreads_cond); #endif /* !defined(FAKE_THREADS) */ *************** *** 1064,1073 **** if (!PL_restartop) { DEBUG_x(dump_all()); DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); ! #ifdef USE_THREADS ! DEBUG_L(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n", (unsigned long) thr)); - #endif /* USE_THREADS */ if (PL_minus_c) { PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename); --- 1062,1069 ---- if (!PL_restartop) { DEBUG_x(dump_all()); DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); ! DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n", (unsigned long) thr)); if (PL_minus_c) { PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename); *************** *** 1571,1577 **** #ifdef DEBUGGING forbid_setid("-D"); if (isALPHA(s[1])) { ! static char debopts[] = "psltocPmfrxuLHXD"; char *d; for (s++; *s && (d = strchr(debopts,*s)); s++) --- 1567,1573 ---- #ifdef DEBUGGING forbid_setid("-D"); if (isALPHA(s[1])) { ! static char debopts[] = "psltocPmfrxuLHXDS"; char *d; for (s++; *s && (d = strchr(debopts,*s)); s++) *************** *** 1738,1743 **** --- 1734,1742 ---- #ifdef MPE printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1998\n"); #endif + #ifdef OEMVS + printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n"); + #endif #ifdef BINARY_BUILD_NOTICE BINARY_BUILD_NOTICE; #endif *************** *** 2886,2895 **** { dTHR; ! #ifdef USE_THREADS ! DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); - #endif /* USE_THREADS */ switch (status) { case 0: STATUS_ALL_SUCCESS; --- 2885,2892 ---- { dTHR; ! DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); switch (status) { case 0: STATUS_ALL_SUCCESS; *************** *** 2974,2981 **** p = SvPVX(PL_e_script); nl = strchr(p, '\n'); nl = (nl) ? nl+1 : SvEND(PL_e_script); ! if (nl-p == 0) return 0; sv_catpvn(buf_sv, p, nl-p); sv_chop(PL_e_script, nl); return 1; --- 2971,2980 ---- p = SvPVX(PL_e_script); nl = strchr(p, '\n'); nl = (nl) ? nl+1 : SvEND(PL_e_script); ! if (nl-p == 0) { ! filter_del(read_e_script); return 0; + } sv_catpvn(buf_sv, p, nl-p); sv_chop(PL_e_script, nl); return 1; Index: perl.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perl.h Fri Jul 24 00:01:14 1998 --- perl5.005_02/perl.h Sun Aug 2 02:12:18 1998 *************** *** 1423,1428 **** --- 1423,1429 ---- #ifndef Perl_debug_log #define Perl_debug_log PerlIO_stderr() #endif + #undef YYDEBUG #define YYDEBUG 1 #define DEB(a) a #define DEBUG(a) if (PL_debug) a *************** *** 1442,1447 **** --- 1443,1453 ---- #define DEBUG_H(a) if (PL_debug & 8192) a #define DEBUG_X(a) if (PL_debug & 16384) a #define DEBUG_D(a) if (PL_debug & 32768) a + # ifdef USE_THREADS + # define DEBUG_S(a) if (PL_debug & (1<<16)) a + # else + # define DEBUG_S(a) + # endif #else #define DEB(a) #define DEBUG(a) *************** *** 1457,1466 **** #define DEBUG_r(a) #define DEBUG_x(a) #define DEBUG_u(a) ! #define DEBUG_L(a) #define DEBUG_H(a) #define DEBUG_X(a) #define DEBUG_D(a) #endif #define YYMAXDEPTH 300 --- 1463,1473 ---- #define DEBUG_r(a) #define DEBUG_x(a) #define DEBUG_u(a) ! #define DEBUG_S(a) #define DEBUG_H(a) #define DEBUG_X(a) #define DEBUG_D(a) + #define DEBUG_S(a) #endif #define YYMAXDEPTH 300 *************** *** 1489,1496 **** --- 1496,1508 ---- /* All of these are in stdlib.h or time.h for ANSI C */ Time_t time(); struct tm *gmtime(), *localtime(); + #ifdef OEMVS + char *(strchr)(), *(strrchr)(); + char *(strcpy)(), *(strcat)(); + #else char *strchr(), *strrchr(); char *strcpy(), *strcat(); + #endif #endif /* ! STANDARD_C */ *************** *** 1668,1673 **** --- 1680,1721 ---- /* fast case folding tables */ #ifdef DOINIT + #ifdef EBCDIC + EXT unsigned char fold[] = { /* fast EBCDIC case folding table */ + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 123, 124, 125, 126, 127, + 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 138, 139, 140, 141, 142, 143, + 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P', + 'Q', 'R', 154, 155, 156, 157, 158, 159, + 160, 161, 'S', 'T', 'U', 'V', 'W', 'X', + 'Y', 'Z', 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 202, 203, 204, 205, 206, 207, + 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p', + 'q', 'r', 218, 219, 220, 221, 222, 223, + 224, 225, 's', 't', 'u', 'v', 'w', 'x', + 'y', 'z', 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 + }; + #else /* ascii rather than ebcdic */ EXTCONST unsigned char fold[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, *************** *** 1702,1707 **** --- 1750,1756 ---- 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 }; + #endif /* !EBCDIC */ #else EXTCONST unsigned char fold[]; #endif *************** *** 1746,1751 **** --- 1795,1836 ---- #endif #ifdef DOINIT + #ifdef EBCDIC + EXT unsigned char freq[] = {/* EBCDIC frequencies for mixed English/C */ + 1, 2, 84, 151, 154, 155, 156, 157, + 165, 246, 250, 3, 158, 7, 18, 29, + 40, 51, 62, 73, 85, 96, 107, 118, + 129, 140, 147, 148, 149, 150, 152, 153, + 255, 6, 8, 9, 10, 11, 12, 13, + 14, 15, 24, 25, 26, 27, 28, 226, + 29, 30, 31, 32, 33, 43, 44, 45, + 46, 47, 48, 49, 50, 76, 77, 78, + 79, 80, 81, 82, 83, 84, 85, 86, + 87, 94, 95, 234, 181, 233, 187, 190, + 180, 96, 97, 98, 99, 100, 101, 102, + 104, 112, 182, 174, 236, 232, 229, 103, + 228, 226, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 235, 176, 230, 194, 162, + 130, 131, 132, 133, 134, 135, 136, 137, + 138, 139, 201, 205, 163, 217, 220, 224, + 5, 248, 227, 244, 242, 255, 241, 231, + 240, 253, 16, 197, 19, 20, 21, 187, + 23, 169, 210, 245, 237, 249, 247, 239, + 168, 252, 34, 196, 36, 37, 38, 39, + 41, 42, 251, 254, 238, 223, 221, 213, + 225, 177, 52, 53, 54, 55, 56, 57, + 58, 59, 60, 61, 63, 64, 65, 66, + 67, 68, 69, 70, 71, 72, 74, 75, + 205, 208, 186, 202, 200, 218, 198, 179, + 178, 214, 88, 89, 90, 91, 92, 93, + 217, 166, 170, 207, 199, 209, 206, 204, + 160, 212, 105, 106, 108, 109, 110, 111, + 203, 113, 216, 215, 192, 175, 193, 243, + 172, 161, 123, 124, 125, 126, 127, 128, + 222, 219, 211, 195, 188, 193, 185, 184, + 191, 183, 141, 142, 143, 144, 145, 146 + }; + #else /* ascii rather than ebcdic */ EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */ 1, 2, 84, 151, 154, 155, 156, 157, 165, 246, 250, 3, 158, 7, 18, 29, *************** *** 1780,1785 **** --- 1865,1871 ---- 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 141, 142, 143, 144, 145, 146 }; + #endif #else EXTCONST unsigned char freq[]; #endif *************** *** 1989,1994 **** --- 2075,2086 ---- #endif #ifdef PERL_OBJECT + /* + * The following is a buffer where new variables must + * be defined to maintain binary compatibility with PERL_OBJECT + * for 5.005 + */ + PERLVAR(object_compatibility[30], char) }; #include "objpp.h" Index: perly.c Prereq: 1.8 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perly.c Fri Jul 24 00:01:17 1998 --- perl5.005_02/perly.c Sun Aug 2 01:15:07 1998 *************** *** 21,27 **** } #endif ! #line 16 "perly.c" #define YYERRCODE 256 short yylhs[] = { -1, 45, 0, 9, 7, 10, 8, 11, 11, 11, 12, --- 21,27 ---- } #endif ! #line 30 "perly.y" #define YYERRCODE 256 short yylhs[] = { -1, 45, 0, 9, 7, 10, 8, 11, 11, 11, 12, *************** *** 1280,1290 **** int yynerrs; int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; ! #line 635 "perly.y" /* PROGRAM */ ! #line 1349 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab --- 1280,1292 ---- int yynerrs; int yyerrflag; int yychar; + short *yyssp; + YYSTYPE *yyvsp; YYSTYPE yyval; YYSTYPE yylval; ! #line 643 "perly.y" /* PROGRAM */ ! #line 1353 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab *************** *** 1513,1519 **** switch (yyn) { case 1: ! #line 86 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (PL_debug & 1); --- 1515,1521 ---- switch (yyn) { case 1: ! #line 94 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (PL_debug & 1); *************** *** 1522,1571 **** } break; case 2: ! #line 93 "perly.y" { newPROG(yyvsp[0].opval); } break; case 3: ! #line 97 "perly.y" { if (PL_copline > (line_t)yyvsp[-3].ival) PL_copline = yyvsp[-3].ival; yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 4: ! #line 103 "perly.y" { yyval.ival = block_start(TRUE); } break; case 5: ! #line 107 "perly.y" { if (PL_copline > (line_t)yyvsp[-3].ival) PL_copline = yyvsp[-3].ival; yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 6: ! #line 113 "perly.y" { yyval.ival = block_start(FALSE); } break; case 7: ! #line 117 "perly.y" { yyval.opval = Nullop; } break; case 8: ! #line 119 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 9: ! #line 121 "perly.y" { yyval.opval = append_list(OP_LINESEQ, (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); PL_pad_reset_pending = TRUE; if (yyvsp[-1].opval && yyvsp[0].opval) PL_hints |= HINT_BLOCK_SCOPE; } break; case 10: ! #line 128 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 12: ! #line 131 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } --- 1524,1573 ---- } break; case 2: ! #line 101 "perly.y" { newPROG(yyvsp[0].opval); } break; case 3: ! #line 105 "perly.y" { if (PL_copline > (line_t)yyvsp[-3].ival) PL_copline = yyvsp[-3].ival; yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 4: ! #line 111 "perly.y" { yyval.ival = block_start(TRUE); } break; case 5: ! #line 115 "perly.y" { if (PL_copline > (line_t)yyvsp[-3].ival) PL_copline = yyvsp[-3].ival; yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 6: ! #line 121 "perly.y" { yyval.ival = block_start(FALSE); } break; case 7: ! #line 125 "perly.y" { yyval.opval = Nullop; } break; case 8: ! #line 127 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 9: ! #line 129 "perly.y" { yyval.opval = append_list(OP_LINESEQ, (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); PL_pad_reset_pending = TRUE; if (yyvsp[-1].opval && yyvsp[0].opval) PL_hints |= HINT_BLOCK_SCOPE; } break; case 10: ! #line 136 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 12: ! #line 139 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } *************** *** 1576,1651 **** PL_expect = XSTATE; } break; case 13: ! #line 140 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); PL_expect = XSTATE; } break; case 14: ! #line 145 "perly.y" { yyval.opval = Nullop; } break; case 15: ! #line 147 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 16: ! #line 149 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 17: ! #line 151 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 18: ! #line 153 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 19: ! #line 155 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);} break; case 20: ! #line 157 "perly.y" { yyval.opval = newFOROP(0, Nullch, yyvsp[-1].ival, Nullop, yyvsp[0].opval, yyvsp[-2].opval, Nullop); } break; case 21: ! #line 162 "perly.y" { yyval.opval = Nullop; } break; case 22: ! #line 164 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 23: ! #line 166 "perly.y" { PL_copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, Nullch, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); PL_hints |= HINT_BLOCK_SCOPE; } break; case 24: ! #line 173 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 25: ! #line 177 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 26: ! #line 183 "perly.y" { yyval.opval = Nullop; } break; case 27: ! #line 185 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 28: ! #line 189 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, --- 1578,1653 ---- PL_expect = XSTATE; } break; case 13: ! #line 148 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); PL_expect = XSTATE; } break; case 14: ! #line 153 "perly.y" { yyval.opval = Nullop; } break; case 15: ! #line 155 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 16: ! #line 157 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 17: ! #line 159 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 18: ! #line 161 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 19: ! #line 163 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);} break; case 20: ! #line 165 "perly.y" { yyval.opval = newFOROP(0, Nullch, yyvsp[-1].ival, Nullop, yyvsp[0].opval, yyvsp[-2].opval, Nullop); } break; case 21: ! #line 170 "perly.y" { yyval.opval = Nullop; } break; case 22: ! #line 172 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 23: ! #line 174 "perly.y" { PL_copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, Nullch, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); PL_hints |= HINT_BLOCK_SCOPE; } break; case 24: ! #line 181 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 25: ! #line 185 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 26: ! #line 191 "perly.y" { yyval.opval = Nullop; } break; case 27: ! #line 193 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 28: ! #line 197 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, *************** *** 1653,1659 **** yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 29: ! #line 195 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, --- 1655,1661 ---- yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 29: ! #line 203 "perly.y" { PL_copline = yyvsp[-6].ival; yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, *************** *** 1661,1683 **** yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 30: ! #line 201 "perly.y" { yyval.opval = block_end(yyvsp[-6].ival, newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 31: ! #line 204 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP), yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 32: ! #line 208 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 33: ! #line 212 "perly.y" { OP *forop = append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), newWHILEOP(0, 1, (LOOP*)Nullop, --- 1663,1685 ---- yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 30: ! #line 209 "perly.y" { yyval.opval = block_end(yyvsp[-6].ival, newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 31: ! #line 212 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP), yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 32: ! #line 216 "perly.y" { yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 33: ! #line 220 "perly.y" { OP *forop = append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), newWHILEOP(0, 1, (LOOP*)Nullop, *************** *** 1687,1775 **** yyval.opval = block_end(yyvsp[-7].ival, newSTATEOP(0, yyvsp[-10].pval, forop)); } break; case 34: ! #line 220 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, NOLINE, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: ! #line 226 "perly.y" { yyval.opval = Nullop; } break; case 37: ! #line 231 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 39: ! #line 236 "perly.y" { yyval.opval = invert(scalar(yyvsp[0].opval)); } break; case 40: ! #line 240 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 41: ! #line 244 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 42: ! #line 248 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 43: ! #line 252 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 44: ! #line 256 "perly.y" { yyval.pval = Nullch; } break; case 46: ! #line 261 "perly.y" { yyval.ival = 0; } break; case 47: ! #line 263 "perly.y" { yyval.ival = 0; } break; case 48: ! #line 265 "perly.y" { yyval.ival = 0; } break; case 49: ! #line 267 "perly.y" { yyval.ival = 0; } break; case 50: ! #line 271 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 51: ! #line 274 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 52: ! #line 275 "perly.y" { yyval.opval = Nullop; } break; case 53: ! #line 279 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 54: ! #line 283 "perly.y" { yyval.ival = start_subparse(FALSE, 0); } break; case 55: ! #line 287 "perly.y" { yyval.ival = start_subparse(FALSE, CVf_ANON); } break; case 56: ! #line 291 "perly.y" { yyval.ival = start_subparse(TRUE, 0); } break; case 57: ! #line 294 "perly.y" { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) --- 1689,1777 ---- yyval.opval = block_end(yyvsp[-7].ival, newSTATEOP(0, yyvsp[-10].pval, forop)); } break; case 34: ! #line 228 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, NOLINE, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: ! #line 234 "perly.y" { yyval.opval = Nullop; } break; case 37: ! #line 239 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 39: ! #line 244 "perly.y" { yyval.opval = invert(scalar(yyvsp[0].opval)); } break; case 40: ! #line 248 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 41: ! #line 252 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 42: ! #line 256 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 43: ! #line 260 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 44: ! #line 264 "perly.y" { yyval.pval = Nullch; } break; case 46: ! #line 269 "perly.y" { yyval.ival = 0; } break; case 47: ! #line 271 "perly.y" { yyval.ival = 0; } break; case 48: ! #line 273 "perly.y" { yyval.ival = 0; } break; case 49: ! #line 275 "perly.y" { yyval.ival = 0; } break; case 50: ! #line 279 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 51: ! #line 282 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 52: ! #line 283 "perly.y" { yyval.opval = Nullop; } break; case 53: ! #line 287 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 54: ! #line 291 "perly.y" { yyval.ival = start_subparse(FALSE, 0); } break; case 55: ! #line 295 "perly.y" { yyval.ival = start_subparse(FALSE, CVf_ANON); } break; case 56: ! #line 299 "perly.y" { yyval.ival = start_subparse(TRUE, 0); } break; case 57: ! #line 302 "perly.y" { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) *************** *** 1777,2073 **** yyval.opval = yyvsp[0].opval; } break; case 58: ! #line 302 "perly.y" { yyval.opval = Nullop; } break; case 60: ! #line 306 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 61: ! #line 307 "perly.y" { yyval.opval = Nullop; PL_expect = XSTATE; } break; case 62: ! #line 311 "perly.y" { package(yyvsp[-1].opval); } break; case 63: ! #line 313 "perly.y" { package(Nullop); } break; case 64: ! #line 317 "perly.y" { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ } break; case 65: ! #line 319 "perly.y" { utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 66: ! #line 323 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 67: ! #line 325 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 69: ! #line 330 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 70: ! #line 332 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 72: ! #line 337 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } break; case 73: ! #line 340 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } break; case 74: ! #line 343 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; case 75: ! #line 348 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } break; case 76: ! #line 353 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } break; case 77: ! #line 358 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 78: ! #line 360 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 79: ! #line 362 "perly.y" { yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 80: ! #line 364 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); } break; case 83: ! #line 374 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 84: ! #line 376 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 85: ! #line 378 "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 86: ! #line 382 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 87: ! #line 384 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 88: ! #line 386 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 89: ! #line 388 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 90: ! #line 390 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 91: ! #line 392 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 92: ! #line 394 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 93: ! #line 396 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 94: ! #line 398 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 95: ! #line 400 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 96: ! #line 402 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 97: ! #line 405 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 98: ! #line 407 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 99: ! #line 409 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 100: ! #line 411 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 101: ! #line 413 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 102: ! #line 415 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 103: ! #line 418 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 104: ! #line 421 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 105: ! #line 424 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 106: ! #line 427 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 107: ! #line 429 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 108: ! #line 431 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 109: ! #line 433 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 110: ! #line 435 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 111: ! #line 437 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 112: ! #line 439 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 113: ! #line 441 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 114: ! #line 443 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 115: ! #line 445 "perly.y" { yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); } break; case 116: ! #line 447 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: ! #line 449 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 118: ! #line 451 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 119: ! #line 455 "perly.y" { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 120: ! #line 459 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 121: ! #line 461 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 122: ! #line 463 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 123: ! #line 465 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 124: ! #line 468 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 125: ! #line 473 "perly.y" { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 126: ! #line 478 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 127: ! #line 480 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 128: ! #line 482 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, --- 1779,2075 ---- yyval.opval = yyvsp[0].opval; } break; case 58: ! #line 310 "perly.y" { yyval.opval = Nullop; } break; case 60: ! #line 314 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 61: ! #line 315 "perly.y" { yyval.opval = Nullop; PL_expect = XSTATE; } break; case 62: ! #line 319 "perly.y" { package(yyvsp[-1].opval); } break; case 63: ! #line 321 "perly.y" { package(Nullop); } break; case 64: ! #line 325 "perly.y" { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ } break; case 65: ! #line 327 "perly.y" { utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 66: ! #line 331 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 67: ! #line 333 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 69: ! #line 338 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 70: ! #line 340 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 72: ! #line 345 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } break; case 73: ! #line 348 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } break; case 74: ! #line 351 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; case 75: ! #line 356 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } break; case 76: ! #line 361 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } break; case 77: ! #line 366 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 78: ! #line 368 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 79: ! #line 370 "perly.y" { yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 80: ! #line 372 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); } break; case 83: ! #line 382 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 84: ! #line 384 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 85: ! #line 386 "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 86: ! #line 390 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 87: ! #line 392 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 88: ! #line 394 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 89: ! #line 396 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 90: ! #line 398 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 91: ! #line 400 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 92: ! #line 402 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 93: ! #line 404 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 94: ! #line 406 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 95: ! #line 408 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 96: ! #line 410 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 97: ! #line 413 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 98: ! #line 415 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 99: ! #line 417 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 100: ! #line 419 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 101: ! #line 421 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 102: ! #line 423 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 103: ! #line 426 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 104: ! #line 429 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 105: ! #line 432 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 106: ! #line 435 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 107: ! #line 437 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 108: ! #line 439 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 109: ! #line 441 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 110: ! #line 443 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 111: ! #line 445 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 112: ! #line 447 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 113: ! #line 449 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 114: ! #line 451 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 115: ! #line 453 "perly.y" { yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); } break; case 116: ! #line 455 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: ! #line 457 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 118: ! #line 459 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 119: ! #line 463 "perly.y" { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 120: ! #line 467 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 121: ! #line 469 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 122: ! #line 471 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 123: ! #line 473 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 124: ! #line 476 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 125: ! #line 481 "perly.y" { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); PL_expect = XOPERATOR; } break; case 126: ! #line 486 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 127: ! #line 488 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 128: ! #line 490 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, *************** *** 2075,2081 **** ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 129: ! #line 488 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, --- 2077,2083 ---- ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 129: ! #line 496 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, *************** *** 2084,2120 **** PL_expect = XOPERATOR; } break; case 130: ! #line 495 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 131: ! #line 497 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 132: ! #line 499 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 133: ! #line 501 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 134: ! #line 504 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 135: ! #line 507 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 136: ! #line 509 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 137: ! #line 511 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, --- 2086,2122 ---- PL_expect = XOPERATOR; } break; case 130: ! #line 503 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 131: ! #line 505 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 132: ! #line 507 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 133: ! #line 509 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 134: ! #line 512 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 135: ! #line 515 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 136: ! #line 517 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 137: ! #line 519 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, *************** *** 2124,2130 **** )),Nullop)); dep();} break; case 138: ! #line 519 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, --- 2126,2132 ---- )),Nullop)); dep();} break; case 138: ! #line 527 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, *************** *** 2135,2295 **** )))); dep();} break; case 139: ! #line 528 "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 140: ! #line 532 "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 141: ! #line 537 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-3].opval))); } break; case 142: ! #line 540 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-4].opval)))); } break; case 143: ! #line 544 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 144: ! #line 547 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 145: ! #line 549 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 146: ! #line 551 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 147: ! #line 553 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 148: ! #line 555 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 149: ! #line 557 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 150: ! #line 560 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 151: ! #line 562 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 152: ! #line 564 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[0].opval)); } break; case 153: ! #line 567 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 154: ! #line 569 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 155: ! #line 571 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 156: ! #line 573 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 159: ! #line 579 "perly.y" { yyval.opval = Nullop; } break; case 160: ! #line 581 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 161: ! #line 585 "perly.y" { yyval.opval = Nullop; } break; case 162: ! #line 587 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 163: ! #line 589 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 164: ! #line 592 "perly.y" { yyval.ival = 0; } break; case 165: ! #line 593 "perly.y" { yyval.ival = 1; } break; case 166: ! #line 597 "perly.y" { PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 167: ! #line 601 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 168: ! #line 605 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 169: ! #line 609 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 170: ! #line 613 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 171: ! #line 617 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 172: ! #line 621 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 173: ! #line 625 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 174: ! #line 627 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 175: ! #line 629 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 176: ! #line 632 "perly.y" { yyval.opval = yyvsp[0].opval; } break; ! #line 2266 "perly.c" } yyssp -= yym; yystate = *yyssp; --- 2137,2297 ---- )))); dep();} break; case 139: ! #line 536 "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 140: ! #line 540 "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 141: ! #line 545 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar(yyvsp[-3].opval))); } break; case 142: ! #line 548 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, newCVREF(0, scalar(yyvsp[-4].opval)))); } break; case 143: ! #line 552 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 144: ! #line 555 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 145: ! #line 557 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 146: ! #line 559 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 147: ! #line 561 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 148: ! #line 563 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 149: ! #line 565 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 150: ! #line 568 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 151: ! #line 570 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 152: ! #line 572 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[0].opval)); } break; case 153: ! #line 575 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 154: ! #line 577 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 155: ! #line 579 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 156: ! #line 581 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 159: ! #line 587 "perly.y" { yyval.opval = Nullop; } break; case 160: ! #line 589 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 161: ! #line 593 "perly.y" { yyval.opval = Nullop; } break; case 162: ! #line 595 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 163: ! #line 597 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 164: ! #line 600 "perly.y" { yyval.ival = 0; } break; case 165: ! #line 601 "perly.y" { yyval.ival = 1; } break; case 166: ! #line 605 "perly.y" { PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 167: ! #line 609 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 168: ! #line 613 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 169: ! #line 617 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 170: ! #line 621 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 171: ! #line 625 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 172: ! #line 629 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 173: ! #line 633 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 174: ! #line 635 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 175: ! #line 637 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 176: ! #line 640 "perly.y" { yyval.opval = yyvsp[0].opval; } break; ! #line 2270 "perly.c" } yyssp -= yym; yystate = *yyssp; Index: perly.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perly.h Fri Jul 24 00:01:17 1998 --- perl5.005_02/perly.h Sun Aug 2 01:15:07 1998 *************** *** 63,66 **** GV *gvval; } YYSTYPE; extern YYSTYPE yylval; - extern YYSTYPE yylval; --- 63,65 ---- Index: perly.y ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perly.y Fri Jul 24 00:01:17 1998 --- perl5.005_02/perly.y Sun Aug 2 01:15:07 1998 *************** *** 26,37 **** --- 26,45 ---- %start prog + %{ + #ifndef OEMVS + %} + %union { I32 ival; char *pval; OP *opval; GV *gvval; } + + %{ + #endif /* OEMVS */ + %} %token '{' ')' Index: perly_c.diff ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/perly_c.diff Fri Jul 24 00:01:17 1998 --- perl5.005_02/perly_c.diff Sun Aug 2 01:15:07 1998 *************** *** 1,92 **** ! Index: perly.c ! *** perly.c.old Wed Jun 10 03:48:43 1998 ! --- perly.c Wed Jun 10 03:55:10 1998 *************** ! *** 7,10 **** ! --- 7,18 ---- #include "perl.h" + #ifdef PERL_OBJECT ! + static void + Dep(CPerlObj *pPerl) + { + pPerl->deprecate("\"do\" to call subroutines"); + } + #define dep() Dep(this) + #else ! static void dep(void) *************** ! *** 12,82 **** deprecate("\"do\" to call subroutines"); } ! ! #line 29 "perly.y" ! ! typedef union { ! ! I32 ival; ! ! char *pval; ! ! OP *opval; ! ! GV *gvval; ! ! } YYSTYPE; ! ! #line 23 "y.tab.c" ! ! #define WORD 257 ! ! #define METHOD 258 ! ! #define FUNCMETH 259 ! ! #define THING 260 ! ! #define PMFUNC 261 ! ! #define PRIVATEREF 262 ! ! #define FUNC0SUB 263 ! ! #define UNIOPSUB 264 ! ! #define LSTOPSUB 265 ! ! #define LABEL 266 ! ! #define FORMAT 267 ! ! #define SUB 268 ! ! #define ANONSUB 269 ! ! #define PACKAGE 270 ! ! #define USE 271 ! ! #define WHILE 272 ! ! #define UNTIL 273 ! ! #define IF 274 ! ! #define UNLESS 275 ! ! #define ELSE 276 ! ! #define ELSIF 277 ! ! #define CONTINUE 278 ! ! #define FOR 279 ! ! #define LOOPEX 280 ! ! #define DOTDOT 281 ! ! #define FUNC0 282 ! ! #define FUNC1 283 ! ! #define FUNC 284 ! ! #define UNIOP 285 ! ! #define LSTOP 286 ! ! #define RELOP 287 ! ! #define EQOP 288 ! ! #define MULOP 289 ! ! #define ADDOP 290 ! ! #define DOLSHARP 291 ! ! #define DO 292 ! ! #define HASHBRACK 293 ! ! #define NOAMP 294 ! ! #define LOCAL 295 ! ! #define MY 296 ! ! #define OROP 297 ! ! #define ANDOP 298 ! ! #define NOTOP 299 ! ! #define ASSIGNOP 300 ! ! #define OROR 301 ! ! #define ANDAND 302 ! ! #define BITOROP 303 ! ! #define BITANDOP 304 ! ! #define SHIFTOP 305 ! ! #define MATCHOP 306 ! ! #define UMINUS 307 ! ! #define REFGEN 308 ! ! #define POWOP 309 ! ! #define PREINC 310 ! ! #define PREDEC 311 ! ! #define POSTINC 312 ! ! #define POSTDEC 313 ! ! #define ARROW 314 #define YYERRCODE 256 short yylhs[] = { -1, --- 20,26 ---- --- 1,96 ---- ! *** perly.c.orig Tue Jul 28 15:02:41 1998 ! --- perly.c Tue Jul 28 15:14:54 1998 *************** ! *** 7,11 **** ! --- 7,19 ---- #include "perl.h" + #ifdef PERL_OBJECT ! static void + Dep(CPerlObj *pPerl) + { + pPerl->deprecate("\"do\" to call subroutines"); + } + #define dep() Dep(this) + #else ! + static void dep(void) + { *************** ! *** 12,86 **** deprecate("\"do\" to call subroutines"); } ! #line 30 "perly.y" ! - #ifndef OEMVS ! - #line 33 "perly.y" ! - typedef union { ! - I32 ival; ! - char *pval; ! - OP *opval; ! - GV *gvval; ! - } YYSTYPE; ! - #line 41 "perly.y" ! - #endif /* OEMVS */ ! - #line 27 "y.tab.c" ! - #define WORD 257 ! - #define METHOD 258 ! - #define FUNCMETH 259 ! - #define THING 260 ! - #define PMFUNC 261 ! - #define PRIVATEREF 262 ! - #define FUNC0SUB 263 ! - #define UNIOPSUB 264 ! - #define LSTOPSUB 265 ! - #define LABEL 266 ! - #define FORMAT 267 ! - #define SUB 268 ! - #define ANONSUB 269 ! - #define PACKAGE 270 ! - #define USE 271 ! - #define WHILE 272 ! - #define UNTIL 273 ! - #define IF 274 ! - #define UNLESS 275 ! - #define ELSE 276 ! - #define ELSIF 277 ! - #define CONTINUE 278 ! - #define FOR 279 ! - #define LOOPEX 280 ! - #define DOTDOT 281 ! - #define FUNC0 282 ! - #define FUNC1 283 ! - #define FUNC 284 ! - #define UNIOP 285 ! - #define LSTOP 286 ! - #define RELOP 287 ! - #define EQOP 288 ! - #define MULOP 289 ! - #define ADDOP 290 ! - #define DOLSHARP 291 ! - #define DO 292 ! - #define HASHBRACK 293 ! - #define NOAMP 294 ! - #define LOCAL 295 ! - #define MY 296 ! - #define OROP 297 ! - #define ANDOP 298 ! - #define NOTOP 299 ! - #define ASSIGNOP 300 ! - #define OROR 301 ! - #define ANDAND 302 ! - #define BITOROP 303 ! - #define BITANDOP 304 ! - #define SHIFTOP 305 ! - #define MATCHOP 306 ! - #define UMINUS 307 ! - #define REFGEN 308 ! - #define POWOP 309 ! - #define PREINC 310 ! - #define PREDEC 311 ! - #define POSTINC 312 ! - #define POSTDEC 313 ! - #define ARROW 314 #define YYERRCODE 256 short yylhs[] = { -1, --- 20,26 ---- *************** *** 94,116 **** } + #endif ! ! #line 16 "perly.c" #define YYERRCODE 256 short yylhs[] = { -1, *************** ! *** 1337,1361 **** ! int yyerrflag; ! int yychar; ! - short *yyssp; ! - YYSTYPE *yyvsp; YYSTYPE yyval; YYSTYPE yylval; - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE ! #line 635 "perly.y" /* PROGRAM */ ! ! #line 1349 "y.tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab --- 98,116 ---- } + #endif ! #line 30 "perly.y" #define YYERRCODE 256 short yylhs[] = { -1, *************** ! *** 1345,1365 **** YYSTYPE yyval; YYSTYPE yylval; - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE ! #line 643 "perly.y" /* PROGRAM */ ! ! #line 1353 "y.tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab *************** *** 124,137 **** if (yys = getenv("YYDEBUG")) { ! --- 1281,1347 ---- ! int yyerrflag; ! int yychar; YYSTYPE yyval; YYSTYPE yylval; ! #line 635 "perly.y" /* PROGRAM */ ! ! #line 1349 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab --- 124,135 ---- if (yys = getenv("YYDEBUG")) { ! --- 1285,1349 ---- YYSTYPE yyval; YYSTYPE yylval; ! #line 643 "perly.y" /* PROGRAM */ ! ! #line 1353 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab *************** *** 178,184 **** extern char *getenv(); + #endif + #endif ! + + struct ysv *ysave; + New(73, ysave, 1, struct ysv); + SAVEDESTRUCTOR(yydestruct, ysave); --- 176,182 ---- extern char *getenv(); + #endif + #endif ! + struct ysv *ysave; + New(73, ysave, 1, struct ysv); + SAVEDESTRUCTOR(yydestruct, ysave); *************** *** 188,200 **** + ysave->oldyychar = yychar; + ysave->oldyyval = yyval; + ysave->oldyylval = yylval; ! + #if YYDEBUG if (yys = getenv("YYDEBUG")) { *************** ! *** 1370,1373 **** ! --- 1356,1369 ---- yychar = (-1); + /* --- 186,198 ---- + ysave->oldyychar = yychar; + ysave->oldyyval = yyval; + ysave->oldyylval = yylval; ! + + #if YYDEBUG if (yys = getenv("YYDEBUG")) { *************** ! *** 1374,1377 **** ! --- 1358,1371 ---- yychar = (-1); + /* *************** *** 210,245 **** yyssp = yyss; yyvsp = yyvs; *************** ! *** 1385,1389 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } ! --- 1381,1385 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } *************** ! *** 1395,1404 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif ! if (yyssp >= yyss + yystacksize - 1) ! { ! ! goto yyoverflow; ! } ! *++yyssp = yystate = yytable[yyn]; ! --- 1391,1414 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif if (yyssp >= yyss + yystacksize - 1) { ! /* --- 208,246 ---- yyssp = yyss; yyvsp = yyvs; *************** ! *** 1389,1393 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } ! --- 1383,1387 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } *************** ! *** 1399,1403 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif ! --- 1393,1397 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif + *************** + *** 1404,1408 **** + if (yyssp >= yyss + yystacksize - 1) + { + ! goto yyoverflow; + } + *++yyssp = yystate = yytable[yyn]; + --- 1398,1416 ---- if (yyssp >= yyss + yystacksize - 1) { ! /* *************** *** 260,266 **** } *++yyssp = yystate = yytable[yyn]; *************** ! *** 1436,1445 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, error recovery shifting\ --- 261,267 ---- } *++yyssp = yystate = yytable[yyn]; *************** ! *** 1440,1449 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, error recovery shifting\ *************** *** 271,277 **** ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ! --- 1446,1470 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, --- 272,278 ---- ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ! --- 1448,1472 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, *************** *** 298,311 **** } *++yyssp = yystate = yytable[yyn]; *************** ! *** 1451,1456 **** #if YYDEBUG if (yydebug) ! printf("yydebug: error recovery discarding state %d\n", ! *yyssp); #endif if (yyssp <= yyss) goto yyabort; ! --- 1476,1482 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, --- 299,312 ---- } *++yyssp = yystate = yytable[yyn]; *************** ! *** 1455,1460 **** #if YYDEBUG if (yydebug) ! printf("yydebug: error recovery discarding state %d\n", ! *yyssp); #endif if (yyssp <= yyss) goto yyabort; ! --- 1478,1484 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, *************** *** 314,327 **** #endif if (yyssp <= yyss) goto yyabort; *************** ! *** 1469,1474 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, error recovery discards token %d (%s)\n", ! yystate, yychar, yys); } #endif ! --- 1495,1501 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, --- 315,328 ---- #endif if (yyssp <= yyss) goto yyabort; *************** ! *** 1473,1478 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, error recovery discards token %d (%s)\n", ! yystate, yychar, yys); } #endif ! --- 1497,1503 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, *************** *** 330,369 **** } #endif *************** ! *** 1479,1483 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif ! --- 1506,1510 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif *************** ! *** 2263,2267 **** { yyval.opval = yyvsp[0].opval; } break; ! ! #line 2266 "y.tab.c" } yyssp -= yym; ! --- 2290,2294 ---- { yyval.opval = yyvsp[0].opval; } break; ! ! #line 2266 "perly.c" } yyssp -= yym; *************** ! *** 2273,2278 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state 0 to\ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ! --- 2300,2306 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, --- 331,370 ---- } #endif *************** ! *** 1483,1487 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif ! --- 1508,1512 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif *************** ! *** 2267,2271 **** { yyval.opval = yyvsp[0].opval; } break; ! ! #line 2270 "y.tab.c" } yyssp -= yym; ! --- 2292,2296 ---- { yyval.opval = yyvsp[0].opval; } break; ! ! #line 2270 "perly.c" } yyssp -= yym; *************** ! *** 2277,2282 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state 0 to\ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ! --- 2302,2308 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, *************** *** 372,391 **** #endif yystate = YYFINAL; *************** ! *** 2288,2292 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ! --- 2316,2320 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** ! *** 2303,2312 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state %d \ --- 373,392 ---- #endif yystate = YYFINAL; *************** ! *** 2292,2296 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ! --- 2318,2322 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** ! *** 2307,2316 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state %d \ *************** *** 396,402 **** ! goto yyoverflow; } *++yyssp = yystate; ! --- 2331,2355 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, --- 397,403 ---- ! goto yyoverflow; } *++yyssp = yystate; ! --- 2333,2357 ---- #if YYDEBUG if (yydebug) ! PerlIO_printf(Perl_debug_log, *************** *** 423,429 **** } *++yyssp = yystate; *************** ! *** 2314,2321 **** goto yyloop; yyoverflow: ! yyerror("yacc stack overflow"); --- 424,430 ---- } *++yyssp = yystate; *************** ! *** 2318,2325 **** goto yyloop; yyoverflow: ! yyerror("yacc stack overflow"); *************** *** 432,438 **** yyaccept: ! return (0); } ! --- 2357,2364 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); --- 433,439 ---- yyaccept: ! return (0); } ! --- 2359,2366 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); Index: pod/perlcall.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlcall.pod Fri Jul 24 00:01:22 1998 --- perl5.005_02/pod/perlcall.pod Sat Aug 1 23:40:14 1998 *************** *** 279,286 **** It is possible for the Perl subroutine you are calling to terminate abnormally, e.g., by calling I explicitly or by not actually ! existing. By default, when either of these of events occurs, the ! process will terminate immediately. If though, you want to trap this type of event, specify the G_EVAL flag. It will put an I around the subroutine call. --- 279,286 ---- It is possible for the Perl subroutine you are calling to terminate abnormally, e.g., by calling I explicitly or by not actually ! existing. By default, when either of these events occurs, the ! process will terminate immediately. If you want to trap this type of event, specify the G_EVAL flag. It will put an I around the subroutine call. Index: pod/perldelta.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perldelta.pod Sun Jul 26 17:14:05 1998 --- perl5.005_02/pod/perldelta.pod Sun Aug 2 01:15:07 1998 *************** *** 165,171 **** just before execution begins. It eliminates the compile-time overheads of the regular perl interpreter, but the run-time performance remains comparatively the same. The CC backend generates optimized C code ! equivivalent to the code path at run-time. The CC backend has greater potential for big optimizations, but only a few optimizations are implemented currently. The Bytecode backend generates a platform independent bytecode representation of the interpreter's state --- 165,171 ---- just before execution begins. It eliminates the compile-time overheads of the regular perl interpreter, but the run-time performance remains comparatively the same. The CC backend generates optimized C code ! equivalent to the code path at run-time. The CC backend has greater potential for big optimizations, but only a few optimizations are implemented currently. The Bytecode backend generates a platform independent bytecode representation of the interpreter's state *************** *** 208,219 **** New types of nodes to process (SUBEXPR)* and similar expressions quickly, used if the SUBEXPR has no side effects and matches strings of the same length; ! better optimizations by lookup for constant substrings; Better search for constants substrings anchored by $ ; Changes in Perl code using RE engine: ! more optimizations to s/longer/short/; study() was not working; /blah/ may be optimized to an analogue of index() if $& $` $' not seen; Unneeded copying of matched-against string removed; --- 208,219 ---- New types of nodes to process (SUBEXPR)* and similar expressions quickly, used if the SUBEXPR has no side effects and matches strings of the same length; ! Better optimizations by lookup for constant substrings; Better search for constants substrings anchored by $ ; Changes in Perl code using RE engine: ! More optimizations to s/longer/short/; study() was not working; /blah/ may be optimized to an analogue of index() if $& $` $' not seen; Unneeded copying of matched-against string removed; *************** *** 230,236 **** possibility of a segfault; (ZERO-LENGTH)* could segfault; (ZERO-LENGTH)* was prohibited; ! Long RE were not allowed; /RE/g could skip matches at the same position after a zero-length match; --- 230,236 ---- possibility of a segfault; (ZERO-LENGTH)* could segfault; (ZERO-LENGTH)* was prohibited; ! Long REs were not allowed; /RE/g could skip matches at the same position after a zero-length match; *************** *** 253,261 **** =item Other improvements ! better debugging output (possibly with colors), even from non-debugging Perl; RE engine code now looks like C, not like assembler; ! behaviour of RE modifiable by `use re' directive; Improved documentation; Test suite significantly extended; Syntax [:^upper:] etc., reserved inside character classes; --- 253,262 ---- =item Other improvements ! Better debugging output (possibly with colors), ! even from non-debugging Perl; RE engine code now looks like C, not like assembler; ! Behaviour of RE modifiable by `use re' directive; Improved documentation; Test suite significantly extended; Syntax [:^upper:] etc., reserved inside character classes; *************** *** 455,461 **** =head2 Negative LENGTH argument to splice ! Splice() with a negative LENGTH argument now work similar to what the LENGTH did for substr(). Previously a negative LENGTH was treated as 0. See L. --- 456,462 ---- =head2 Negative LENGTH argument to splice ! splice() with a negative LENGTH argument now work similar to what the LENGTH did for substr(). Previously a negative LENGTH was treated as 0. See L. *************** *** 500,505 **** --- 501,508 ---- DOS is now supported under the DJGPP tools. See L. MPE/iX is now supported. See L. + + MVS (OS390) is now supported. See L. =head2 Changes in existing support Index: pod/perldiag.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perldiag.pod Fri Jul 24 00:01:26 1998 --- perl5.005_02/pod/perldiag.pod Sun Aug 2 02:44:13 1998 *************** *** 1538,1544 **** =item Modification of non-creatable hash value attempted, subscript "%s" ! (F) You tried to make a hash value spring into existence, and it couldn't be created for some peculiar reason. =item Module name must be constant --- 1538,1544 ---- =item Modification of non-creatable hash value attempted, subscript "%s" ! (P) You tried to make a hash value spring into existence, and it couldn't be created for some peculiar reason. =item Module name must be constant *************** *** 2479,2488 **** instead of Perl. Check the #! line, or manually feed your script into Perl yourself. ! =item System V IPC is not implemented on this machine ! (F) You tried to do something with a function beginning with "sem", "shm", ! or "msg". See L, for example. =item Syswrite on closed filehandle --- 2479,2490 ---- instead of Perl. Check the #! line, or manually feed your script into Perl yourself. ! =item System V %s is not implemented on this machine ! (F) You tried to do something with a function beginning with "sem", ! "shm", or "msg" but that System V IPC is not implemented in your ! machine. In some machines the functionality can exist but be ! unconfigured. Consult your system support. =item Syswrite on closed filehandle Index: pod/perlembed.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlembed.pod Fri Jul 24 00:01:28 1998 --- perl5.005_02/pod/perlembed.pod Sun Aug 2 03:09:43 1998 *************** *** 35,40 **** --- 35,42 ---- =head2 ROADMAP + =over 5 + L L Index: pod/perlfaq.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq.pod Fri Jul 24 00:01:28 1998 --- perl5.005_02/pod/perlfaq.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq - frequently asked questions about Perl ($Date: 1998/07/20 23:12:17 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq - frequently asked questions about Perl ($Date: 1998/08/05 12:09:32 $) =head1 DESCRIPTION *************** *** 117,123 **** =over 4 ! =head 22/June/98 Significant changes throughout in preparation for the 5.005 release. --- 117,123 ---- =over 4 ! =item 22/June/98 Significant changes throughout in preparation for the 5.005 release. Index: pod/perlfaq1.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq1.pod Fri Jul 24 00:01:28 1998 --- perl5.005_02/pod/perlfaq1.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq1 - General Questions About Perl ($Revision: 1.14 $, $Date: 1998/06/14 22:15:25 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq1 - General Questions About Perl ($Revision: 1.15 $, $Date: 1998/08/05 11:52:24 $) =head1 DESCRIPTION *************** *** 29,35 **** core, the standard Perl library, the optional modules, and the documentation you're reading now were all written by volunteers. See the personal note at the end of the README file in the perl source ! distribution for more details. In particular, the core development team (known as the Perl Porters) are a rag-tag band of highly altruistic individuals --- 29,36 ---- core, the standard Perl library, the optional modules, and the documentation you're reading now were all written by volunteers. See the personal note at the end of the README file in the perl source ! distribution for more details. See L (new as of 5.005) ! for Perl's milestone releases. In particular, the core development team (known as the Perl Porters) are a rag-tag band of highly altruistic individuals *************** *** 51,60 **** You should definitely use version 5. Version 4 is old, limited, and no longer maintained; its last patch (4.036) was in 1992. The most ! recent production release is 5.004_01. Further references to the Perl language in this document refer to this production release unless otherwise specified. There may be one or more official bug fixes for ! 5.004_01 by the time you read this, and also perhaps some experimental versions on the way to the next release. =head2 What are perl4 and perl5? --- 52,61 ---- You should definitely use version 5. Version 4 is old, limited, and no longer maintained; its last patch (4.036) was in 1992. The most ! recent production release is 5.005_01. Further references to the Perl language in this document refer to this production release unless otherwise specified. There may be one or more official bug fixes for ! 5.005_01 by the time you read this, and also perhaps some experimental versions on the way to the next release. =head2 What are perl4 and perl5? *************** *** 210,216 **** Over a hundred quips by Larry, from postings of his or source code, can be found at http://www.perl.com/CPAN/misc/lwall-quotes . ! =head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.004/Perl instead of some other language)? If your manager or employees are wary of unsupported software, or software which doesn't officially ship with your Operating System, you --- 211,217 ---- Over a hundred quips by Larry, from postings of his or source code, can be found at http://www.perl.com/CPAN/misc/lwall-quotes . ! =head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)? If your manager or employees are wary of unsupported software, or software which doesn't officially ship with your Operating System, you *************** *** 240,249 **** (Well, ok, maybe 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. That probably means running the 5.004 release, ! although 5.003 isn't that bad (it's just one year and one release behind). Several important bugs were fixed from the 5.000 through ! 5.002 versions, though, so try upgrading past them if possible. =head1 AUTHOR AND COPYRIGHT --- 241,255 ---- (Well, ok, maybe 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. That probably means running the 5.005 release, ! although 5.004 isn't that bad (it's just one year and one release behind). Several important bugs were fixed from the 5.000 through ! 5.003 versions, though, so try upgrading past them if possible. ! ! Of particular note is the massive bughunt for buffer overflow ! problems that went into the 5.004 release. All releases prior to ! that, including perl4, are considered insecure and should be upgraded ! as soon as possible. =head1 AUTHOR AND COPYRIGHT Index: pod/perlfaq2.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq2.pod Fri Jul 24 00:01:29 1998 --- perl5.005_02/pod/perlfaq2.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.24 $, $Date: 1998/07/20 23:40:28 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.25 $, $Date: 1998/08/05 11:47:25 $) =head1 DESCRIPTION *************** *** 11,32 **** =head2 What machines support Perl? Where do I get it? The standard release of Perl (the one maintained by the perl ! development team) is distributed only in source code form. You can ! find this at http://www.perl.com/CPAN/src/latest.tar.gz, which is a ! gzipped archive in POSIX tar format. This source builds with no ! porting whatsoever on most Unix systems (Perl's native environment), ! as well as Plan 9, VMS, QNX, OS/2, and the Amiga. ! ! Although it's rumored that the (imminent) 5.004 release may build ! on Windows NT, this is yet to be proven. Binary distributions ! for 32-bit Microsoft systems and for Apple systems can be found ! http://www.perl.com/CPAN/ports/ directory. Because these are not part of ! the standard distribution, they may and in fact do differ from the base ! Perl port in a variety of ways. You'll have to check their respective ! release notes to see just what the differences are. These differences ! can be either positive (e.g. extensions for the features of the particular ! platform that are not supported in the source release of perl) or negative ! (e.g. might be based upon a less current source release of perl). A useful FAQ for Win32 Perl users is http://www.endcontsw.com/people/evangelo/Perl_for_Win32_FAQ.html --- 11,35 ---- =head2 What machines support Perl? Where do I get it? The standard release of Perl (the one maintained by the perl ! development team) is distributed only in source code form. You ! can find this at http://www.perl.com/CPAN/src/latest.tar.gz, which ! in standard Internet format (a gzipped archive in POSIX tar format). ! ! Perl builds and runs on a bewildering number of platforms. Virtually ! all known and current Unix derivatives are supported (Perl's native ! platform), as are proprietary systems like VMS, DOS, OS/2, Windows, ! QNX, BeOS, and the Amiga. There are also the beginnings of support ! for MPE/iX. ! ! Binary distributions for some proprietary platforms, including ! Apple systems can be found http://www.perl.com/CPAN/ports/ directory. ! Because these are not part of the standard distribution, they may ! and in fact do differ from the base Perl port in a variety of ways. ! You'll have to check their respective release notes to see just ! what the differences are. These differences can be either positive ! (e.g. extensions for the features of the particular platform that ! are not supported in the source release of perl) or negative (e.g. ! might be based upon a less current source release of perl). A useful FAQ for Win32 Perl users is http://www.endcontsw.com/people/evangelo/Perl_for_Win32_FAQ.html *************** *** 177,201 **** Christiansen maintains a list of these books, some with extensive reviews, at http://www.perl.com/perl/critiques/index.html. ! The incontestably definitive reference book on Perl, written by the ! creator of Perl and his apostles, is now in its second edition and ! fourth printing. Programming Perl (the "Camel Book"): Authors: Larry Wall, Tom Christiansen, and Randal Schwartz ISBN 1-56592-149-6 (English) ISBN 4-89052-384-7 (Japanese) ! (French, German, and Italian translations also available) ! ! Note that O'Reilly books are color-coded: turquoise (some would call ! it teal) covers indicate perl5 coverage, while magenta (some would ! call it pink) covers indicate perl4 only. Check the cover color ! before you buy! If you're already a hard-core systems programmer, then the Camel Book might suffice for you to learn Perl from. But if you're not, check ! out I by Randal and Tom. The second edition of "Llama ! Book" has a blue cover, and is updated for the 5.004 release of Perl. If you're not an accidental programmer, but a more serious and possibly even degreed computer scientist who doesn't need as much hand-holding as --- 180,220 ---- Christiansen maintains a list of these books, some with extensive reviews, at http://www.perl.com/perl/critiques/index.html. ! The incontestably definitive reference book on Perl, written by ! the creator of Perl, is now in its second edition: Programming Perl (the "Camel Book"): Authors: Larry Wall, Tom Christiansen, and Randal Schwartz ISBN 1-56592-149-6 (English) ISBN 4-89052-384-7 (Japanese) ! URL: http://www.oreilly.com/catalog/pperl2/ ! (French, German, Italian, and Hungarian translations also ! available) ! ! The companion volume to the Camel containing thousands ! of real-world examples, mini-tutorials, and complete programs ! (first premiering at the 1998 Perl Conference), is: ! ! The Perl Cookbook (the "Ram Book"): ! Authors: Tom Christiansen and Nathan Torkington, ! with Foreword by Larry Wall ! ISBN: 1-56592-243-3 ! URL: http://perl.oreilly.com/cookbook/ If you're already a hard-core systems programmer, then the Camel Book might suffice for you to learn Perl from. But if you're not, check ! out: ! ! Learning Perl (the "Llama Book"): ! Authors: Randal Schwartz and Tom Christiansen ! with Foreword by Larry Wall ! ISBN: 1-56592-284-0 ! URL: http://www.oreilly.com/catalog/lperl2/ ! ! Despite the picture at the URL above, the second edition of "Llama ! Book" really has a blue cover, and is updated for the 5.004 release ! of Perl. Various foreign language editions are available, including ! I (the Gecko Book). If you're not an accidental programmer, but a more serious and possibly even degreed computer scientist who doesn't need as much hand-holding as *************** *** 211,218 **** What follows is a list of the books that the FAQ authors found personally useful. Your mileage may (but, we hope, probably won't) vary. ! Recommended books on (or muchly on) Perl are the following. ! Those marked with a star may be ordered from O'Reilly. =over --- 230,237 ---- What follows is a list of the books that the FAQ authors found personally useful. Your mileage may (but, we hope, probably won't) vary. ! Recommended books on (or muchly on) Perl follow; those marked with ! a star may be ordered from O'Reilly. =over *************** *** 228,233 **** --- 247,253 ---- *Learning Perl [2nd edition] by Randal L. Schwartz and Tom Christiansen + with foreword by Larry Wall *Learning Perl on Win32 Systems by Randal L. Schwartz, Erik Olson, and Tom Christiansen, *************** *** 273,281 **** Perl Journal> contains tutorials, demonstrations, case studies, announcements, contests, and much more. TPJ has columns on web development, databases, Win32 Perl, graphical programming, regular ! expressions, and networking, and sponsors the Obfuscated Perl Contest. ! It is published quarterly by Jon Orwant. See http://www.tpj.com/ or ! send mail to subscriptions@tpj.com. Beyond this, magazines that frequently carry high-quality articles on Perl are I (see http://www.webtechniques.com/), --- 293,302 ---- Perl Journal> contains tutorials, demonstrations, case studies, announcements, contests, and much more. TPJ has columns on web development, databases, Win32 Perl, graphical programming, regular ! expressions, and networking, and sponsors the Obfuscated Perl ! Contest. It is published quarterly under the gentle hand of its ! editor, Jon Orwant. See http://www.tpj.com/ or send mail to ! subscriptions@tpj.com. Beyond this, magazines that frequently carry high-quality articles on Perl are I (see http://www.webtechniques.com/), *************** *** 297,305 **** http://www.cs.ruu.nl/pub/PERL/CPAN/ ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ - http:/www.oasis.leo.org/perl/ has, amongst other things, source to - versions 1 through 5 of Perl. - =head2 What mailing lists are there for perl? Most of the major modules (tk, CGI, libwww-perl) have their own --- 318,323 ---- *************** *** 427,432 **** --- 445,452 ---- Web: http://www.perl.co.uk/ Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk + See also www.perl.com for updates on training and support. + =head2 Where do I send bug reports? If you are reporting a bug in the perl interpreter or the modules *************** *** 443,449 **** =head2 What is perl.com? perl.org? The Perl Institute? ! The perl.com domain is Tom Christiansen's domain. He created it as a public service long before perl.org came about. Despite the name, it's a pretty non-commercial site meant to be a clearinghouse for information about all things Perlian, accepting no paid advertisements, bouncy --- 463,469 ---- =head2 What is perl.com? perl.org? The Perl Institute? ! The perl.com domain is managed by Tom Christiansen, who created it as a public service long before perl.org came about. Despite the name, it's a pretty non-commercial site meant to be a clearinghouse for information about all things Perlian, accepting no paid advertisements, bouncy *************** *** 454,462 **** perl.org is the official vehicle for The Perl Institute. The motto of TPI is "helping people help Perl help people" (or something like that). It's a non-profit organization supporting development, ! documentation, and dissemination of perl. Current directors of TPI ! include Larry Wall, Tom Christiansen, and Randal Schwartz, whom you ! may have heard of somewhere else around here. =head2 How do I learn about object-oriented Perl programming? --- 474,480 ---- perl.org is the official vehicle for The Perl Institute. The motto of TPI is "helping people help Perl help people" (or something like that). It's a non-profit organization supporting development, ! documentation, and dissemination of perl. =head2 How do I learn about object-oriented Perl programming? Index: pod/perlfaq3.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq3.pod Fri Jul 24 00:01:29 1998 --- perl5.005_02/pod/perlfaq3.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq3 - Programming Tools ($Revision: 1.28 $, $Date: 1998/07/16 22:08:49 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq3 - Programming Tools ($Revision: 1.29 $, $Date: 1998/08/05 11:57:04 $) =head1 DESCRIPTION *************** *** 372,381 **** =head2 How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, ! available from CPAN, that can do both these things. It is as of ! Jul-1998 in late alpha release, which means it's fun to play with if ! you're a programmer but not really for people looking for turn-key ! solutions. Merely compiling into C does not in and of itself guarantee that your code will run very much faster. That's because except for lucky cases --- 372,381 ---- =head2 How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, ! available from CPAN, that can do both these things. It is included ! in the perl5.005 release, but is still considered experimental. ! This means it's fun to play with if you're a programmer but not ! really for people looking for turn-key solutions. Merely compiling into C does not in and of itself guarantee that your code will run very much faster. That's because except for lucky cases *************** *** 386,396 **** rare programs actually benefit significantly (like several times faster), but this takes some tweaking of your code. - The 5.005 release of Perl itself, whose main goal is merging the various - non-Unix ports back into the one Perl source, will also have preliminary - (strictly beta) support for Malcolm's compiler and his light-weight - processes (sometimes called ``threads''). - You'll probably be astonished to learn that the current version of the compiler generates a compiled form of your script whose executable is just as big as the original perl executable, and then some. That's --- 386,391 ---- *************** *** 410,416 **** viruses, or bootleggers. The real advantage of the compiler is merely packaging, and once you see the size of what it makes (well, unless you use a shared I), you'll probably want a complete ! Perl install anywayt. =head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]? --- 405,411 ---- viruses, or bootleggers. The real advantage of the compiler is merely packaging, and once you see the size of what it makes (well, unless you use a shared I), you'll probably want a complete ! Perl install anyway. =head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]? Index: pod/perlfaq4.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq4.pod Fri Jul 24 00:01:30 1998 --- perl5.005_02/pod/perlfaq4.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq4 - Data Manipulation ($Revision: 1.25 $, $Date: 1998/07/16 22:49:55 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq4 - Data Manipulation ($Revision: 1.26 $, $Date: 1998/08/05 12:04:00 $) =head1 DESCRIPTION *************** *** 177,183 **** Of course, this believes that weeks start at zero. The Date::Calc module from CPAN has a lot of date calculation functions, including ! day of the year, week of the year, and so on. =head2 How can I compare two dates and find the difference? --- 177,187 ---- Of course, this believes that weeks start at zero. The Date::Calc module from CPAN has a lot of date calculation functions, including ! day of the year, week of the year, and so on. Note that not ! all business consider ``week 1'' to be the same; for example, ! American business often consider the first week with a Monday ! in it to be Work Week #1, despite ISO 8601, which consider ! WW1 to be the frist week with a Thursday in it. =head2 How can I compare two dates and find the difference? *************** *** 202,209 **** =head2 Does Perl have a year 2000 problem? Is Perl Y2K compliant? ! Short answer: No, Perl does not have a Year 2000 problem. Yes, Perl ! is Y2K compliant. Long answer: Perl is just as Y2K compliant as your pencil--no more, and no less. The date and time functions supplied with perl (gmtime --- 206,214 ---- =head2 Does Perl have a year 2000 problem? Is Perl Y2K compliant? ! Short answer: No, Perl does not have a Year 2000 problem. Yes, ! Perl is Y2K compliant. The programmers you're hired to use it, ! however, probably are not. Long answer: Perl is just as Y2K compliant as your pencil--no more, and no less. The date and time functions supplied with perl (gmtime *************** *** 471,477 **** s/\s+$//; } ! This idiom takes advantage of the C loop's aliasing behavior to factor out common code. You can do this on several strings at once, or arrays, or even the values of a hash if you use a slide: --- 476,482 ---- s/\s+$//; } ! This idiom takes advantage of the C loop's aliasing behavior to factor out common code. You can do this on several strings at once, or arrays, or even the values of a hash if you use a slide: Index: pod/perlfaq8.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfaq8.pod Fri Jul 24 00:01:33 1998 --- perl5.005_02/pod/perlfaq8.pod Wed Aug 5 18:02:28 1998 *************** *** 1,6 **** =head1 NAME ! perlfaq8 - System Interaction ($Revision: 1.25 $, $Date: 1998/07/05 15:07:20 $) =head1 DESCRIPTION --- 1,6 ---- =head1 NAME ! perlfaq8 - System Interaction ($Revision: 1.26 $, $Date: 1998/08/05 12:20:28 $) =head1 DESCRIPTION *************** *** 1005,1011 **** another. Here are the deltas between the various inclusion constructs: 1) do $file is like eval `cat $file`, except the former: ! 1.1: searches @INC. 1.2: bequeaths an *unrelated* lexical scope on the eval'ed code. 2) require $file is like do $file, except the former: --- 1005,1011 ---- another. Here are the deltas between the various inclusion constructs: 1) do $file is like eval `cat $file`, except the former: ! 1.1: searches @INC and updates %INC. 1.2: bequeaths an *unrelated* lexical scope on the eval'ed code. 2) require $file is like do $file, except the former: Index: pod/perlfunc.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlfunc.pod Fri Jul 24 00:01:37 1998 --- perl5.005_02/pod/perlfunc.pod Tue Aug 4 23:27:17 1998 *************** *** 225,230 **** --- 225,232 ---- names, precedence is the same as any other named unary operator, and the argument may be parenthesized like any other unary operator. The operator may be any of: + X<-r>X<-w>X<-x>X<-o>X<-R>X<-W>X<-X>X<-O>X<-e>X<-z>X<-s>X<-f>X<-d>X<-l>X<-p> + X<-S>X<-b>X<-c>X<-t>X<-u>X<-g>X<-k>X<-T>X<-B>X<-M>X<-A>X<-C> -r File is readable by effective uid/gid. -w File is writable by effective uid/gid. *************** *** 915,920 **** --- 917,928 ---- reparse the file every time you call it, so you probably don't want to do this inside a loop. + If C cannot read the file, it returns undef and sets C<$!> to the + error. If C can read the file but cannot compile it, it + returns undef and sets an error message in C<$@>. If the file is + successfully compiled, C returns the value of the last expression + evaluated. + Note that inclusion of library modules is better done with the C and C operators, which also do automatic error checking and raise an exception if there's a problem. *************** *** 3822,3829 **** The possible values and flag bits of the MODE parameter are system-dependent; they are available via the standard module C. ! However, for historical reasons, some values are universal: zero means ! read-only, one means write-only, and two means read/write. If the file named by FILENAME does not exist and the C call creates it (typically because MODE includes the C flag), then the value of --- 3830,3840 ---- The possible values and flag bits of the MODE parameter are system-dependent; they are available via the standard module C. ! For historical reasons, some values work on almost every system ! supported by perl: zero means read-only, one means write-only, and two ! means read/write. We know that these values do I work under ! OS/390 Unix and on the Macintosh; you probably don't want to use them ! in new code. If the file named by FILENAME does not exist and the C call creates it (typically because MODE includes the C flag), then the value of Index: pod/perlhist.pod Prereq: 1.41 ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlhist.pod Sun Jul 26 01:08:15 1998 --- perl5.005_02/pod/perlhist.pod Fri Aug 7 23:37:10 1998 *************** *** 6,12 **** =for RCS # ! # $Id: perlhist.pod,v 1.41 1998/06/09 15:20:18 jhi Exp $ # =end RCS --- 6,12 ---- =for RCS # ! # $Id: perlhist.pod,v 1.48 1998/08/03 08:50:12 jhi Exp $ # =end RCS *************** *** 32,38 **** Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy ! Sarathy. =head2 PUMPKIN? --- 32,38 ---- Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy ! Sarathy, Graham Barr. =head2 PUMPKIN? *************** *** 70,85 **** Larry 0 Classified. Don't ask. Larry 1.000 1987-Dec-18 ! 1.001..10 1988-Jan-30 1.011..14 1988-Feb-02 ! Larry 2.000 1988-Jun-05 ! 2.001 1988-Jun-28 ! Larry 3.000 1989-Oct-18 ! 3.001 1989-Oct-26 3.002..4 1989-Nov-11 3.005 1989-Nov-18 --- 70,85 ---- Larry 0 Classified. Don't ask. Larry 1.000 1987-Dec-18 ! 1.001..10 1988-Jan-30 1.011..14 1988-Feb-02 ! Larry 2.000 1988-Jun-05 ! 2.001 1988-Jun-28 ! Larry 3.000 1989-Oct-18 ! 3.001 1989-Oct-26 3.002..4 1989-Nov-11 3.005 1989-Nov-18 *************** *** 96,104 **** 3.041 1990-Nov-13 3.042..43 1990-Jan-?? 3.044 1991-Jan-12 ! Larry 4.000 1991-Mar-21 ! 4.001..3 1991-Apr-12 4.004..9 1991-Jun-07 4.010 1991-Jun-10 --- 96,104 ---- 3.041 1990-Nov-13 3.042..43 1990-Jan-?? 3.044 1991-Jan-12 ! Larry 4.000 1991-Mar-21 ! 4.001..3 1991-Apr-12 4.004..9 1991-Jun-07 4.010 1991-Jun-10 *************** *** 108,114 **** 4.034 1992-Jun-11 4.035 1992-Jun-23 Larry 4.036 1993-Feb-05 Very stable. ! 5.000alpha1 1993-Jul-31 5.000alpha2 1993-Aug-16 5.000alpha3 1993-Oct-10 --- 108,114 ---- 4.034 1992-Jun-11 4.035 1992-Jun-23 Larry 4.036 1993-Feb-05 Very stable. ! 5.000alpha1 1993-Jul-31 5.000alpha2 1993-Aug-16 5.000alpha3 1993-Oct-10 *************** *** 148,156 **** 5.000b3f 1994-Sep-30 5.000b3g 1994-Oct-04 Andy 5.000b3h 1994-Oct-07 ! Larry 5.000 1994-Oct-18 ! Andy 5.000a 1994-Dec-19 5.000b 1995-Jan-18 5.000c 1995-Jan-18 --- 148,156 ---- 5.000b3f 1994-Sep-30 5.000b3g 1994-Oct-04 Andy 5.000b3h 1994-Oct-07 ! Larry 5.000 1994-Oct-18 ! Andy 5.000a 1994-Dec-19 5.000b 1995-Jan-18 5.000c 1995-Jan-18 *************** *** 165,173 **** 5.000l 1995-Feb-21 5.000m 1995-???-?? 5.000n 1995-Mar-07 ! Larry 5.001 1995-Mar-13 ! Andy 5.001a 1995-Mar-15 5.001b 1995-Mar-31 5.001c 1995-Apr-07 --- 165,173 ---- 5.000l 1995-Feb-21 5.000m 1995-???-?? 5.000n 1995-Mar-07 ! Larry 5.001 1995-Mar-13 ! Andy 5.001a 1995-Mar-15 5.001b 1995-Mar-31 5.001c 1995-Apr-07 *************** *** 195,207 **** Larry 5.002b3 1996-Feb-02 Andy 5.002gamma 1996-Feb-11 Larry 5.002delta 1996-Feb-27 ! ! Larry 5.002 1996-Feb-29 ! Charles 5.002_01 1996-Mar-25 ! 5.003 1996-Jun-25 Security release. ! 5.003_01 1996-Jul-31 Nick 5.003_02 1996-Aug-10 Andy 5.003_03 1996-Aug-28 --- 195,207 ---- Larry 5.002b3 1996-Feb-02 Andy 5.002gamma 1996-Feb-11 Larry 5.002delta 1996-Feb-27 ! ! Larry 5.002 1996-Feb-29 Prototypes. ! Charles 5.002_01 1996-Mar-25 ! 5.003 1996-Jun-25 Security release. ! 5.003_01 1996-Jul-31 Nick 5.003_02 1996-Aug-10 Andy 5.003_03 1996-Aug-28 *************** *** 252,261 **** 5.003_99 1997-May-01 5.003_99a 1997-May-09 p54rc1 1997-May-12 Release Candidates. ! p54rc2 1997-May-14 ! Chip 5.004 1997-May-15 A major maintenance release. ! Tim 5.004_01 1997-Jun-13 The 5.004 maintenance track. 5.004_02 1997-Aug-07 5.004_03 1997-Sep-05 --- 252,261 ---- 5.003_99 1997-May-01 5.003_99a 1997-May-09 p54rc1 1997-May-12 Release Candidates. ! p54rc2 1997-May-14 ! Chip 5.004 1997-May-15 A major maintenance release. ! Tim 5.004_01 1997-Jun-13 The 5.004 maintenance track. 5.004_02 1997-Aug-07 5.004_03 1997-Sep-05 *************** *** 263,269 **** 5.004m5t1 1998-Mar-04 Maintenance Trials (for 5.004_05). 5.004_04-m2 1997-May-01 5.004_04-m3 1998-May-15 ! Malcolm 5.004_50 1997-Sep-09 The 5.005 development track. 5.004_51 1997-Oct-02 5.004_52 1997-Oct-15 --- 263,271 ---- 5.004m5t1 1998-Mar-04 Maintenance Trials (for 5.004_05). 5.004_04-m2 1997-May-01 5.004_04-m3 1998-May-15 ! 5.004_04-m4 1998-May-19 ! 5.004_04-MT5 1998-Jul-21 ! Malcolm 5.004_50 1997-Sep-09 The 5.005 development track. 5.004_51 1997-Oct-02 5.004_52 1997-Oct-15 *************** *** 288,297 **** 5.004_71 1998-Jul-09 5.004_72 1998-Jul-12 5.004_73 1998-Jul-13 ! 5.004_74 1998-Jul-14 ! 5.004_75 1998-Jul-15 ! 5.004_76 1998-Jul-21 ! 5.005 1998-Jul-22 =head2 SELECTED RELEASE SIZES --- 290,307 ---- 5.004_71 1998-Jul-09 5.004_72 1998-Jul-12 5.004_73 1998-Jul-13 ! 5.004_74 1998-Jul-14 5.005 beta candidate. ! 5.004_75 1998-Jul-15 5.005 beta1. ! 5.004_76 1998-Jul-21 5.005 beta2. ! 5.005 1998-Jul-22 Oneperl. ! ! Sarathy 5.005_01 1998-Jul-27 The 5.005 maintenance track. ! 5.005_02-T1 1998-Aug-02 ! 5.005_02-T2 1998-Aug-05 ! 5.005_02 1998-Aug-08 ! Graham 5.005_03 1998- ! ! Sarathy 5.005_50 1998-Jul-26 The 5.006 development track. =head2 SELECTED RELEASE SIZES *************** *** 322,335 **** 5.003 1129 54 680 102 291 43 166 100 853 35 5.003_07 1231 60 748 106 396 53 213 137 976 39 5.004 1351 60 1230 136 408 51 355 161 1587 55 ! 5.004_01 1356 60 1258 138 410 51 358 161 1587 55 5.004_04 1375 60 1294 139 413 51 394 162 1629 55 5.004_51 1401 61 1260 140 413 53 358 162 1594 56 5.004_53 1422 62 1295 141 438 70 394 162 1637 56 5.004_56 1501 66 1301 140 447 74 408 165 1648 57 ! 5.004_59 1555 72 1317 142 448 74 424 171 1678 58 5.004_62 1602 77 1327 144 629 92 428 173 1674 58 5.004_65 1626 77 1358 146 615 92 446 179 1698 60 The "core"..."doc" mean the following files from the Perl source code distribution. The glob notation ** means recursively, (.) means --- 332,350 ---- 5.003 1129 54 680 102 291 43 166 100 853 35 5.003_07 1231 60 748 106 396 53 213 137 976 39 5.004 1351 60 1230 136 408 51 355 161 1587 55 ! 5.004_01 1356 60 1258 138 410 51 358 161 1587 55 5.004_04 1375 60 1294 139 413 51 394 162 1629 55 5.004_51 1401 61 1260 140 413 53 358 162 1594 56 5.004_53 1422 62 1295 141 438 70 394 162 1637 56 5.004_56 1501 66 1301 140 447 74 408 165 1648 57 ! 5.004_59 1555 72 1317 142 448 74 424 171 1678 58 5.004_62 1602 77 1327 144 629 92 428 173 1674 58 5.004_65 1626 77 1358 146 615 92 446 179 1698 60 + 5.004_68 1856 74 1382 152 619 92 463 187 1784 60 + 5.004_70 1863 75 1456 154 675 92 494 194 1809 60 + 5.004_73 1874 76 1467 152 762 102 506 196 1883 61 + 5.004_75 1877 76 1467 152 770 103 508 196 1896 62 + 5.005 1896 76 1469 152 795 103 509 197 1945 63 The "core"..."doc" mean the following files from the Perl source code distribution. The glob notation ** means recursively, (.) means *************** *** 347,408 **** ====================================================================== Legend: kB # ! 1.014 2.001 3.044 4.000 4.019 4.036 ! ! atarist - - - - - - - - - - 113 31 ! Configure 31 1 37 1 62 1 73 1 83 1 86 1 ! eg - - 34 28 47 39 47 39 47 39 47 39 ! emacs - - - - - - 67 4 67 4 67 4 ! h2pl - - - - 12 12 12 12 12 12 12 12 ! hints - - - - - - - - 5 42 11 56 ! msdos - - - - 41 13 57 15 58 15 60 15 ! os2 - - - - 63 22 81 29 81 29 113 31 ! usub - - - - 21 16 25 7 43 8 43 8 ! x2p 103 17 104 17 137 17 147 18 152 19 154 19 ====================================================================== ! 5.000a2 5.000a12h 5.000b3h 5.000 5.001m 5.002 5.003 ! atarist 113 31 113 31 - - - - - - - - - - bench - - 0 1 - - - - - - - - - - Bugs 2 5 26 1 - - - - - - - - - - dlperl 40 5 - - - - - - - - - - - - do 127 71 - - - - - - - - - - - - ! Configure - - 153 1 159 1 160 1 180 1 201 1 201 1 ! Doc - - 26 1 75 7 11 1 11 1 - - - - ! eg 79 58 53 44 51 43 54 44 54 44 54 44 54 44 ! emacs 67 4 104 6 104 6 104 1 104 6 108 1 108 1 ! h2pl 12 12 12 12 12 12 12 12 12 12 12 12 12 12 ! hints 11 56 12 46 18 48 18 48 44 56 73 59 77 60 ! msdos 60 15 60 15 - - - - - - - - - - ! os2 113 31 113 31 - - - - - - 84 17 56 10 ! U - - 62 8 112 42 - - - - - - - - usub 43 8 - - - - - - - - - - - - ! utils - - - - - - - - - - 87 7 88 7 ! vms - - 80 7 123 9 184 15 304 20 500 24 475 26 ! x2p 171 22 171 21 162 20 162 20 279 20 280 20 280 20 ====================================================================== ! 5.003_07 5.004 5.004_04 5.004_62 5.004_65 ! ! beos - - - - - - - - 1 1 ! Configure 217 1 225 1 225 1 240 1 248 1 ! cygwin32 - - 23 5 23 5 23 5 24 5 ! djgpp - - - - - - 14 5 14 5 ! eg 54 44 81 62 81 62 81 62 81 62 ! emacs 143 1 194 1 204 1 212 2 212 2 ! h2pl 12 12 12 12 12 12 12 12 12 12 ! hints 90 62 129 69 132 71 144 72 151 74 ! os2 117 42 121 42 127 42 127 44 129 44 ! plan9 79 15 82 15 82 15 82 15 82 15 ! Porting 51 1 94 2 109 4 203 6 234 8 ! qnx - - 1 2 1 2 1 2 1 2 ! utils 97 7 112 8 118 8 124 8 156 9 ! vms 505 27 518 34 524 34 538 34 569 34 ! win32 - - 285 33 378 36 470 39 493 39 ! x2p 280 19 281 19 281 19 281 19 282 19 =head2 SELECTED PATCH SIZES --- 362,445 ---- ====================================================================== Legend: kB # ! 1.014 2.001 3.044 4.000 4.019 4.036 ! ! atarist - - - - - - - - - - 113 31 ! Configure 31 1 37 1 62 1 73 1 83 1 86 1 ! eg - - 34 28 47 39 47 39 47 39 47 39 ! emacs - - - - - - 67 4 67 4 67 4 ! h2pl - - - - 12 12 12 12 12 12 12 12 ! hints - - - - - - - - 5 42 11 56 ! msdos - - - - 41 13 57 15 58 15 60 15 ! os2 - - - - 63 22 81 29 81 29 113 31 ! usub - - - - 21 16 25 7 43 8 43 8 ! x2p 103 17 104 17 137 17 147 18 152 19 154 19 ====================================================================== ! 5.000a2 5.000a12h 5.000b3h 5.000 5.001m 5.002 5.003 ! atarist 113 31 113 31 - - - - - - - - - - bench - - 0 1 - - - - - - - - - - Bugs 2 5 26 1 - - - - - - - - - - dlperl 40 5 - - - - - - - - - - - - do 127 71 - - - - - - - - - - - - ! Configure - - 153 1 159 1 160 1 180 1 201 1 201 1 ! Doc - - 26 1 75 7 11 1 11 1 - - - - ! eg 79 58 53 44 51 43 54 44 54 44 54 44 54 44 ! emacs 67 4 104 6 104 6 104 1 104 6 108 1 108 1 ! h2pl 12 12 12 12 12 12 12 12 12 12 12 12 12 12 ! hints 11 56 12 46 18 48 18 48 44 56 73 59 77 60 ! msdos 60 15 60 15 - - - - - - - - - - ! os2 113 31 113 31 - - - - - - 84 17 56 10 ! U - - 62 8 112 42 - - - - - - - - usub 43 8 - - - - - - - - - - - - ! utils - - - - - - - - - - 87 7 88 7 ! vms - - 80 7 123 9 184 15 304 20 500 24 475 26 ! x2p 171 22 171 21 162 20 162 20 279 20 280 20 280 20 ! ! ====================================================================== ! ! 5.003_07 5.004 5.004_04 5.004_62 5.004_65 5.004_68 ! ! beos - - - - - - - - 1 1 1 1 ! Configure 217 1 225 1 225 1 240 1 248 1 256 1 ! cygwin32 - - 23 5 23 5 23 5 24 5 24 5 ! djgpp - - - - - - 14 5 14 5 14 5 ! eg 54 44 81 62 81 62 81 62 81 62 81 62 ! emacs 143 1 194 1 204 1 212 2 212 2 212 2 ! h2pl 12 12 12 12 12 12 12 12 12 12 12 12 ! hints 90 62 129 69 132 71 144 72 151 74 155 74 ! os2 117 42 121 42 127 42 127 44 129 44 129 44 ! plan9 79 15 82 15 82 15 82 15 82 15 82 15 ! Porting 51 1 94 2 109 4 203 6 234 8 241 9 ! qnx - - 1 2 1 2 1 2 1 2 1 2 ! utils 97 7 112 8 118 8 124 8 156 9 159 9 ! vms 505 27 518 34 524 34 538 34 569 34 569 34 ! win32 - - 285 33 378 36 470 39 493 39 575 41 ! x2p 280 19 281 19 281 19 281 19 282 19 281 19 ====================================================================== ! 5.004_70 5.004_73 5.004_75 5.005 ! ! beos 1 1 1 1 1 1 1 1 ! Configure 256 1 256 1 264 1 264 1 ! cygwin32 24 5 24 5 24 5 24 5 ! djgpp 14 5 14 5 14 5 14 5 ! eg 86 65 86 65 86 65 86 65 ! emacs 262 2 262 2 262 2 262 2 ! h2pl 12 12 12 12 12 12 12 12 ! hints 157 74 157 74 159 74 160 74 ! mpeix - - - - 5 3 5 3 ! os2 129 44 139 44 142 44 143 44 ! plan9 82 15 82 15 82 15 82 15 ! Porting 241 9 253 9 259 10 264 12 ! qnx 1 2 1 2 1 2 1 2 ! utils 160 9 160 9 160 9 160 9 ! vms 570 34 572 34 573 34 575 34 ! win32 577 41 585 41 585 41 587 41 ! x2p 281 19 281 19 281 19 281 19 =head2 SELECTED PATCH SIZES Index: pod/perllocale.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perllocale.pod Fri Jul 24 00:01:41 1998 --- perl5.005_02/pod/perllocale.pod Sun Aug 2 00:03:23 1998 *************** *** 169,183 **** hints on the naming of locales: not all systems name locales as in the example. ! If no second argument is provided, the function returns a string naming ! the current locale for the category. You can use this value as the ! second argument in a subsequent call to setlocale(). If a second ! argument is given and it corresponds to a valid locale, the locale for ! the category is set to that value, and the function returns the ! now-current locale value. You can then use this in yet another call to ! setlocale(). (In some implementations, the return value may sometimes ! differ from the value you gave as the second argument--think of it as ! an alias for the value you gave.) As the example shows, if the second argument is an empty string, the category's locale is returned to the default specified by the --- 169,191 ---- hints on the naming of locales: not all systems name locales as in the example. ! If no second argument is provided and the category is something else ! than LC_ALL, the function returns a string naming the current locale ! for the category. You can use this value as the second argument in a ! subsequent call to setlocale(). ! ! If no second argument is provided and the category is LC_ALL, the ! result is implementation-dependent. It may be a string of ! concatenated locales names (separator also implementation-dependent) ! or a single locale name. Please consult your L for ! details. ! ! If a second argument is given and it corresponds to a valid locale, ! the locale for the category is set to that value, and the function ! returns the now-current locale value. You can then use this in yet ! another call to setlocale(). (In some implementations, the return ! value may sometimes differ from the value you gave as the second ! argument--think of it as an alias for the value you gave.) As the example shows, if the second argument is an empty string, the category's locale is returned to the default specified by the *************** *** 210,219 **** --- 218,229 ---- and see whether they list something resembling these en_US.ISO8859-1 de_DE.ISO8859-1 ru_RU.ISO8859-5 + en_US.iso88591 de_DE.iso88591 ru_RU.iso88595 en_US de_DE ru_RU en de ru english german russian english.iso88591 german.iso88591 russian.iso88595 + english.roman8 russian.koi8r Sadly, even though the calling interface for setlocale() has been standardized, names of locales and the directories where the *************** *** 368,378 **** localeconv() takes no arguments, and returns B a hash. The keys of this hash are variable names for formatting, such as ! C and C. The values are the corresponding, ! er, values. See L for a longer example listing ! the categories an implementation might be expected to provide; some ! provide more and others fewer, however. You don't need an explicit C, because localeconv() always observes the current locale. Here's a simple-minded example program that rewrites its command-line parameters as integers correctly formatted in the current locale: --- 378,389 ---- localeconv() takes no arguments, and returns B a hash. The keys of this hash are variable names for formatting, such as ! C and C. The values are the ! corresponding, er, values. See L for a longer ! example listing the categories an implementation might be expected to ! provide; some provide more and others fewer. You don't need an ! explicit C, because localeconv() always observes the ! current locale. Here's a simple-minded example program that rewrites its command-line parameters as integers correctly formatted in the current locale: *************** *** 387,399 **** # Apply defaults if values are missing $thousands_sep = ',' unless $thousands_sep; ! $grouping = 3 unless $grouping; # Format command line params for current locale for (@ARGV) { $_ = int; # Chop non-integer part 1 while ! s/(\d)(\d{$grouping}($|$thousands_sep))/$1$thousands_sep$2/; print "$_"; } print "\n"; --- 398,426 ---- # Apply defaults if values are missing $thousands_sep = ',' unless $thousands_sep; ! ! # grouping and mon_grouping are packed lists ! # of small integers (characters) telling the ! # grouping (thousand_seps and mon_thousand_seps ! # being the group dividers) of numbers and ! # monetary quantities. The integers' meanings: ! # 255 means no more grouping, 0 means repeat ! # the previous grouping, 1-254 means use that ! # as the current grouping. Grouping goes from ! # right to left (low to high digits). In the ! # below we cheat slightly by never using anything ! # else than the first grouping (whatever that is). ! if ($grouping) { ! @grouping = unpack("C*", $grouping); ! } else { ! @grouping = (3); ! } # Format command line params for current locale for (@ARGV) { $_ = int; # Chop non-integer part 1 while ! s/(\d)(\d{$grouping[0]}($|$thousands_sep))/$1$thousands_sep$2/; print "$_"; } print "\n"; Index: pod/perlport.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlport.pod Fri Jul 24 00:01:45 1998 --- perl5.005_02/pod/perlport.pod Fri Aug 7 23:18:01 1998 *************** *** 10,32 **** features. This document is meant to help you to find out what constitutes portable ! perl code, so that once you have made your decision to write portably, you know where the lines are drawn, and you can stay within them. There is a tradeoff between taking full advantage of B particular type ! of computer, and taking advantage of a full B of them. Naturally, ! as you make your range bigger (and thus more diverse), the common denominators ! drop, and you are left with fewer areas of common ground in which ! you can operate to accomplish a particular task. Thus, when you begin ! attacking a problem, it is important to consider which part of the tradeoff ! curve you want to operate under. Specifically, whether it is important to ! you that the task that you are coding needs the full generality of being ! portable, or if it is sufficient to just get the job done. This is the ! hardest choice to be made. The rest is easy, because Perl provides lots ! of choices, whichever way you want to approach your problem. ! ! Looking at it another way, writing portable code is usually about willfully ! limiting your available choices. Naturally, it takes discipline to do that. Be aware of two important points: --- 10,34 ---- features. This document is meant to help you to find out what constitutes portable ! Perl code, so that once you have made your decision to write portably, you know where the lines are drawn, and you can stay within them. There is a tradeoff between taking full advantage of B particular type ! of computer, and taking advantage of a full B of them. Naturally, ! as you make your range bigger (and thus more diverse), the common ! denominators drop, and you are left with fewer areas of common ground in ! which you can operate to accomplish a particular task. Thus, when you ! begin attacking a problem, it is important to consider which part of the ! tradeoff curve you want to operate under. Specifically, whether it is ! important to you that the task that you are coding needs the full ! generality of being portable, or if it is sufficient to just get the job ! done. This is the hardest choice to be made. The rest is easy, because ! Perl provides lots of choices, whichever way you want to approach your ! problem. ! ! Looking at it another way, writing portable code is usually about ! willfully limiting your available choices. Naturally, it takes discipline ! to do that. Be aware of two important points: *************** *** 59,76 **** often the case with systems programming (whether for Unix, Windows, S, VMS, etc.), consider writing platform-specific code. ! When the code will run on only two or three operating systems, then you may ! only need to consider the differences of those particular systems. The ! important thing is to decide where the code will run, and to be deliberate ! in your decision. This information should not be considered complete; it includes possibly ! transient information about idiosyncracies of some of the ports, almost all of which are in a state of constant evolution. Thus this material should be considered a perpetual work in progress (EIMG SRC="yellow_sign.gif" ALT="Under Construction"E). =head1 ISSUES =head2 Newlines --- 61,85 ---- often the case with systems programming (whether for Unix, Windows, S, VMS, etc.), consider writing platform-specific code. ! When the code will run on only two or three operating systems, then you ! may only need to consider the differences of those particular systems. ! The important thing is to decide where the code will run, and to be ! deliberate in your decision. ! ! The material below is separated into three main sections: main issues of ! portability (L<"ISSUES">, platform-specific issues (L<"PLATFORMS">, and ! builtin perl functions that behave differently on various ports ! (L<"FUNCTION IMPLEMENTATIONS">. This information should not be considered complete; it includes possibly ! transient information about idiosyncrasies of some of the ports, almost all of which are in a state of constant evolution. Thus this material should be considered a perpetual work in progress (EIMG SRC="yellow_sign.gif" ALT="Under Construction"E). + + =head1 ISSUES =head2 Newlines *************** *** 97,103 **** with arbitrary values quite safely. A common misconception in socket programming is that C<\n> eq C<\012> ! everywhere. When using protocols, such as common Internet protocols, C<\012> and C<\015> are called for specifically, and the values of the logical C<\n> and C<\r> (carriage return) are not reliable. --- 106,112 ---- with arbitrary values quite safely. A common misconception in socket programming is that C<\n> eq C<\012> ! everywhere. When using protocols such as common Internet protocols, C<\012> and C<\015> are called for specifically, and the values of the logical C<\n> and C<\r> (carriage return) are not reliable. *************** *** 110,118 **** which translates those characters, along with all other characters in text streams, from EBCDIC to ASCII.] ! However, C<\015\012> (or C<\cM\cJ>, or C<\x0D\x0A>) can be tedious and ! unsightly, as well as confusing to those maintaining the code. As such, ! the C module supplies the Right Thing for those who want it. use Socket qw(:DEFAULT :crlf); print SOCKET "Hi there, client!$CRLF" # RIGHT --- 119,127 ---- which translates those characters, along with all other characters in text streams, from EBCDIC to ASCII.] ! However, using C<\015\012> (or C<\cM\cJ>, or C<\x0D\x0A>) can be tedious ! and unsightly, as well as confusing to those maintaining the code. As ! such, the C module supplies the Right Thing for those who want it. use Socket qw(:DEFAULT :crlf); print SOCKET "Hi there, client!$CRLF" # RIGHT *************** *** 140,146 **** (and there was much rejoicing). ! =head2 File Paths Most platforms these days structure files in a hierarchical fashion. So, it is reasonably safe to assume that any platform supports the --- 149,181 ---- (and there was much rejoicing). ! =head2 Numbers endianness and Width ! ! Different CPUs store integers and floating point numbers in different ! orders (called I) and widths (32-bit and 64-bit being the ! most common). This affects your programs if they attempt to transfer ! numbers in binary format from a CPU architecture to another over some ! channel: either 'live' via network connections or storing the numbers ! to secondary storage such as a disk file. ! ! Conflicting storage orders make utter mess out of the numbers: if a ! little-endian host (Intel, Alpha) stores 0x12345678 (305419896 in ! decimal), a big-endian host (Motorola, MIPS, Sparc, PA) reads it as ! 0x78563412 (2018915346 in decimal). To avoid this problem in network ! (socket) connections use the C and C formats C<"n"> ! and C<"N">, the "network" orders, they are guaranteed to be portable. ! ! Different widths can cause truncation even between platforms of equal ! endianness: the platform of shorter width loses the upper parts of the ! number. There is no good solution for this problem except to avoid ! transferring or storing raw binary numbers. ! ! One can circumnavigate both these problems in two ways: either ! transfer and store numbers always in text format, instead of raw ! binary, or consider using modules like C (included in ! the standard distribution as of Perl 5.005) and C. ! ! =head2 Files Most platforms these days structure files in a hierarchical fashion. So, it is reasonably safe to assume that any platform supports the *************** *** 148,158 **** how that path is actually written, differs. While they are similar, file path specifications differ between Unix, ! Windows, S, OS/2, VMS and probably others. Unix, for example, is ! one of the few OSes that has the idea of a root directory. S ! uses C<:> as a path separator instead of C. VMS, Windows, and OS/2 ! can work similarly to Unix with C as path separator, or in their own ! idiosyncratic ways. As with the newline problem above, there are modules that can help. The C modules provide methods to do the Right Thing on whatever --- 183,202 ---- how that path is actually written, differs. While they are similar, file path specifications differ between Unix, ! Windows, S, OS/2, VMS, S and probably others. Unix, ! for example, is one of the few OSes that has the idea of a single root ! directory. ! ! VMS, Windows, and OS/2 can work similarly to Unix with C as path ! separator, or in their own idiosyncratic ways (such as having several ! root directories and various "unrooted" device files such NIL: and ! LPT:). ! ! S uses C<:> as a path separator instead of C. ! ! C perl can emulate Unix filenames with C as path ! separator, or go native and use C<.> for path separator and C<:> to ! signal filing systems and disc names. As with the newline problem above, there are modules that can help. The C modules provide methods to do the Right Thing on whatever *************** *** 180,189 **** splits a pathname into pieces (base filename, full path to directory, and file suffix). ! Remember not to count on the existence of system-specific files, like ! F. If code does need to rely on such a file, include a ! description of the file and its format in the code's documentation, and ! make it easy for the user to override the default location of the file. =head2 System Interaction --- 224,255 ---- splits a pathname into pieces (base filename, full path to directory, and file suffix). ! Even when on a single platform (if you can call UNIX a single ! platform), remember not to count on the existence or the contents of ! system-specific files, like F, F, or ! F. For example the F may exist but it ! may not contain the encrypted passwords because the system is using ! some form of enhanced security-- or it may not contain all the ! accounts because the system is using NIS. If code does need to rely ! on such a file, include a description of the file and its format in ! the code's documentation, and make it easy for the user to override ! the default location of the file. ! ! Do not have two files of the same name with different case, like ! F and , as many platforms have case-insensitive ! filenames. Also, try not to have non-word characters (except for C<.>) ! in the names, and keep them to the 8.3 convention, for maximum ! portability. ! ! Likewise, if using C, try to keep the split functions to ! 8.3 naming and case-insensitive conventions; or, at the very least, ! make it so the resulting files have a unique (case-insensitively) ! first 8 characters. ! ! Don't assume C> won't be the first character of a filename. Always ! use C> explicitly to open a file for reading: ! ! open(FILE, "<$existing_file") or die $!; =head2 System Interaction *************** *** 199,219 **** Don't C or C an open file. Don't C to or C a file that is already tied to or opened; C or C first. Don't count on a specific environment variable existing in C<%ENV>. ! Don't even count on C<%ENV> entries being case-sensitive, or even case-preserving. ! Don't count on signals in portable programs. Don't count on filename globbing. Use C, C, and C instead. =head2 Interprocess Communication (IPC) In general, don't directly access the system in code that is meant to be ! portable. That means, no: C, C, C, C, C<``>, ! C, C with a C<|>, or any of the other things that makes being a Unix perl hacker worth being. Commands that launch external processes are generally supported on --- 265,291 ---- Don't C or C an open file. Don't C to or C a file that is already tied to or opened; C or C first. + Don't open the same file more than once at a time for writing, as some + operating systems put mandatory locks on such files. + Don't count on a specific environment variable existing in C<%ENV>. ! Don't count on C<%ENV> entries being case-sensitive, or even case-preserving. ! Don't count on signals. Don't count on filename globbing. Use C, C, and C instead. + Don't count on per-program environment variables, or per-program current + directories. + =head2 Interprocess Communication (IPC) In general, don't directly access the system in code that is meant to be ! portable. That means, no C, C, C, C, C<``>, ! C, C with a C<|>, nor any of the other things that makes being a Unix perl hacker worth being. Commands that launch external processes are generally supported on *************** *** 238,247 **** (via C) if a mail transfer agent is not available. The rule of thumb for portable code is: Do it all in portable Perl, or ! use a module that may internally implement it with platform-specific code, ! but expose a common interface. By portable Perl, we mean code that ! avoids the constructs described in this document as being non-portable. =head2 External Subroutines (XS) --- 310,320 ---- (via C) if a mail transfer agent is not available. The rule of thumb for portable code is: Do it all in portable Perl, or ! use a module (that may internally implement it with platform-specific ! code, but expose a common interface). + The UNIX System V IPC (C) is not available + even in all UNIX platforms. =head2 External Subroutines (XS) *************** *** 252,259 **** normally reasonable to make sure the XS code is portable, too. There is a different kind of portability issue with writing XS ! code: availability of a C compiler on the end-user's system. C brings with ! it its own portability issues, and writing XS code will expose you to some of those. Writing purely in perl is a comparatively easier way to achieve portability. --- 325,332 ---- normally reasonable to make sure the XS code is portable, too. There is a different kind of portability issue with writing XS ! code: availability of a C compiler on the end-user's system. C brings ! with it its own portability issues, and writing XS code will expose you to some of those. Writing purely in perl is a comparatively easier way to achieve portability. *************** *** 267,273 **** There is no one DBM module that is available on all platforms. C and the others are generally available on all Unix and DOSish ! ports, but not in MacPerl, where C and C are available. The good news is that at least some DBM module should be available, and C will use whichever module it can find. Of course, then --- 340,347 ---- There is no one DBM module that is available on all platforms. C and the others are generally available on all Unix and DOSish ! ports, but not in MacPerl, where only C and C are ! available. The good news is that at least some DBM module should be available, and C will use whichever module it can find. Of course, then *************** *** 277,300 **** =head2 Time and Date ! The system's notion of time of day and calendar date is controlled in widely ! different ways. Don't assume the timezone is stored in C<$ENV{TZ}>, and even ! if it is, don't assume that you can control the timezone through that ! variable. ! ! Don't assume that the epoch starts at January 1, 1970, because that is ! OS-specific. Better to store a date in an unambiguous representation. ! A text representation (like C<1 Jan 1970>) can be easily converted into an ! OS-specific value using a module like C. An array of values, ! such as those returned by C, can be converted to an OS-specific ! representation using C. =head2 System Resources ! If your code is destined for systems with severely constrained (or missing!) ! virtual memory systems then you want to be especially mindful of avoiding ! wasteful constructs such as: # NOTE: this is no longer "bad" in perl5.005 for (0..10000000) {} # bad --- 351,399 ---- =head2 Time and Date ! The system's notion of time of day and calendar date is controlled in ! widely different ways. Don't assume the timezone is stored in C<$ENV{TZ}>, ! and even if it is, don't assume that you can control the timezone through ! that variable. ! ! Don't assume that the epoch starts at 00:00:00, January 1, 1970, ! because that is OS-specific. Better to store a date in an unambiguous ! representation. The ISO 8601 standard defines YYYY-MM-DD as the date ! format. A text representation (like C<1 Jan 1970>) can be easily ! converted into an OS-specific value using a module like ! C. An array of values, such as those returned by ! C, can be converted to an OS-specific representation using ! C. ! ! ! =head2 Character sets and character encoding ! ! Assume very little about character sets. Do not assume anything about ! the numerical values (C, C) of characters. Do not ! assume that the alphabetic characters are encoded contiguously (in ! numerical sense). Do no assume anything about the ordering of the ! characters. The lowercase letters may come before or after the ! uppercase letters, the lowercase and uppercase may be interlaced so ! that both 'a' and 'A' come before the 'b', the accented and other ! international characters may be interlaced so that E comes ! before the 'b'. ! ! ! =head2 Internationalisation ! ! If you may assume POSIX (a rather large assumption, that: in practise ! that means UNIX) you may read more about the POSIX locale system from ! L. The locale system at least attempts to make things a ! little bit more portable or at least more convenient and ! native-friendly for non-English users. The system affects character ! sets and encoding, and date and time formatting, among other things. =head2 System Resources ! If your code is destined for systems with severely constrained (or ! missing!) virtual memory systems then you want to be I mindful ! of avoiding wasteful constructs such as: # NOTE: this is no longer "bad" in perl5.005 for (0..10000000) {} # bad *************** *** 303,343 **** @lines = ; # bad while () {$file .= $_} # sometimes bad ! $file = join '', ; # better The last two may appear unintuitive to most people. The first of those two constructs repeatedly grows a string, while the second allocates a large chunk of memory in one go. On some systems, the latter is more efficient that the former. =head2 Security ! Most Unix platforms provide basic levels of security that is usually felt ! at the file-system level. Other platforms usually don't (unfortunately). ! Thus the notion of User-ID, or "home" directory, or even the state of ! being logged-in may be unrecognizable on may platforms. If you write ! programs that are security conscious, it is usually best to know what ! type of system you will be operating under, and write code explicitly for that platform (or class of platforms). =head2 Style For those times when it is necessary to have platform-specific code, consider keeping the platform-specific code in one place, making porting to other platforms easier. Use the C module and the special ! variable C<$^O> to differentiate platforms, as described in L<"PLATFORMS">. ! =head1 CPAN TESTERS ! Module uploaded to CPAN are tested by a variety of volunteers on ! different platforms. These CPAN testers are notified by e-mail of each new upload, and reply to the list with PASS, FAIL, NA (not applicable to ! this platform), or ???? (unknown), along with any relevant notations. The purpose of the testing is twofold: one, to help developers fix any ! problems in their code; two, to provide users with information about ! whether or not a given module works on a given platform. =over 4 --- 402,446 ---- @lines = ; # bad while () {$file .= $_} # sometimes bad ! $file = join('', ); # better The last two may appear unintuitive to most people. The first of those two constructs repeatedly grows a string, while the second allocates a large chunk of memory in one go. On some systems, the latter is more efficient that the former. + =head2 Security ! Most multi-user platforms provide basic levels of security that is usually ! felt at the file-system level. Other platforms usually don't ! (unfortunately). Thus the notion of user id, or "home" directory, or even ! the state of being logged-in, may be unrecognizable on many platforms. If ! you write programs that are security conscious, it is usually best to know ! what type of system you will be operating under, and write code explicitly for that platform (or class of platforms). + =head2 Style For those times when it is necessary to have platform-specific code, consider keeping the platform-specific code in one place, making porting to other platforms easier. Use the C module and the special ! variable C<$^O> to differentiate platforms, as described in ! L<"PLATFORMS">. ! =head1 CPAN Testers ! Modules uploaded to CPAN are tested by a variety of volunteers on ! different platforms. These CPAN testers are notified by mail of each new upload, and reply to the list with PASS, FAIL, NA (not applicable to ! this platform), or UNKNOWN (unknown), along with any relevant notations. The purpose of the testing is twofold: one, to help developers fix any ! problems in their code that crop up because of lack of testing on other ! platforms; two, to provide users with information about whether or not ! a given module works on a given platform. =over 4 *************** *** 363,385 **** e.g. most of the files in the F directory in the source code kit). On most of these systems, the value of C<$^O> (hence C<$Config{'osname'}>, too) is determined by lowercasing and stripping punctuation from the first ! field of the string returned by typing ! ! % uname -a ! ! (or a similar command) at the shell prompt. Here, for example, are a few ! of the more popular Unix flavors: ! ! uname $^O ! -------------------- ! AIX aix ! FreeBSD freebsd ! Linux linux ! HP-UX hpux ! OSF1 dec_osf ! SunOS solaris ! SunOS4 sunos =head2 DOS and Derivatives --- 466,489 ---- e.g. most of the files in the F directory in the source code kit). On most of these systems, the value of C<$^O> (hence C<$Config{'osname'}>, too) is determined by lowercasing and stripping punctuation from the first ! field of the string returned by typing C (or a similar command) ! at the shell prompt. Here, for example, are a few of the more popular ! Unix flavors: ! ! uname $^O $Config{'archname'} ! ------------------------------------------- ! AIX aix aix ! FreeBSD freebsd freebsd-i386 ! Linux linux i386-linux ! HP-UX hpux PA-RISC1.1 ! IRIX irix irix ! OSF1 dec_osf alpha-dec_osf ! SunOS solaris sun4-solaris ! SunOS solaris i86pc-solaris ! SunOS4 sunos sun4-sunos + Note that because the C<$Config{'archname'}> may depend on the hardware + architecture it may vary quite a lot, much more than the C<$^O>. =head2 DOS and Derivatives *************** *** 402,410 **** probably better, as it is more consistent with popular usage, and avoids the problem of remembering what to backwhack and what not to. ! The DOS FAT file system can only accomodate "8.3" style filenames. Under the "case insensitive, but case preserving" HPFS (OS/2) and NTFS (NT) ! file systems you may have to be careful about case returned with functions like C or used with functions like C or C. DOS also treats several filenames as special, such as AUX, PRN, NUL, CON, --- 506,514 ---- probably better, as it is more consistent with popular usage, and avoids the problem of remembering what to backwhack and what not to. ! The DOS FAT filesystem can only accommodate "8.3" style filenames. Under the "case insensitive, but case preserving" HPFS (OS/2) and NTFS (NT) ! filesystems you may have to be careful about case returned with functions like C or used with functions like C or C. DOS also treats several filenames as special, such as AUX, PRN, NUL, CON, *************** *** 452,463 **** =back ! =head2 MacPerl Any module requiring XS compilation is right out for most people, because MacPerl is built using non-free (and non-cheap!) compilers. Some XS modules that can work with MacPerl are built and distributed in binary ! form on CPAN. See I for more details. Directories are specified as: --- 556,568 ---- =back ! =head2 S Any module requiring XS compilation is right out for most people, because MacPerl is built using non-free (and non-cheap!) compilers. Some XS modules that can work with MacPerl are built and distributed in binary ! form on CPAN. See I and L<"CPAN Testers"> ! for more details. Directories are specified as: *************** *** 472,479 **** limited to 31 characters, and may include any character except C<:>, which is reserved as a path separator. ! Instead of C, see C and C in ! C. In the MacPerl application, you can't run a program from the command line; programs that expect C<@ARGV> to be populated can be edited with something --- 577,584 ---- limited to 31 characters, and may include any character except C<:>, which is reserved as a path separator. ! Instead of C, see C and C in the ! C module. In the MacPerl application, you can't run a program from the command line; programs that expect C<@ARGV> to be populated can be edited with something *************** *** 495,501 **** perl myscript.plx some arguments ToolServer is another app from Apple that provides access to MPW tools ! from MPW and the MacPerl app, which allows MacPerl program to use C, backticks, and piped C. "S" is the proper name for the operating system, but the value --- 600,606 ---- perl myscript.plx some arguments ToolServer is another app from Apple that provides access to MPW tools ! from MPW and the MacPerl app, which allows MacPerl programs to use C, backticks, and piped C. "S" is the proper name for the operating system, but the value *************** *** 508,513 **** --- 613,622 ---- $is_ppc = $MacPerl::Architecture eq 'MacPPC'; $is_68k = $MacPerl::Architecture eq 'Mac68K'; + S, to be based on NeXT's OpenStep OS, will be able to run + MacPerl natively (in the Blue Box, and even in the Yellow Box, once some + changes to the toolbox calls are made), but Unix perl will also run + natively. Also see: *************** *** 523,529 **** =head2 VMS Perl on VMS is discussed in F in the perl distribution. ! Note that perl on VMS can accept either VMS or Unix style file specifications as in either of the following: $ perl -ne "print if /perl_setup/i" SYS$LOGIN:LOGIN.COM --- 632,638 ---- =head2 VMS Perl on VMS is discussed in F in the perl distribution. ! Note that perl on VMS can accept either VMS- or Unix-style file specifications as in either of the following: $ perl -ne "print if /perl_setup/i" SYS$LOGIN:LOGIN.COM *************** *** 566,585 **** VMS' RMS filesystem is case insensitive and does not preserve case. C returns lowercased filenames, but specifying a file for ! opening remains case insensitive. Files without extensions have a trailing period on them, so doing a C with a file named F ! will return F (though that file could be opened with C. ! RMS has an eight level limit on directory depths from any rooted logical ! (allowing 16 levels overall). Hence C ! is a valid directory specification but C ! is not. F authors might have to take this into account, but ! at least they can refer to the former as C. ! ! The C module, which gets installed as part ! of the build process on VMS, is a pure Perl module that can easily be ! installed on non-VMS platforms and can be helpful for conversions to ! and from RMS native formats. What C<\n> represents depends on the type of file that is open. It could be C<\015>, C<\012>, C<\015\012>, or nothing. Reading from a file --- 675,696 ---- VMS' RMS filesystem is case insensitive and does not preserve case. C returns lowercased filenames, but specifying a file for ! opening remains case insensitive. Files without extensions have a trailing period on them, so doing a C with a file named F ! will return F (though that file could be opened with ! C). ! RMS had an eight level limit on directory depths from any rooted logical ! (allowing 16 levels overall) prior to VMS 7.2. Hence ! C is a valid directory specification but ! C is not. F authors might ! have to take this into account, but at least they can refer to the former ! as C. ! ! The C module, which gets installed as part of the build ! process on VMS, is a pure Perl module that can easily be installed on ! non-VMS platforms and can be helpful for conversions to and from RMS ! native formats. What C<\n> represents depends on the type of file that is open. It could be C<\015>, C<\012>, C<\015\012>, or nothing. Reading from a file *************** *** 637,651 **** print "Hello from perl!\n"; On these platforms, bear in mind that the EBCDIC character set may have ! an effect on what happens with perl functions such as C, C, ! C, C, C, C, C, C; as well as ! bit-fiddling with ASCII constants using operators like C<^>, C<&> and ! C<|>; not to mention dealing with socket interfaces to ASCII computers (see L<"NEWLINES">). Fortunately, most web servers for the mainframe will correctly translate the C<\n> in the following statement to its ASCII equivalent (note that ! C<\r> is the same under both ASCII and EBCDIC): print "Content-type: text/html\r\n\r\n"; --- 748,762 ---- print "Hello from perl!\n"; On these platforms, bear in mind that the EBCDIC character set may have ! an effect on what happens with some perl functions (such as C, ! C, C, C, C, C, C, C), as ! well as bit-fiddling with ASCII constants using operators like C<^>, C<&> ! and C<|>, not to mention dealing with socket interfaces to ASCII computers (see L<"NEWLINES">). Fortunately, most web servers for the mainframe will correctly translate the C<\n> in the following statement to its ASCII equivalent (note that ! C<\r> is the same under both Unix and OS/390): print "Content-type: text/html\r\n\r\n"; *************** *** 661,669 **** if (chr(169) eq 'z') { print "EBCDIC may be spoken here!\n"; } Note that one thing you may not want to rely on is the EBCDIC encoding ! of punctuation characters since these may differ from code page to code page ! (and once your module or script is rumoured to work with EBCDIC, folks will ! want it to work with all EBCDIC character sets). Also see: --- 772,780 ---- if (chr(169) eq 'z') { print "EBCDIC may be spoken here!\n"; } Note that one thing you may not want to rely on is the EBCDIC encoding ! of punctuation characters since these may differ from code page to code ! page (and once your module or script is rumoured to work with EBCDIC, ! folks will want it to work with all EBCDIC character sets). Also see: *************** *** 675,693 **** general usage issues for all EBCDIC Perls. Send a message body of "subscribe perl-mvs" to majordomo@perl.org. ! =item AS/400 Perl information at C =back =head2 Other perls Perl has been ported to a variety of platforms that do not fit into any of the above categories. Some, such as AmigaOS, BeOS, QNX, and Plan 9, have ! been well integrated into the standard Perl source code kit. You may need to see the F directory on CPAN for information, and possibly ! binaries, for the likes of: acorn, aos, atari, lynxos, HP-MPE/iX, riscos, ! Tandem Guardian, vos, I (yes we know that some of these OSes may fall ! under the Unix category but we are not a standards body.) See also: --- 786,916 ---- general usage issues for all EBCDIC Perls. Send a message body of "subscribe perl-mvs" to majordomo@perl.org. ! =item AS/400 Perl information at C =back + + =head2 Acorn RISC OS + + As Acorns use ASCII with newlines (C<\n>) in text files as C<\012> like + Unix and Unix filename emulation is turned on by default, it is quite + likely that most simple scripts will work "out of the box". The native + filing system is modular, and individual filing systems are free to be + case-sensitive or insensitive, and are usually case-preserving. Some + native filing systems have name length limits which file and directory + names are silently truncated to fit - scripts should be aware that the + standard disc filing system currently has a name length limit of B<10> + characters, with up to 77 items in a directory, but other filing systems + may not impose such limitations. + + Native filenames are of the form + + Filesystem#Special_Field::DiscName.$.Directory.Directory.File + + where + + Special_Field is not usually present, but may contain . and $ . + Filesystem =~ m|[A-Za-z0-9_]| + DsicName =~ m|[A-Za-z0-9_/]| + $ represents the root directory + . is the path separator + @ is the current directory (per filesystem but machine global) + ^ is the parent directory + Directory and File =~ m|[^\0- "\.\$\%\&:\@\\^\|\177]+| + + The default filename translation is roughly C + + Note that C<"ADFS::HardDisc.$.File" ne 'ADFS::HardDisc.$.File'> and that + the second stage of C<$> interpolation in regular expressions will fall + foul of the C<$.> if scripts are not careful. + + Logical paths specified by system variables containing comma-separated + search lists are also allowed, hence C is a valid + filename, and the filesystem will prefix C with each section of + C until a name is made that points to an object on disc. + Writing to a new file C would only be allowed if + C contains a single item list. The filesystem will also + expand system variables in filenames if enclosed in angle brackets, so + CSystem$DirE.Modules> would look for the file + S>. The obvious implication of this is + that BE> and should + be protected when C is used for input. + + Because C<.> was in use as a directory separator and filenames could not + be assumed to be unique after 10 characters, Acorn implemented the C + compiler to strip the trailing C<.c> C<.h> C<.s> and C<.o> suffix from + filenames specified in source code and store the respective files in + subdirectories named after the suffix. Hence files are translated: + + foo.h h.foo + C:foo.h C:h.foo (logical path variable) + sys/os.h sys.h.os (C compiler groks Unix-speak) + 10charname.c c.10charname + 10charname.o o.10charname + 11charname_.c c.11charname (assuming filesystem truncates at 10) + + The Unix emulation library's translation of filenames to native assumes + that this sort of translation is required, and allows a user defined list + of known suffixes which it will transpose in this fashion. This may + appear transparent, but consider that with these rules C + and C both map to C, and that C and + C cannot and do not attempt to emulate the reverse mapping. Other + C<.>s in filenames are translated to C. + + As implied above the environment accessed through C<%ENV> is global, and + the convention is that program specific environment variables are of the + form C. Each filing system maintains a current directory, + and the current filing system's current directory is the B current + directory. Consequently, sociable scripts don't change the current + directory but rely on full pathnames, and scripts (and Makefiles) cannot + assume that they can spawn a child process which can change the current + directory without affecting its parent (and everyone else for that + matter). + + As native operating system filehandles are global and currently are + allocated down from 255, with 0 being a reserved value the Unix emulation + library emulates Unix filehandles. Consequently, you can't rely on + passing C, C, or C to your children. + + The desire of users to express filenames of the form + CFoo$DirE.Bar> on the command line unquoted causes problems, + too: C<``> command output capture has to perform a guessing game. It + assumes that a string C[^EE]+\$[^EE]E> is a + reference to an environment variable, whereas anything else involving + C> or C> is redirection, and generally manages to be 99% + right. Of course, the problem remains that scripts cannot rely on any + Unix tools being available, or that any tools found have Unix-like command + line arguments. + + Extensions and XS are, in theory, buildable by anyone using free tools. + In practice, many don't, as users of the Acorn platform are used to binary + distribution. MakeMaker does run, but no available make currently copes + with MakeMaker's makefiles; even if/when this is fixed, the lack of a + Unix-like shell can cause problems with makefile rules, especially lines + of the form C, and anything using quoting. + + "S" is the proper name for the operating system, but the value + in C<$^O> is "riscos" (because we don't like shouting). + + Also see: + + =over 4 + + =item perl list + + =back + + =head2 Other perls Perl has been ported to a variety of platforms that do not fit into any of the above categories. Some, such as AmigaOS, BeOS, QNX, and Plan 9, have ! been well-integrated into the standard Perl source code kit. You may need to see the F directory on CPAN for information, and possibly ! binaries, for the likes of: aos, atari, lynxos, riscos, Tandem Guardian, ! vos, I (yes we know that some of these OSes may fall under the Unix ! category, but we are not a standards body.) See also: *************** *** 699,705 **** =item Novell Netware ! A free Perl 5 based PERL.NLM for Novell Netware is available from C =back --- 922,928 ---- =item Novell Netware ! A free perl5-based PERL.NLM for Novell Netware is available from C =back *************** *** 715,728 **** doubt, consult the platform-specific README files in the Perl source distribution, and other documentation resources for a given port. ! Be aware, moreover, that even among Unix-ish systems there are variations, ! and not all functions listed here are necessarily available, though ! most usually are. For many functions, you can also query C<%Config>, exported by default from C. For example, to check if the platform has the C ! call, check C<$Config{'d_lstat'}>. See L for a full description ! of available variables. =head2 Alphabetical Listing of Perl Functions --- 938,949 ---- doubt, consult the platform-specific README files in the Perl source distribution, and other documentation resources for a given port. ! Be aware, moreover, that even among Unix-ish systems there are variations. For many functions, you can also query C<%Config>, exported by default from C. For example, to check if the platform has the C ! call, check C<$Config{'d_lstat'}>. See L for a full ! description of available variables. =head2 Alphabetical Listing of Perl Functions *************** *** 742,769 **** C<-r>, C<-w>, C<-x>, and C<-o> tell whether or not file is accessible, which may not reflect UIC-based file protections. (VMS) C<-R>, C<-W>, C<-X>, C<-O> are indistinguishable from C<-r>, C<-w>, ! C<-x>, C<-o>. (S, Win32, VMS) C<-b>, C<-c>, C<-k>, C<-g>, C<-p>, C<-u>, C<-A> are not implemented. (S) C<-g>, C<-k>, C<-l>, C<-p>, C<-u>, C<-A> are not particularly meaningful. ! (Win32, VMS) C<-d> is true if passed a device spec without an explicit directory. (VMS) C<-T> and C<-B> are implemented, but might misclassify Mac text files ! with foreign characters; this is the case will all platforms, but ! affects S a lot. (S) C<-x> (or C<-X>) determine if a file ends in one of the executable suffixes. C<-S> is meaningless. (Win32) =item binmode FILEHANDLE ! Meaningless. (S) Reopens file and restores pointer; if function fails, underlying filehandle may be closed, or pointer may be in a different position. --- 963,1000 ---- C<-r>, C<-w>, C<-x>, and C<-o> tell whether or not file is accessible, which may not reflect UIC-based file protections. (VMS) + C<-s> returns the size of the data fork, not the total size of data fork + plus resource fork. (S). + + C<-s> by name on an open file will return the space reserved on disk, + rather than the current extent. C<-s> on an open filehandle returns the + current size. (S) + C<-R>, C<-W>, C<-X>, C<-O> are indistinguishable from C<-r>, C<-w>, ! C<-x>, C<-o>. (S, Win32, VMS, S) C<-b>, C<-c>, C<-k>, C<-g>, C<-p>, C<-u>, C<-A> are not implemented. (S) C<-g>, C<-k>, C<-l>, C<-p>, C<-u>, C<-A> are not particularly meaningful. ! (Win32, VMS, S) C<-d> is true if passed a device spec without an explicit directory. (VMS) C<-T> and C<-B> are implemented, but might misclassify Mac text files ! with foreign characters; this is the case will all platforms, but may ! affect S often. (S) C<-x> (or C<-X>) determine if a file ends in one of the executable suffixes. C<-S> is meaningless. (Win32) + C<-x> (or C<-X>) determine if a file has an executable file type. + (S) + =item binmode FILEHANDLE ! Meaningless. (S, S) Reopens file and restores pointer; if function fails, underlying filehandle may be closed, or pointer may be in a different position. *************** *** 780,788 **** Only good for changing "owner" read-write access, "group", and "other" bits are meaningless. (Win32) =item chown LIST ! Not implemented. (S, Win32, Plan9) Does nothing, but won't fail. (Win32) --- 1011,1021 ---- Only good for changing "owner" read-write access, "group", and "other" bits are meaningless. (Win32) + Only good for changing "owner" and "other" read-write access. (S) + =item chown LIST ! Not implemented. (S, Win32, Plan9, S) Does nothing, but won't fail. (Win32) *************** *** 790,801 **** =item chroot ! Not implemented. (S, Win32, VMS, Plan9) =item crypt PLAINTEXT,SALT May not be available if library or source was not provided when building ! perl. (Win32) =item dbmclose HASH --- 1023,1034 ---- =item chroot ! Not implemented. (S, Win32, VMS, Plan9, S) =item crypt PLAINTEXT,SALT May not be available if library or source was not provided when building ! perl. (Win32) =item dbmclose HASH *************** *** 807,817 **** =item dump LABEL ! Not useful. (S) Not implemented. (Win32) ! Invokes VMS debugger. (VMS) =item exec LIST --- 1040,1050 ---- =item dump LABEL ! Not useful. (S, S) Not implemented. (Win32) ! Invokes VMS debugger. (VMS) =item exec LIST *************** *** 823,859 **** =item flock FILEHANDLE,OPERATION ! Not implemented (S, VMS). Available only on Windows NT (not on Windows 95). (Win32) =item fork ! Not implemented. (S, Win32, AmigaOS) =item getlogin ! Not implemented. (S) =item getpgrp PID ! Not implemented. (S, Win32, VMS) =item getppid ! Not implemented. (S, Win32, VMS) =item getpriority WHICH,WHO ! Not implemented. (S, Win32, VMS) =item getpwnam NAME Not implemented. (S, Win32) =item getgrnam NAME ! Not implemented. (S, Win32, VMS) =item getnetbyname NAME --- 1056,1094 ---- =item flock FILEHANDLE,OPERATION ! Not implemented (S, VMS, S). Available only on Windows NT (not on Windows 95). (Win32) =item fork ! Not implemented. (S, Win32, AmigaOS, S) =item getlogin ! Not implemented. (S, S) =item getpgrp PID ! Not implemented. (S, Win32, VMS, S) =item getppid ! Not implemented. (S, Win32, VMS, S) =item getpriority WHICH,WHO ! Not implemented. (S, Win32, VMS, S) =item getpwnam NAME Not implemented. (S, Win32) + Not useful. (S) + =item getgrnam NAME ! Not implemented. (S, Win32, VMS, S) =item getnetbyname NAME *************** *** 863,871 **** Not implemented. (S, Win32) =item getgrgid GID ! Not implemented. (S, Win32, VMS) =item getnetbyaddr ADDR,ADDRTYPE --- 1098,1108 ---- Not implemented. (S, Win32) + Not useful. (S) + =item getgrgid GID ! Not implemented. (S, Win32, VMS, S) =item getnetbyaddr ADDR,ADDRTYPE *************** *** 905,931 **** =item setpwent ! Not implemented. (S, Win32) =item setgrent ! Not implemented. (S, Win32, VMS) =item sethostent STAYOPEN ! Not implemented. (S, Win32, Plan9) =item setnetent STAYOPEN ! Not implemented. (S, Win32, Plan9) =item setprotoent STAYOPEN ! Not implemented. (S, Win32, Plan9) =item setservent STAYOPEN ! Not implemented. (Plan9, Win32) =item endpwent --- 1142,1168 ---- =item setpwent ! Not implemented. (S, Win32, S) =item setgrent ! Not implemented. (S, Win32, VMS, S) =item sethostent STAYOPEN ! Not implemented. (S, Win32, Plan9, S) =item setnetent STAYOPEN ! Not implemented. (S, Win32, Plan9, S) =item setprotoent STAYOPEN ! Not implemented. (S, Win32, Plan9, S) =item setservent STAYOPEN ! Not implemented. (Plan9, Win32, S) =item endpwent *************** *** 933,939 **** =item endgrent ! Not implemented. (S, Win32, VMS) =item endhostent --- 1170,1176 ---- =item endgrent ! Not implemented. (S, Win32, VMS, S) =item endhostent *************** *** 962,969 **** Globbing built-in, but only C<*> and C metacharacters are supported. (S) ! Features depend on external perlglob.exe or perlglob.bat. May be overridden ! with something like File::DosGlob, which is recommended. (Win32) =item ioctl FILEHANDLE,FUNCTION,SCALAR --- 1199,1212 ---- Globbing built-in, but only C<*> and C metacharacters are supported. (S) ! Features depend on external perlglob.exe or perlglob.bat. May be ! overridden with something like File::DosGlob, which is recommended. ! (Win32) ! ! Globbing built-in, but only C<*> and C metacharacters are supported. ! Globbing relies on operating system calls, which may return filenames ! in any order. As most filesystems are case-insensitive, even "sorted" ! filenames will not be in case-sensitive order. (S) =item ioctl FILEHANDLE,FUNCTION,SCALAR *************** *** 972,987 **** Available only for socket handles, and it does what the ioctlsocket() call in the Winsock API does. (Win32) =item kill LIST ! Not implemented. (S) ! Available only for process handles returned by the C method of ! spawning a process. (Win32) =item link OLDFILE,NEWFILE ! Not implemented. (S, Win32, VMS) =item lstat FILEHANDLE --- 1215,1233 ---- Available only for socket handles, and it does what the ioctlsocket() call in the Winsock API does. (Win32) + Available only for socket handles. (S) + =item kill LIST ! Not implemented, hence not useful for taint checking. (S, ! S) ! Available only for process handles returned by the C ! method of spawning a process. (Win32) =item link OLDFILE,NEWFILE ! Not implemented. (S, Win32, VMS, S) =item lstat FILEHANDLE *************** *** 989,997 **** =item lstat ! Not implemented. (VMS) ! Return values may be bogus. (Win32) =item msgctl ID,CMD,ARG --- 1235,1243 ---- =item lstat ! Not implemented. (VMS, S) ! Return values may be bogus. (Win32) =item msgctl ID,CMD,ARG *************** *** 1001,1007 **** =item msgrcv ID,VAR,SIZE,TYPE,FLAGS ! Not implemented. (S, Win32, VMS, Plan9) =item open FILEHANDLE,EXPR --- 1247,1253 ---- =item msgrcv ID,VAR,SIZE,TYPE,FLAGS ! Not implemented. (S, Win32, VMS, Plan9, S) =item open FILEHANDLE,EXPR *************** *** 1010,1016 **** The C<|> variants are only supported if ToolServer is installed. (S) ! open to C<|-> and C<-|> are unsupported. (S, Win32) =item pipe READHANDLE,WRITEHANDLE --- 1256,1262 ---- The C<|> variants are only supported if ToolServer is installed. (S) ! open to C<|-> and C<-|> are unsupported. (S, Win32, S) =item pipe READHANDLE,WRITEHANDLE *************** *** 1020,1046 **** =item readlink ! Not implemented. (Win32, VMS) =item select RBITS,WBITS,EBITS,TIMEOUT Only implemented on sockets. (Win32) =item semctl ID,SEMNUM,CMD,ARG =item semget KEY,NSEMS,FLAGS =item semop KEY,OPSTRING ! Not implemented. (S, Win32, VMS) =item setpgrp PID,PGRP ! Not implemented. (S, Win32, VMS) =item setpriority WHICH,WHO,PRIORITY ! Not implemented. (S, Win32, VMS) =item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL --- 1266,1294 ---- =item readlink ! Not implemented. (Win32, VMS, S) =item select RBITS,WBITS,EBITS,TIMEOUT Only implemented on sockets. (Win32) + Only reliable on sockets. (S) + =item semctl ID,SEMNUM,CMD,ARG =item semget KEY,NSEMS,FLAGS =item semop KEY,OPSTRING ! Not implemented. (S, Win32, VMS, S) =item setpgrp PID,PGRP ! Not implemented. (S, Win32, VMS, S) =item setpriority WHICH,WHO,PRIORITY ! Not implemented. (S, Win32, VMS, S) =item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL *************** *** 1054,1064 **** =item shmwrite ID,STRING,POS,SIZE ! Not implemented. (S, Win32, VMS) =item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL ! Not implemented. (S, Win32, VMS) =item stat FILEHANDLE --- 1302,1312 ---- =item shmwrite ID,STRING,POS,SIZE ! Not implemented. (S, Win32, VMS, S) =item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL ! Not implemented. (S, Win32, VMS, S) =item stat FILEHANDLE *************** *** 1073,1085 **** device and inode are not necessarily reliable. (VMS) =item symlink OLDFILE,NEWFILE ! Not implemented. (Win32, VMS) =item syscall LIST ! Not implemented. (S, Win32, VMS) =item system LIST --- 1321,1343 ---- device and inode are not necessarily reliable. (VMS) + mtime, atime and ctime all return the last modification time. Device and + inode are not necessarily reliable. (S) + =item symlink OLDFILE,NEWFILE ! Not implemented. (Win32, VMS, S) =item syscall LIST ! Not implemented. (S, Win32, VMS, S) ! ! =item sysopen FILEHANDLE,FILENAME,MODE,PERMS ! ! The traditional "0", "1", and "2" MODEs are implemented with different ! numeric values on some systems. The flags exported by C ! (O_RDONLY, O_WRONLY, O_RDWR) should work everywhere though. (S, OS/390) =item system LIST *************** *** 1091,1096 **** --- 1349,1364 ---- waiting for it to terminate. Return value may be used subsequently in C or C. (Win32) + There is no shell to process metacharacters, and the native standard is + to pass a command line terminated by "\n" "\r" or "\0" to the spawned + program. Redirection such as C foo> is performed (if at all) by + the run time library of the spawned program. C I will call + the Unix emulation library's C emulation, which attempts to provide + emulation of the stdin, stdout, stderr in force in the parent, providing + the child program uses a compatible version of the emulation library. + I will call the native command line direct and no such emulation + of a child Unix program will exists. Mileage B vary. (S) + =item times Only the first entry returned is nonzero. (S) *************** *** 1099,1104 **** --- 1367,1374 ---- "system" time will be bogus, and "user" time is actually the time returned by the clock() function in the C runtime library. (Win32) + Not useful. (S) + =item truncate FILEHANDLE,LENGTH =item truncate EXPR,LENGTH *************** *** 1113,1121 **** =item utime LIST ! Only the modification time is updated. (S, VMS) ! May not behave as expected. (Win32) =item wait --- 1383,1395 ---- =item utime LIST ! Only the modification time is updated. (S, VMS, S) ! May not behave as expected. Behavior depends on the C runtime ! library's implementation of utime(), and the filesystem being ! used. The FAT filesystem typically does not support an "access ! time" field, and it may limit timestamps to a granularity of ! two seconds. (Win32) =item wait *************** *** 1126,1160 **** Can only be applied to process handles returned for processes spawned using C. (Win32) =back =head1 AUTHORS / CONTRIBUTORS ! Chris Nandor Epudge@pobox.comE, ! Gurusamy Sarathy Egsar@umich.eduE, ! Peter Prymmer Epvhp@forte.comE, ! Tom Christiansen Etchrist@perl.comE, ! Nathan Torkington Egnat@frii.comE, ! Paul Moore EPaul.Moore@uk.origin-it.comE, ! Matthias Neercher Eneeri@iis.ee.ethz.chE, Charles Bailey Ebailey@genetics.upenn.eduE, Luther Huffman Elutherh@stratcom.comE, - Gary Ng E71564.1743@CompuServe.COME, Nick Ing-Simmons Enick@ni-s.u-net.comE, ! Paul J. Schinder Eschinder@pobox.comE, Tom Phoenix Erootbeer@teleport.comE, ! Hugo van der Sanden Eh.sanden@elsevier.nlE, ! Dominic Dunlop Edomo@vo.luE, Dan Sugalski Esugalskd@ous.eduE, ! Andreas J. Koenig Ekoenig@kulturbox.deE, ! Andrew M. Langmead Eaml@world.std.comE, ! Andy Dougherty Edoughera@lafcol.lafayette.eduE, ! Abigail Eabigail@fnx.comE. This document is maintained by Chris Nandor. =head1 VERSION ! Version 1.23, last modified 10 July 1998. --- 1400,1461 ---- Can only be applied to process handles returned for processes spawned using C. (Win32) + Not useful. (S) + =back + =head1 CHANGES + + =over 4 + + =item 1.33, 06 August 1998 + + Integrate more minor changes. + + =item 1.32, 05 August 1998 + + Integrate more minor changes. + + =item 1.30, 03 August 1998 + + Major update for RISC OS, other minor changes. + + =item 1.23, 10 July 1998 + + First public release with perl5.005. + + =back =head1 AUTHORS / CONTRIBUTORS ! Abigail Eabigail@fnx.comE, Charles Bailey Ebailey@genetics.upenn.eduE, + Graham Barr Egbarr@pobox.comE, + Tom Christiansen Etchrist@perl.comE, + Nicholas Clark ENicholas.Clark@liverpool.ac.ukE, + Andy Dougherty Edoughera@lafcol.lafayette.eduE, + Dominic Dunlop Edomo@vo.luE, + M.J.T. Guy Emjtg@cus.cam.ac.ukE, Luther Huffman Elutherh@stratcom.comE, Nick Ing-Simmons Enick@ni-s.u-net.comE, ! Andreas J. KEnig Ekoenig@kulturbox.deE, ! Andrew M. Langmead Eaml@world.std.comE, ! Paul Moore EPaul.Moore@uk.origin-it.comE, ! Chris Nandor Epudge@pobox.comE, ! Matthias Neeracher Eneeri@iis.ee.ethz.chE, ! Gary Ng E71564.1743@CompuServe.COME, Tom Phoenix Erootbeer@teleport.comE, ! Peter Prymmer Epvhp@forte.comE, ! Hugo van der Sanden Ehv@crypt0.demon.co.ukE, ! Gurusamy Sarathy Egsar@umich.eduE, ! Paul J. Schinder Eschinder@pobox.comE, Dan Sugalski Esugalskd@ous.eduE, ! Nathan Torkington Egnat@frii.comE. This document is maintained by Chris Nandor. =head1 VERSION ! Version 1.34, last modified 07 August 1998. ! Index: pod/perlre.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlre.pod Fri Jul 24 00:01:46 1998 --- perl5.005_02/pod/perlre.pod Fri Aug 7 18:08:40 1998 *************** *** 7,18 **** This page describes the syntax of regular expressions in Perl. For a description of how to I regular expressions in matching operations, plus various examples of the same, see discussion ! of C, C, C and C in L. The matching operations can have various modifiers. The modifiers that relate to the interpretation of the regular expression inside ! are listed below. For the modifiers that alter the way regular expression ! is used by Perl, see L. =over 4 --- 7,19 ---- This page describes the syntax of regular expressions in Perl. For a description of how to I regular expressions in matching operations, plus various examples of the same, see discussion ! of C, C, C and C in L. The matching operations can have various modifiers. The modifiers that relate to the interpretation of the regular expression inside ! are listed below. For the modifiers that alter the way a regular expression ! is used by Perl, see L and ! L. =over 4 *************** *** 341,350 **** succeeds. C is not interpolated. Currently the rules to determine where the C ends are somewhat convoluted. - Owing to the risks to security, this is only available when the - C pragma is used, and then only for patterns that don't - have any variables that must be interpolated at run time. - The C is properly scoped in the following sense: if the assertion is backtracked (compare L<"Backtracking">), all the changes introduced after Cisation are undone, so --- 342,347 ---- *************** *** 375,380 **** --- 372,399 ---- The above assignment to $^R is properly localized, thus the old value of $^R is restored if the assertion is backtracked (compare L<"Backtracking">). + Due to security concerns, this construction is not allowed if the regular + expression involves run-time interpolation of variables, unless + C pragma is used (see L), or the variables contain + results of qr() operator (see L). + + This restriction is due to the wide-spread (questionable) practice of + using the construct + + $re = <>; + chomp $re; + $string =~ /$re/; + + without tainting. While this code is frowned upon from security point + of view, when C<(?{})> was introduced, it was considered bad to add + I security holes to existing scripts. + + B Use of the above insecure snippet without also enabling taint mode + is to be severely frowned upon. C does not disable tainting + checks, thus to allow $re in the above snippet to contain C<(?{})> + I, one needs both C and untaint + the $re. + =item C<(?Epattern)> An "independent" subexpression. Matches the substring that a *************** *** 387,393 **** In contrast, C will match the same as C, since the match of the subgroup C is influenced by the following group C (see L<"Backtracking">). In particular, C inside C will match ! less characters that a standalone C, since this makes the tail match. An effect similar to C<(?Epattern)> may be achieved by --- 406,412 ---- In contrast, C will match the same as C, since the match of the subgroup C is influenced by the following group C (see L<"Backtracking">). In particular, C inside C will match ! fewer characters than a standalone C, since this makes the tail match. An effect similar to C<(?Epattern)> may be achieved by *************** *** 396,435 **** since the lookahead is in I<"logical"> context, thus matches the same substring as a standalone C. The following C<\1> eats the matched string, thus making a zero-length assertion into an analogue of ! C<(?>...)>. (The difference between these two constructs is that the second one uses a catching group, thus shifting ordinals of backreferences in the rest of a regular expression.) This construct is useful for optimizations of "eternal" matches, because it will not backtrack (see L<"Backtracking">). ! m{ \( ( ! [^()]+ ! | ! \( [^()]* \) ! )+ ! \) ! }x That will efficiently match a nonempty group with matching two-or-less-level-deep parentheses. However, if there is no such group, it will take virtually forever on a long string. That's because there are so many different ways to split a long string into several substrings. ! This is essentially what C<(.+)+> is doing, and this is a subpattern ! of the above pattern. Consider that C<((()aaaaaaaaaaaaaaaaaa> on the ! pattern above detects no-match in several seconds, but that each extra letter doubles this time. This exponential performance will make it appear that your program has hung. However, a tiny modification of this pattern ! m{ \( ( ! (?> [^()]+ ) ! | ! \( [^()]* \) ! )+ ! \) ! }x which uses C<(?E...)> matches exactly when the one above does (verifying this yourself would be a productive exercise), but finishes in a fourth --- 415,456 ---- since the lookahead is in I<"logical"> context, thus matches the same substring as a standalone C. The following C<\1> eats the matched string, thus making a zero-length assertion into an analogue of ! C<(?E...)>. (The difference between these two constructs is that the second one uses a catching group, thus shifting ordinals of backreferences in the rest of a regular expression.) This construct is useful for optimizations of "eternal" matches, because it will not backtrack (see L<"Backtracking">). ! m{ \( ! ( ! [^()]+ ! | ! \( [^()]* \) ! )+ ! \) ! }x That will efficiently match a nonempty group with matching two-or-less-level-deep parentheses. However, if there is no such group, it will take virtually forever on a long string. That's because there are so many different ways to split a long string into several substrings. ! This is what C<(.+)+> is doing, and C<(.+)+> is similar to a subpattern ! of the above pattern. Consider that the above pattern detects no-match ! on C<((()aaaaaaaaaaaaaaaaaa> in several seconds, but that each extra letter doubles this time. This exponential performance will make it appear that your program has hung. However, a tiny modification of this pattern ! m{ \( ! ( ! (?> [^()]+ ) ! | ! \( [^()]* \) ! )+ ! \) ! }x which uses C<(?E...)> matches exactly when the one above does (verifying this yourself would be a productive exercise), but finishes in a fourth *************** *** 452,460 **** Say, m{ ( \( )? ! [^()]+ (?(1) \) ) ! }x matches a chunk of non-parentheses, possibly included in parentheses themselves. --- 473,481 ---- Say, m{ ( \( )? ! [^()]+ (?(1) \) ) ! }x matches a chunk of non-parentheses, possibly included in parentheses themselves. *************** *** 603,612 **** tricker. Imagine you'd like to find a sequence of non-digits not followed by "123". You might try to write that as ! $_ = "ABC123"; ! if ( /^\D*(?!123)/ ) { # Wrong! ! print "Yup, no 123 in $_\n"; ! } But that isn't going to match; at least, not the way you're hoping. It claims that there is no 123 in the string. Here's a clearer picture of --- 624,633 ---- tricker. Imagine you'd like to find a sequence of non-digits not followed by "123". You might try to write that as ! $_ = "ABC123"; ! if ( /^\D*(?!123)/ ) { # Wrong! ! print "Yup, no 123 in $_\n"; ! } But that isn't going to match; at least, not the way you're hoping. It claims that there is no 123 in the string. Here's a clearer picture of *************** *** 898,903 **** --- 919,926 ---- =head2 SEE ALSO L. + + L. L. Index: pod/perlrun.pod ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/perlrun.pod Fri Jul 24 00:01:47 1998 --- perl5.005_02/pod/perlrun.pod Sun Aug 2 02:22:45 1998 *************** *** 272,277 **** --- 272,278 ---- 8192 H Hash dump -- usurps values() 16384 X Scratchpad allocation 32768 D Cleaning up + 65536 S Thread synchronization All these flags require C<-DDEBUGGING> when you compile the Perl executable. This flag is automatically set if you include C<-g> Index: pod/roffitall ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pod/roffitall Fri Jul 24 00:01:57 1998 --- perl5.005_02/pod/roffitall Mon Aug 3 15:02:45 1998 *************** *** 14,21 **** mandir=$installman1dir libdir=$installman3dir ! test -d $mandir || mandir=/usr/local/man/man1 ! test -d $libdir || libdir=/usr/local/man/man3 case "$1" in -nroff) cmd="nroff -man"; ext='txt';; --- 14,21 ---- mandir=$installman1dir libdir=$installman3dir ! test -d $mandir || mandir=/usr/new/man/man1 ! test -d $libdir || libdir=/usr/new/man/man3 case "$1" in -nroff) cmd="nroff -man"; ext='txt';; *************** *** 30,69 **** toroff=` echo \ $mandir/perl.1 \ - $mandir/perldelta.1 \ $mandir/perldata.1 \ $mandir/perlsyn.1 \ $mandir/perlop.1 \ $mandir/perlre.1 \ $mandir/perlrun.1 \ - $mandir/perllocale.1 \ $mandir/perlfunc.1 \ $mandir/perlvar.1 \ $mandir/perlsub.1 \ $mandir/perlmod.1 \ $mandir/perlmodlib.1 \ $mandir/perlref.1 \ $mandir/perldsc.1 \ $mandir/perllol.1 \ $mandir/perlobj.1 \ $mandir/perltie.1 \ - $mandir/perltoot.1 \ $mandir/perlbot.1 \ $mandir/perldebug.1 \ $mandir/perldiag.1 \ - $mandir/perlform.1 \ - $mandir/perlipc.1 \ $mandir/perlsec.1 \ $mandir/perltrap.1 \ $mandir/perlstyle.1 \ $mandir/perlapio.1 \ $mandir/perlxs.1 \ $mandir/perlxstut.1 \ $mandir/perlguts.1 \ $mandir/perlcall.1 \ ! $mandir/perlembed.1 \ ! $mandir/perlpod.1 \ ! $mandir/perlbook.1 \ $mandir/perlfaq.1 \ $mandir/perlfaq1.1 \ $mandir/perlfaq2.1 \ --- 30,73 ---- toroff=` echo \ $mandir/perl.1 \ $mandir/perldata.1 \ $mandir/perlsyn.1 \ $mandir/perlop.1 \ $mandir/perlre.1 \ $mandir/perlrun.1 \ $mandir/perlfunc.1 \ $mandir/perlvar.1 \ $mandir/perlsub.1 \ $mandir/perlmod.1 \ $mandir/perlmodlib.1 \ + $mandir/perlmodinstall.1 \ + $mandir/perlform.1 \ + $mandir/perllocale.1 \ $mandir/perlref.1 \ $mandir/perldsc.1 \ $mandir/perllol.1 \ + $mandir/perltoot.1 \ $mandir/perlobj.1 \ $mandir/perltie.1 \ $mandir/perlbot.1 \ + $mandir/perlipc.1 \ $mandir/perldebug.1 \ $mandir/perldiag.1 \ $mandir/perlsec.1 \ $mandir/perltrap.1 \ + $mandir/perlport.1 \ $mandir/perlstyle.1 \ + $mandir/perlpod.1 \ + $mandir/perlbook.1 \ + $mandir/perlembed.1 \ $mandir/perlapio.1 \ $mandir/perlxs.1 \ $mandir/perlxstut.1 \ $mandir/perlguts.1 \ $mandir/perlcall.1 \ ! $mandir/perlhist.1 \ ! $mandir/perldelta.1 \ ! $mandir/perl5004delta.1 \ $mandir/perlfaq.1 \ $mandir/perlfaq1.1 \ $mandir/perlfaq2.1 \ *************** *** 75,87 **** --- 79,111 ---- $mandir/perlfaq8.1 \ $mandir/perlfaq9.1 \ \ + $mandir/a2p.1 \ + $mandir/c2ph.1 \ + $mandir/h2ph.1 \ + $mandir/h2xs.1 \ + $mandir/perlbug.1 \ + $mandir/perldoc.1 \ + $mandir/pl2pm.1 \ + $mandir/pod2html.1 \ + $mandir/pod2man.1 \ + $mandir/s2p.1 \ + $mandir/splain.1 \ + $mandir/xsubpp.1 \ + \ + $libdir/attrs.3 \ + $libdir/autouse.3 \ + $libdir/base.3 \ $libdir/blib.3 \ + $libdir/constant.3 \ $libdir/diagnostics.3 \ + $libdir/fields.3 \ $libdir/integer.3 \ $libdir/less.3 \ $libdir/lib.3 \ $libdir/locale.3 \ + $libdir/ops.3 \ $libdir/overload.3 \ + $libdir/re.3 \ $libdir/sigtrap.3 \ $libdir/strict.3 \ $libdir/subs.3 \ *************** *** 90,123 **** $libdir/AnyDBM_File.3 \ $libdir/AutoLoader.3 \ $libdir/AutoSplit.3 \ $libdir/Benchmark.3 \ $libdir/Carp.3 \ $libdir/Config.3 \ $libdir/Cwd.3 \ $libdir/DB_File.3 \ $libdir/Devel::SelfStubber.3 \ $libdir/DynaLoader.3 \ $libdir/English.3 \ $libdir/Env.3 \ $libdir/Exporter.3 \ $libdir/ExtUtils::Embed.3 \ $libdir/ExtUtils::Install.3 \ $libdir/ExtUtils::Liblist.3 \ $libdir/ExtUtils::MakeMaker.3 \ $libdir/ExtUtils::Manifest.3 \ $libdir/ExtUtils::Mkbootstrap.3 \ $libdir/ExtUtils::Mksymlists.3 \ $libdir/Fcntl.3 \ $libdir/File::Basename.3 \ $libdir/File::CheckTree.3 \ - $libdir/File::Copy.3 \ $libdir/File::Compare.3 \ $libdir/File::Find.3 \ $libdir/File::Path.3 \ $libdir/File::stat.3 \ $libdir/FileCache.3 \ $libdir/FileHandle.3 \ $libdir/FindBin.3 \ $libdir/Getopt::Long.3 \ $libdir/Getopt::Std.3 \ $libdir/I18N::Collate.3 \ --- 114,194 ---- $libdir/AnyDBM_File.3 \ $libdir/AutoLoader.3 \ $libdir/AutoSplit.3 \ + $libdir/B.3 \ + $libdir/B::Asmdata.3 \ + $libdir/B::Assembler.3 \ + $libdir/B::Bblock.3 \ + $libdir/B::Bytecode.3 \ + $libdir/B::C.3 \ + $libdir/B::CC.3 \ + $libdir/B::Debug.3 \ + $libdir/B::Deparse.3 \ + $libdir/B::Disassembler.3 \ + $libdir/B::Lint.3 \ + $libdir/B::Showlex.3 \ + $libdir/B::Stackobj.3 \ + $libdir/B::Terse.3 \ + $libdir/B::Xref.3 \ $libdir/Benchmark.3 \ $libdir/Carp.3 \ + $libdir/CGI.3 \ + $libdir/CGI::Apache.3 \ + $libdir/CGI::Carp.3 \ + $libdir/CGI::Cookie.3 \ + $libdir/CGI::Fast.3 \ + $libdir/CGI::Push.3 \ + $libdir/CGI::Switch.3 \ + $libdir/Class::Struct.3 \ $libdir/Config.3 \ + $libdir/CPAN.3 \ + $libdir/CPAN::FirstTime.3 \ + $libdir/CPAN::Nox.3 \ $libdir/Cwd.3 \ + $libdir/Data::Dumper.3 \ $libdir/DB_File.3 \ $libdir/Devel::SelfStubber.3 \ + $libdir/DirHandle.3 \ $libdir/DynaLoader.3 \ $libdir/English.3 \ $libdir/Env.3 \ + $libdir/Errno.3 \ $libdir/Exporter.3 \ + $libdir/ExtUtils::Command.3 \ $libdir/ExtUtils::Embed.3 \ $libdir/ExtUtils::Install.3 \ + $libdir/ExtUtils::Installed.3 \ $libdir/ExtUtils::Liblist.3 \ $libdir/ExtUtils::MakeMaker.3 \ $libdir/ExtUtils::Manifest.3 \ + $libdir/ExtUtils::Miniperl.3 \ $libdir/ExtUtils::Mkbootstrap.3 \ $libdir/ExtUtils::Mksymlists.3 \ + $libdir/ExtUtils::MM_OS2.3 \ + $libdir/ExtUtils::MM_Unix.3 \ + $libdir/ExtUtils::MM_VMS.3 \ + $libdir/ExtUtils::MM_Win32.3 \ + $libdir/ExtUtils::Packlist.3 \ + $libdir/ExtUtils::testlib.3 \ + $libdir/Fatal.3 \ $libdir/Fcntl.3 \ $libdir/File::Basename.3 \ $libdir/File::CheckTree.3 \ $libdir/File::Compare.3 \ + $libdir/File::Copy.3 \ + $libdir/File::DosGlob.3 \ $libdir/File::Find.3 \ $libdir/File::Path.3 \ + $libdir/File::Spec.3 \ + $libdir/File::Spec::Mac.3 \ + $libdir/File::Spec::OS2.3 \ + $libdir/File::Spec::Unix.3 \ + $libdir/File::Spec::VMS.3 \ + $libdir/File::Spec::Win32.3 \ $libdir/File::stat.3 \ $libdir/FileCache.3 \ $libdir/FileHandle.3 \ $libdir/FindBin.3 \ + $libdir/GDBM_File.3 \ $libdir/Getopt::Long.3 \ $libdir/Getopt::Std.3 \ $libdir/I18N::Collate.3 \ *************** *** 128,148 **** $libdir/IO::Seekable.3 \ $libdir/IO::Select.3 \ $libdir/IO::Socket.3 \ $libdir/IPC::Open2.3 \ $libdir/IPC::Open3.3 \ $libdir/Math::BigFloat.3 \ $libdir/Math::BigInt.3 \ $libdir/Math::Complex.3 \ $libdir/Math::Trig.3 \ ! $libdir/Net::Ping.3 \ $libdir/Net::hostent.3 \ $libdir/Net::netent.3 \ $libdir/Net::protoent.3 \ $libdir/Net::servent.3 \ $libdir/Opcode.3 \ ! $libdir/POSIX.3 \ $libdir/Pod::Text.3 \ $libdir/Safe.3 \ $libdir/Search::Dict.3 \ $libdir/SelectSaver.3 \ $libdir/SelfLoader.3 \ --- 199,226 ---- $libdir/IO::Seekable.3 \ $libdir/IO::Select.3 \ $libdir/IO::Socket.3 \ + $libdir/IPC::Msg.3 \ $libdir/IPC::Open2.3 \ $libdir/IPC::Open3.3 \ + $libdir/IPC::Semaphore.3 \ + $libdir/IPC::SysV.3 \ $libdir/Math::BigFloat.3 \ $libdir/Math::BigInt.3 \ $libdir/Math::Complex.3 \ $libdir/Math::Trig.3 \ ! $libdir/NDBM_File.3 \ $libdir/Net::hostent.3 \ $libdir/Net::netent.3 \ + $libdir/Net::Ping.3 \ $libdir/Net::protoent.3 \ $libdir/Net::servent.3 \ + $libdir/O.3 \ $libdir/Opcode.3 \ ! $libdir/Pod::Html.3 \ $libdir/Pod::Text.3 \ + $libdir/POSIX.3 \ $libdir/Safe.3 \ + $libdir/SDBM_File.3 \ $libdir/Search::Dict.3 \ $libdir/SelectSaver.3 \ $libdir/SelfLoader.3 \ *************** *** 153,202 **** $libdir/Sys::Syslog.3 \ $libdir/Term::Cap.3 \ $libdir/Term::Complete.3 \ $libdir/Test::Harness.3 \ $libdir/Text::Abbrev.3 \ $libdir/Text::ParseWords.3 \ $libdir/Text::Soundex.3 \ $libdir/Text::Tabs.3 \ $libdir/Tie::Hash.3 \ $libdir/Tie::RefHash.3 \ $libdir/Tie::Scalar.3 \ $libdir/Tie::SubstrHash.3 \ - $libdir/Time::Local.3 \ $libdir/Time::gmtime.3 \ $libdir/Time::localtime.3 \ $libdir/Time::tm.3 \ $libdir/UNIVERSAL.3 \ $libdir/User::grent.3 \ $libdir/User::pwent.3 | \ ! perl -ne 'map { -r && print "$_ " } split'` ! # Bypass internal shell buffer limit -- can't use case ! if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then echo "$me: empty file list -- did you run install?" >&2 exit 1 ! fi ! #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw ! #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw ! # First, create the raw data ! run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" ! echo "$me: running $run" ! eval $run $toroff ! ! #Now create the TOC ! echo "$me: parsing TOC" ! ./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man ! run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" ! echo "$me: running $run" ! eval $run ! ! # Finally, recreate the Doc, without the blank page 0 ! run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" ! echo "$me: running $run" ! eval $run $toroff ! rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw ! echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" --- 231,284 ---- $libdir/Sys::Syslog.3 \ $libdir/Term::Cap.3 \ $libdir/Term::Complete.3 \ + $libdir/Term::ReadLine.3 \ + $libdir/Test.3 \ $libdir/Test::Harness.3 \ $libdir/Text::Abbrev.3 \ $libdir/Text::ParseWords.3 \ $libdir/Text::Soundex.3 \ $libdir/Text::Tabs.3 \ + $libdir/Text::Wrap.3 \ + $libdir/Tie::Array.3 \ + $libdir/Tie::Handle.3 \ $libdir/Tie::Hash.3 \ $libdir/Tie::RefHash.3 \ $libdir/Tie::Scalar.3 \ $libdir/Tie::SubstrHash.3 \ $libdir/Time::gmtime.3 \ + $libdir/Time::Local.3 \ $libdir/Time::localtime.3 \ $libdir/Time::tm.3 \ $libdir/UNIVERSAL.3 \ $libdir/User::grent.3 \ $libdir/User::pwent.3 | \ ! perl -ne 'map { -r && print "$_ " } split'` ! # Bypass internal shell buffer limit -- can't use case ! if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then echo "$me: empty file list -- did you run install?" >&2 exit 1 ! fi ! ! #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw ! #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw ! # First, create the raw data ! run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" ! echo "$me: running $run" ! eval $run $toroff ! #Now create the TOC ! echo "$me: parsing TOC" ! ./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man ! run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" ! echo "$me: running $run" ! eval $run + # Finally, recreate the Doc, without the blank page 0 + run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" + echo "$me: running $run" + eval $run $toroff + rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw + echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" Index: pp.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pp.c Fri Jul 24 00:01:59 1998 --- perl5.005_02/pp.c Tue Aug 4 17:58:01 1998 *************** *** 2908,2913 **** --- 2908,2927 ---- /* Explosives and implosives. */ + static const char uuemap[] = + "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; + static char uudmap[256]; /* Initialised on first use */ + #if 'I' == 73 && 'J' == 74 + /* On an ASCII/ISO kind of system */ + #define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a') + #else + /* + Some other sort of character set - use memchr() so we don't match + the null byte. + */ + #define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ') + #endif + PP(pp_unpack) { djSP; *************** *** 3534,3564 **** } break; case 'u': along = (strend - s) * 3 / 4; sv = NEWSV(42, along); if (along) SvPOK_on(sv); ! while (s < strend && *s > ' ' && *s < 'a') { I32 a, b, c, d; char hunk[4]; hunk[3] = '\0'; len = (*s++ - ' ') & 077; while (len > 0) { ! if (s < strend && *s >= ' ') ! a = (*s++ - ' ') & 077; ! else ! a = 0; ! if (s < strend && *s >= ' ') ! b = (*s++ - ' ') & 077; ! else ! b = 0; ! if (s < strend && *s >= ' ') ! c = (*s++ - ' ') & 077; ! else ! c = 0; ! if (s < strend && *s >= ' ') ! d = (*s++ - ' ') & 077; else d = 0; hunk[0] = (a << 2) | (b >> 4); --- 3548,3595 ---- } break; case 'u': + /* MKS: + * Initialise the decode mapping. By using a table driven + * algorithm, the code will be character-set independent + * (and just as fast as doing character arithmetic) + */ + if (uudmap['M'] == 0) { + int i; + + for (i = 0; i < sizeof(uuemap); i += 1) + uudmap[uuemap[i]] = i; + /* + * Because ' ' and '`' map to the same value, + * we need to decode them both the same. + */ + uudmap[' '] = 0; + } + along = (strend - s) * 3 / 4; sv = NEWSV(42, along); if (along) SvPOK_on(sv); ! while (s < strend && *s > ' ' && ISUUCHAR(*s)) { I32 a, b, c, d; char hunk[4]; hunk[3] = '\0'; len = (*s++ - ' ') & 077; while (len > 0) { ! if (s < strend && ISUUCHAR(*s)) ! a = uudmap[*s++] & 077; ! else ! a = 0; ! if (s < strend && ISUUCHAR(*s)) ! b = uudmap[*s++] & 077; ! else ! b = 0; ! if (s < strend && ISUUCHAR(*s)) ! c = uudmap[*s++] & 077; ! else ! c = 0; ! if (s < strend && ISUUCHAR(*s)) ! d = uudmap[*s++] & 077; else d = 0; hunk[0] = (a << 2) | (b >> 4); *************** *** 3619,3639 **** { char hunk[5]; ! *hunk = len + ' '; sv_catpvn(sv, hunk, 1); hunk[4] = '\0'; ! while (len > 0) { ! hunk[0] = ' ' + (077 & (*s >> 2)); ! hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017))); ! hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03))); ! hunk[3] = ' ' + (077 & (s[2] & 077)); sv_catpvn(sv, hunk, 4); s += 3; len -= 3; } ! for (s = SvPVX(sv); *s; s++) { ! if (*s == ' ') ! *s = '`'; } sv_catpvn(sv, "\n", 1); } --- 3650,3674 ---- { char hunk[5]; ! *hunk = uuemap[len]; sv_catpvn(sv, hunk, 1); hunk[4] = '\0'; ! while (len > 2) { ! hunk[0] = uuemap[(077 & (*s >> 2))]; ! hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))]; ! hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; ! hunk[3] = uuemap[(077 & (s[2] & 077))]; sv_catpvn(sv, hunk, 4); s += 3; len -= 3; } ! if (len > 0) { ! char r = (len > 1 ? s[1] : '\0'); ! hunk[0] = uuemap[(077 & (*s >> 2))]; ! hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))]; ! hunk[2] = uuemap[(077 & ((r << 2) & 074))]; ! hunk[3] = uuemap[0]; ! sv_catpvn(sv, hunk, 4); } sv_catpvn(sv, "\n", 1); } *************** *** 4459,4465 **** croak("panic: unlock_condpair unlocking mutex that we don't own"); MgOWNER(mg) = 0; COND_SIGNAL(MgOWNERCONDP(mg)); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", (unsigned long)thr, (unsigned long)svv);) MUTEX_UNLOCK(MgMUTEXP(mg)); } --- 4494,4500 ---- croak("panic: unlock_condpair unlocking mutex that we don't own"); MgOWNER(mg) = 0; COND_SIGNAL(MgOWNERCONDP(mg)); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", (unsigned long)thr, (unsigned long)svv);) MUTEX_UNLOCK(MgMUTEXP(mg)); } *************** *** 4484,4490 **** while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */ --- 4519,4525 ---- while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", (unsigned long)thr, (unsigned long)sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */ Index: pp_ctl.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pp_ctl.c Fri Jul 24 00:02:01 1998 --- perl5.005_02/pp_ctl.c Sun Aug 2 01:15:08 1998 *************** *** 436,450 **** arg = itemsize; s = item; while (arg--) { ! #if 'z' - 'a' != 25 int ch = *t++ = *s++; ! if (!iscntrl(ch)) ! t[-1] = ' '; #else if ( !((*t++ = *s++) & ~31) ) - t[-1] = ' '; #endif ! } break; --- 436,448 ---- arg = itemsize; s = item; while (arg--) { ! #ifdef EBCDIC int ch = *t++ = *s++; ! if (iscntrl(ch)) #else if ( !((*t++ = *s++) & ~31) ) #endif ! t[-1] = ' '; } break; Index: pp_hot.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pp_hot.c Fri Jul 24 00:02:02 1998 --- perl5.005_02/pp_hot.c Sun Aug 2 02:08:11 1998 *************** *** 21,26 **** --- 21,32 ---- #ifdef I_UNISTD #include #endif + #ifdef I_FCNTL + #include + #endif + #ifdef I_SYS_FILE + #include + #endif /* Hot code. */ *************** *** 33,42 **** dTHR; #endif /* DEBUGGING */ ! DEBUG_L((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); MUTEX_LOCK(CvMUTEXP(cv)); ! DEBUG_L(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); assert(thr == CvOWNER(cv)); --- 39,48 ---- dTHR; #endif /* DEBUGGING */ ! DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); MUTEX_LOCK(CvMUTEXP(cv)); ! DEBUG_S(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); assert(thr == CvOWNER(cv)); *************** *** 1063,1069 **** IoFLAGS(io) &= ~IOf_START; IoLINES(io) = 0; if (av_len(GvAVn(PL_last_in_gv)) < 0) { ! do_open(PL_last_in_gv,"-",1,FALSE,0,0,Nullfp); sv_setpvn(GvSV(PL_last_in_gv), "-", 1); SvSETMAGIC(GvSV(PL_last_in_gv)); fp = IoIFP(io); --- 1069,1075 ---- IoFLAGS(io) &= ~IOf_START; IoLINES(io) = 0; if (av_len(GvAVn(PL_last_in_gv)) < 0) { ! do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp); sv_setpvn(GvSV(PL_last_in_gv), "-", 1); SvSETMAGIC(GvSV(PL_last_in_gv)); fp = IoIFP(io); *************** *** 1197,1203 **** #endif /* !CSH */ #endif /* !DOSISH */ (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd), ! FALSE, 0, 0, Nullfp); fp = IoIFP(io); #endif /* !VMS */ LEAVE; --- 1203,1209 ---- #endif /* !CSH */ #endif /* !DOSISH */ (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd), ! FALSE, O_RDONLY, 0, Nullfp); fp = IoIFP(io); #endif /* !VMS */ LEAVE; *************** *** 1244,1250 **** IoFLAGS(io) |= IOf_START; } else if (type == OP_GLOB) { ! if (do_close(PL_last_in_gv, FALSE) & ~0xFF) warn("internal error: glob failed"); } if (gimme == G_SCALAR) { --- 1250,1256 ---- IoFLAGS(io) |= IOf_START; } else if (type == OP_GLOB) { ! if (!do_close(PL_last_in_gv, FALSE)) warn("internal error: glob failed"); } if (gimme == G_SCALAR) { *************** *** 1460,1466 **** char *max = SvPV((SV*)av, maxlen); if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { #ifndef USE_THREADS /* don't risk potential race */ ! if (SvREFCNT(*cx->blk_loop.itervar) == 1) { /* safe to reuse old SV */ sv_setsv(*cx->blk_loop.itervar, cur); } --- 1466,1474 ---- char *max = SvPV((SV*)av, maxlen); if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { #ifndef USE_THREADS /* don't risk potential race */ ! if (SvREFCNT(*cx->blk_loop.itervar) == 1 ! && !SvMAGICAL(*cx->blk_loop.itervar)) ! { /* safe to reuse old SV */ sv_setsv(*cx->blk_loop.itervar, cur); } *************** *** 1486,1492 **** RETPUSHNO; #ifndef USE_THREADS /* don't risk potential race */ ! if (SvREFCNT(*cx->blk_loop.itervar) == 1) { /* safe to reuse old SV */ sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); } --- 1494,1502 ---- RETPUSHNO; #ifndef USE_THREADS /* don't risk potential race */ ! if (SvREFCNT(*cx->blk_loop.itervar) == 1 ! && !SvMAGICAL(*cx->blk_loop.itervar)) ! { /* safe to reuse old SV */ sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); } *************** *** 2081,2087 **** while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", thr, sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */ --- 2091,2097 ---- while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", thr, sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */ *************** *** 2125,2131 **** /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); cv = *(CV**)svp; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "entersub: %p already has clone %p:%s\n", thr, cv, SvPEEK((SV*)cv))); CvOWNER(cv) = thr; --- 2135,2141 ---- /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); cv = *(CV**)svp; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "entersub: %p already has clone %p:%s\n", thr, cv, SvPEEK((SV*)cv))); CvOWNER(cv) = thr; *************** *** 2139,2145 **** CvOWNER(cv) = thr; SvREFCNT_inc(cv); MUTEX_UNLOCK(CvMUTEXP(cv)); ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "entersub: %p grabbing %p:%s in stash %s\n", thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? HvNAME(CvSTASH(cv)) : "(none)")); --- 2149,2155 ---- CvOWNER(cv) = thr; SvREFCNT_inc(cv); MUTEX_UNLOCK(CvMUTEXP(cv)); ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "entersub: %p grabbing %p:%s in stash %s\n", thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? HvNAME(CvSTASH(cv)) : "(none)")); *************** *** 2148,2154 **** CV *clonecv; SvREFCNT_inc(cv); /* don't let it vanish from under us */ MUTEX_UNLOCK(CvMUTEXP(cv)); ! DEBUG_L((PerlIO_printf(PerlIO_stderr(), "entersub: %p cloning %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); /* --- 2158,2164 ---- CV *clonecv; SvREFCNT_inc(cv); /* don't let it vanish from under us */ MUTEX_UNLOCK(CvMUTEXP(cv)); ! DEBUG_S((PerlIO_printf(PerlIO_stderr(), "entersub: %p cloning %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); /* *************** *** 2165,2171 **** cv = clonecv; SvREFCNT_inc(cv); } ! DEBUG_L(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); SAVEDESTRUCTOR(unset_cvowner, (void*) cv); --- 2175,2181 ---- cv = clonecv; SvREFCNT_inc(cv); } ! DEBUG_S(if (CvDEPTH(cv) != 0) PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", CvDEPTH(cv));); SAVEDESTRUCTOR(unset_cvowner, (void*) cv); *************** *** 2315,2321 **** SV** ary; #if 0 ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; --- 2325,2331 ---- SV** ary; #if 0 ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; *************** *** 2353,2359 **** } } #if 0 ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p entersub returning %p\n", thr, CvSTART(cv))); #endif RETURNOP(CvSTART(cv)); --- 2363,2369 ---- } } #if 0 ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p entersub returning %p\n", thr, CvSTART(cv))); #endif RETURNOP(CvSTART(cv)); Index: pp_sys.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/pp_sys.c Sat Jul 25 22:24:31 1998 --- perl5.005_02/pp_sys.c Sun Aug 2 01:15:08 1998 *************** *** 382,388 **** if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; tmps = SvPV(sv, len); ! if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) PUSHi( (I32)PL_forkprocess ); else if (PL_forkprocess == 0) /* we are a new child */ PUSHi(0); --- 382,388 ---- if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; tmps = SvPV(sv, len); ! if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp)) PUSHi( (I32)PL_forkprocess ); else if (PL_forkprocess == 0) /* we are a new child */ PUSHi(0); *************** *** 2608,2619 **** --- 2608,2624 ---- odd += len; break; } + #ifdef EBCDIC + else if (!(isPRINT(*s) || isSPACE(*s))) + odd++; + #else else if (*s & 128) odd++; else if (*s < 32 && *s != '\n' && *s != '\r' && *s != '\b' && *s != '\t' && *s != '\f' && *s != 27) odd++; + #endif } if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */ *************** *** 2739,2745 **** if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { ! if (euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode)) (void)UNLINK(tmps2); if (!(anum = link(tmps, tmps2))) anum = UNLINK(tmps); --- 2744,2750 ---- if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { ! if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode)) (void)UNLINK(tmps2); if (!(anum = link(tmps, tmps2))) anum = UNLINK(tmps); Index: proto.h ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/proto.h Sun Jul 26 18:57:03 1998 --- perl5.005_02/proto.h Sun Aug 2 02:28:28 1998 *************** *** 1,10 **** #ifdef PERL_OBJECT ! #define VIRTUAL virtual #else ! #define VIRTUAL START_EXTERN_C #endif #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ #ifdef __attribute__ /* Avoid possible redefinition errors */ --- 1,19 ---- + #ifndef PERL_CALLCONV + # define PERL_CALLCONV + #endif + #ifdef PERL_OBJECT ! #define VIRTUAL virtual PERL_CALLCONV #else ! #define VIRTUAL PERL_CALLCONV START_EXTERN_C #endif + /* NOTE!!! When new virtual functions are added, they must be added at + * the end of this file to maintain binary compatibility with PERL_OBJECT + */ + + #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ #ifdef __attribute__ /* Avoid possible redefinition errors */ *************** *** 527,539 **** VIRTUAL int sv_backoff _((SV* sv)); VIRTUAL SV* sv_bless _((SV* sv, HV* stash)); VIRTUAL void sv_catpvf _((SV* sv, const char* pat, ...)); - VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...)); VIRTUAL void sv_catpv _((SV* sv, char* ptr)); - VIRTUAL void sv_catpv_mg _((SV *sv, char *ptr)); VIRTUAL void sv_catpvn _((SV* sv, char* ptr, STRLEN len)); - VIRTUAL void sv_catpvn_mg _((SV *sv, char *ptr, STRLEN len)); VIRTUAL void sv_catsv _((SV* dsv, SV* ssv)); - VIRTUAL void sv_catsv_mg _((SV *dstr, SV *sstr)); VIRTUAL void sv_chop _((SV* sv, char* ptr)); VIRTUAL void sv_clean_all _((void)); VIRTUAL void sv_clean_objs _((void)); --- 536,544 ---- *************** *** 572,596 **** VIRTUAL void sv_report_used _((void)); VIRTUAL void sv_reset _((char* s, HV* stash)); VIRTUAL void sv_setpvf _((SV* sv, const char* pat, ...)); - VIRTUAL void sv_setpvf_mg _((SV *sv, const char* pat, ...)); VIRTUAL void sv_setiv _((SV* sv, IV num)); - VIRTUAL void sv_setiv_mg _((SV *sv, IV i)); VIRTUAL void sv_setpviv _((SV* sv, IV num)); - VIRTUAL void sv_setpviv_mg _((SV *sv, IV iv)); VIRTUAL void sv_setuv _((SV* sv, UV num)); - VIRTUAL void sv_setuv_mg _((SV *sv, UV u)); VIRTUAL void sv_setnv _((SV* sv, double num)); - VIRTUAL void sv_setnv_mg _((SV *sv, double num)); VIRTUAL SV* sv_setref_iv _((SV* rv, char* classname, IV iv)); VIRTUAL SV* sv_setref_nv _((SV* rv, char* classname, double nv)); VIRTUAL SV* sv_setref_pv _((SV* rv, char* classname, void* pv)); VIRTUAL SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n)); VIRTUAL void sv_setpv _((SV* sv, const char* ptr)); - VIRTUAL void sv_setpv_mg _((SV *sv, const char *ptr)); VIRTUAL void sv_setpvn _((SV* sv, const char* ptr, STRLEN len)); - VIRTUAL void sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len)); VIRTUAL void sv_setsv _((SV* dsv, SV* ssv)); - VIRTUAL void sv_setsv_mg _((SV *dstr, SV *sstr)); VIRTUAL void sv_taint _((SV* sv)); VIRTUAL bool sv_tainted _((SV* sv)); VIRTUAL int sv_unmagic _((SV* sv, int type)); --- 577,593 ---- *************** *** 598,604 **** VIRTUAL void sv_untaint _((SV* sv)); VIRTUAL bool sv_upgrade _((SV* sv, U32 mt)); VIRTUAL void sv_usepvn _((SV* sv, char* ptr, STRLEN len)); - VIRTUAL void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len)); VIRTUAL void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale)); --- 595,600 ---- *************** *** 885,888 **** --- 881,902 ---- #else VIRTUAL void byterun _((PerlIO *fp)); #endif /* INDIRECT_BGET_MACROS */ + + VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...)); + VIRTUAL void sv_catpv_mg _((SV *sv, char *ptr)); + VIRTUAL void sv_catpvn_mg _((SV *sv, char *ptr, STRLEN len)); + VIRTUAL void sv_catsv_mg _((SV *dstr, SV *sstr)); + VIRTUAL void sv_setpvf_mg _((SV *sv, const char* pat, ...)); + VIRTUAL void sv_setiv_mg _((SV *sv, IV i)); + VIRTUAL void sv_setpviv_mg _((SV *sv, IV iv)); + VIRTUAL void sv_setuv_mg _((SV *sv, UV u)); + VIRTUAL void sv_setnv_mg _((SV *sv, double num)); + VIRTUAL void sv_setpv_mg _((SV *sv, const char *ptr)); + VIRTUAL void sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len)); + VIRTUAL void sv_setsv_mg _((SV *dstr, SV *sstr)); + VIRTUAL void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len)); + + /* New virtual functions must be added here to maintain binary + * compatablity with PERL_OBJECT + */ Index: regcomp.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/regcomp.c Fri Jul 24 00:02:06 1998 --- perl5.005_02/regcomp.c Tue Aug 4 22:33:43 1998 *************** *** 306,312 **** } if (OP(scan) != CURLYX) { ! int max = (reg_off_by_arg[OP(scan)] ? I32_MAX : U16_MAX); int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan)); int noff; regnode *n = scan; --- 306,315 ---- } if (OP(scan) != CURLYX) { ! int max = (reg_off_by_arg[OP(scan)] ! ? I32_MAX ! /* I32 may be smaller than U16 on CRAYs! */ ! : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan)); int noff; regnode *n = scan; Index: regexec.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/regexec.c Fri Jul 24 00:02:07 1998 --- perl5.005_02/regexec.c Tue Aug 4 22:33:43 1998 *************** *** 619,628 **** } else { STRLEN len; char *little = SvPV(prog->float_substr, len); ! last = rninstr(s, strend, little, little + len); } if (last == NULL) goto phooey; /* Should not happen! */ ! dontbother = strend - last - 1; } if (minlen && (dontbother < minlen)) dontbother = minlen - 1; --- 619,631 ---- } else { STRLEN len; char *little = SvPV(prog->float_substr, len); ! if (len) ! last = rninstr(s, strend, little, little + len); ! else ! last = strend; /* matching `$' */ } if (last == NULL) goto phooey; /* Should not happen! */ ! dontbother = strend - last + prog->float_min_offset; } if (minlen && (dontbother < minlen)) dontbother = minlen - 1; *************** *** 638,646 **** goto phooey; got_it: - strend += dontbother; /* uncheat */ prog->subbeg = strbeg; ! prog->subend = strend; RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); /* make sure $`, $&, $', and $digit will work later */ --- 641,648 ---- goto phooey; got_it: prog->subbeg = strbeg; ! prog->subend = PL_regeol; /* strend may have been modified */ RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); /* make sure $`, $&, $', and $digit will work later */ *************** *** 652,658 **** } } else { ! I32 i = strend - startpos + (stringarg - strbeg); s = savepvn(strbeg, i); Safefree(prog->subbase); prog->subbase = s; --- 654,660 ---- } } else { ! I32 i = PL_regeol - startpos + (stringarg - strbeg); s = savepvn(strbeg, i); Safefree(prog->subbase); prog->subbase = s; *************** *** 1244,1250 **** } if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) { PL_reg_flags |= RF_warned; ! warn("count exceeded %d", REG_INFTY - 1); } /* Failed deeper matches of scan, so see if this one works. */ --- 1246,1254 ---- } if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) { PL_reg_flags |= RF_warned; ! warn("%s limit (%d) exceeded", ! "Complex regular subexpression recursion", ! REG_INFTY - 1); } /* Failed deeper matches of scan, so see if this one works. */ Index: scope.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/scope.c Fri Jul 24 00:02:08 1998 --- perl5.005_02/scope.c Sun Aug 2 02:08:11 1998 *************** *** 382,388 **** #ifdef USE_THREADS dTHR; SV **svp = &THREADSV(i); /* XXX Change to save by offset */ ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", i, svp, *svp, SvPEEK(*svp))); save_svref(svp); return svp; --- 382,388 ---- #ifdef USE_THREADS dTHR; SV **svp = &THREADSV(i); /* XXX Change to save by offset */ ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", i, svp, *svp, SvPEEK(*svp))); save_svref(svp); return svp; *************** *** 567,573 **** ptr = SSPOPPTR; restore_sv: sv = *(SV**)ptr; ! DEBUG_L(PerlIO_printf(PerlIO_stderr(), "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && --- 567,573 ---- ptr = SSPOPPTR; restore_sv: sv = *(SV**)ptr; ! DEBUG_S(PerlIO_printf(PerlIO_stderr(), "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && Index: sv.c ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/sv.c Fri Jul 24 00:02:10 1998 --- perl5.005_02/sv.c Sun Aug 2 01:15:08 1998 *************** *** 2097,2103 **** if (sflags & SVf_ROK) { if (dtype >= SVt_PV) { if (dtype == SVt_PVGV) { - dTHR; SV *sref = SvREFCNT_inc(SvRV(sstr)); SV *dref = 0; int intro = GvINTRO(dstr); --- 2097,2102 ---- *************** *** 2885,2891 **** stash = NULL; switch (SvTYPE(sv)) { case SVt_PVIO: ! if (IoIFP(sv) != PerlIO_stdin() && IoIFP(sv) != PerlIO_stdout() && IoIFP(sv) != PerlIO_stderr()) io_close((IO*)sv); --- 2884,2891 ---- stash = NULL; switch (SvTYPE(sv)) { case SVt_PVIO: ! if (IoIFP(sv) && ! IoIFP(sv) != PerlIO_stdin() && IoIFP(sv) != PerlIO_stdout() && IoIFP(sv) != PerlIO_stderr()) io_close((IO*)sv); *************** *** 3540,3549 **** --- 3540,3563 ---- *(d--) = '0'; } else { + #ifdef EBCDIC + /* MKS: The original code here died if letters weren't consecutive. + * at least it didn't have to worry about non-C locales. The + * new code assumes that ('z'-'a')==('Z'-'A'), letters are + * arranged in order (although not consecutively) and that only + * [A-Za-z] are accepted by isALPHA in the C locale. + */ + if (*d != 'z' && *d != 'Z') { + do { ++*d; } while (!isALPHA(*d)); + return; + } + *(d--) -= 'z' - 'a'; + #else ++*d; if (isALPHA(*d)) return; *(d--) -= 'z' - 'a' + 1; + #endif } } /* oh,oh, the number grew */ Index: t/TEST ####### perl5.005_02/ => perl5.005_02 *** perl5.005_02/t/TEST Fri Jul 24 00:02:11 1998 --- perl5.005_02/t/TEST Sun Aug 2 19:33:55 1998 *************** *** 48,53 **** --- 48,61 ---- $total = @tests; $files = 0; $totmax = 0; + $maxlen = 0; + foreach (@tests) { + $len = length; + $maxlen = $len if $len > $maxlen; + } + # +3 : we want three dots between the test name and the "ok" + # -2 : the .t suffix + $dotdotdot = $maxlen + 3 - 2; while ($test = shift @tests) { if ( $infinite{$test} && $type eq 'compile' ) { *************** *** 59,65 **** } $te = $test; chop($te); ! print "$te" . '.' x (18 - length($te)); open(SCRIPT,"<$test") or die "Can't run $test.\n"; $_ =