diff options
| author | Charles Bailey <bailey@newman.upenn.edu> | 2000-03-13 02:31:44 +0000 |
|---|---|---|
| committer | bailey <bailey@newman.upenn.edu> | 2000-03-13 02:31:44 +0000 |
| commit | a32e82edde068d007913f66170d881838f070558 (patch) | |
| tree | b263f210818e8a9977e4a12080386f6af4a33282 | |
| parent | fd7385b97d6c0b537b272f194ad6f88a70d3dd39 (diff) | |
| parent | 24ef60581ee187bb6d4388e124dfc34b8cf0b663 (diff) | |
| download | perl-a32e82edde068d007913f66170d881838f070558.tar.gz | |
Resync with mainline post RC1
p4raw-id: //depot/vmsperl@5690
134 files changed, 3928 insertions, 1290 deletions
@@ -95,6 +95,1107 @@ Version v5.6.0 -------------- ____________________________________________________________________________ +[ 5676] By: gsar on 2000/03/12 11:27:38 + Log: don't bother testing if we can flush all handles when fflush(stdin) + shows the pipe bug + Branch: perl + ! Configure +____________________________________________________________________________ +[ 5675] By: jhi on 2000/03/12 05:08:29 + Log: continue flogging the string->int conversion ifdefs + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5674] By: gsar on 2000/03/12 05:01:30 + Log: fix File::DosGlob for patterns with drive names like c:*.bat + (suggested by Jason Mathews <mathews@computer.org>) + Branch: perl + ! lib/File/DosGlob.pm +____________________________________________________________________________ +[ 5673] By: jhi on 2000/03/12 04:48:14 + Log: Integrate with Sarathy. + Branch: cfgperl + !> doop.c perl.h pod/perldelta.pod pod/perldiag.pod + !> pod/perlpod.pod toke.c utils/perldoc.PL +____________________________________________________________________________ +[ 5672] By: gsar on 2000/03/12 03:57:23 + Log: security fixes for perldoc (from Tom Christiansen) + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 5671] By: gsar on 2000/03/12 03:45:27 + Log: Larry's patch to disallow CORE::Snark, with perldiag entry + Branch: perl + ! pod/perldelta.pod pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 5670] By: gsar on 2000/03/12 03:36:17 + Log: insufficient buffer in change#5317 + Branch: perl + ! doop.c +____________________________________________________________________________ +[ 5669] By: gsar on 2000/03/12 03:15:29 + Log: avoid L<foo|bar> for now, not all the pod2foo support it + Branch: perl + ! pod/perlpod.pod +____________________________________________________________________________ +[ 5668] By: gsar on 2000/03/12 02:35:55 + Log: rework change#5664 + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 5667] By: jhi on 2000/03/11 21:35:29 + Log: todo and perldelta updates + Branch: cfgperl + ! Todo Todo-5.6 pod/perldelta.pod +____________________________________________________________________________ +[ 5666] By: jhi on 2000/03/11 21:00:34 + Log: Integrate with Sarathy. + Branch: cfgperl + !> perl.h +____________________________________________________________________________ +[ 5665] By: jhi on 2000/03/11 20:58:58 + Log: Fixes for #5661. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5664] By: gsar on 2000/03/11 19:50:06 + Log: fix Strtoul() misdefinition is change#5661 + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 5663] By: gsar on 2000/03/11 19:21:18 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure config_h.SH hints/solaris_2.sh perl.h + !> t/pragma/warn/pp_hot toke.c +____________________________________________________________________________ +[ 5662] By: jhi on 2000/03/11 19:06:20 + Log: Integrate with Sarathy. + Branch: cfgperl + !> cop.h perl.c pp_ctl.c t/op/eval.t t/op/misc.t +____________________________________________________________________________ +[ 5661] By: jhi on 2000/03/11 19:03:32 + Log: Use Atof() instead of bare strtod(); ditto for Atol()/Atoul() + (introduce the latter) instead of bare strtoll()/strtoll(). + Branch: cfgperl + ! perl.h toke.c +____________________________________________________________________________ +[ 5660] By: gsar on 2000/03/11 18:40:49 + Log: another long-standing eval bug: return doesn't reset $@ correctly + Branch: perl + ! pp_ctl.c t/op/eval.t +____________________________________________________________________________ +[ 5659] By: jhi on 2000/03/11 18:27:54 + Log: metaconfig-ify the test for broken fflush(NULL) + (which ails e.g. Solaris), from Ulrich Pfeifer. + Branch: cfgperl + ! Configure config_h.SH hints/solaris_2.sh + Branch: metaconfig/U/perl + ! d_unorderedl.U fflushall.U +____________________________________________________________________________ +[ 5658] By: gsar on 2000/03/11 18:11:22 + Log: change#3511 was not defensive enough about try blocks, causing + bogus attempts to free closures, and thence, segfaults + Branch: perl + ! cop.h perl.c pp_ctl.c t/op/misc.t +____________________________________________________________________________ +[ 5657] By: jhi on 2000/03/11 18:04:44 + Log: Rewording. + Branch: cfgperl + ! t/pragma/warn/pp_hot +____________________________________________________________________________ +[ 5656] By: jhi on 2000/03/11 17:41:29 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 27 files) +____________________________________________________________________________ +[ 5655] By: gsar on 2000/03/11 17:06:03 + Log: reword comment + Branch: perl + ! t/pragma/warn/pp_hot +____________________________________________________________________________ +[ 5654] By: gsar on 2000/03/11 17:01:47 + Log: off-by-one in os2.c (from Ilya Zakharevich) + Branch: perl + ! os2/os2.c +____________________________________________________________________________ +[ 5653] By: gsar on 2000/03/11 16:59:48 + Log: File::Spec::VMS fixups, *not tested* on VMS (from Barrie Slaymaker) + Branch: perl + ! lib/File/Spec/VMS.pm t/lib/filespec.t +____________________________________________________________________________ +[ 5652] By: gsar on 2000/03/11 16:52:03 + Log: missing export list entry in change#5619 + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5651] By: gsar on 2000/03/11 16:50:05 + Log: avoid using context pointer in MUTEX_INIT() et al; remove the + *_NOCONTEXT variants to keep it simple + Branch: perl + ! malloc.c thread.h win32/win32thread.h +____________________________________________________________________________ +[ 5650] By: gsar on 2000/03/11 16:07:35 + Log: remove =for section (from Johan Vromans) + Branch: perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 5649] By: gsar on 2000/03/11 16:05:50 + Log: add nokfile target in Makefile (from Andy Dougherty) + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 5648] By: gsar on 2000/03/11 16:02:53 + Log: mention podchecker (from Tim Jenness <timj@jach.hawaii.edu>) + Branch: perl + ! pod/perlpod.pod +____________________________________________________________________________ +[ 5647] By: gsar on 2000/03/11 16:01:03 + Log: VMS build tweaks (from Charles Bailey) + Branch: perl + ! configure.com perl.c t/pragma/warn/doio t/pragma/warn/util + ! vms/subconfigure.com +____________________________________________________________________________ +[ 5646] By: gsar on 2000/03/11 10:13:27 + Log: remove outdated ftp.cis.ufl.edu reference + Branch: perl + ! pod/perlfaq2.pod +____________________________________________________________________________ +[ 5645] By: gsar on 2000/03/11 10:10:39 + Log: failed hunk in change#5644 + Branch: perl + ! t/op/pat.t +____________________________________________________________________________ +[ 5644] By: gsar on 2000/03/11 10:08:47 + Log: fix optimizer bug in /^(?p{"a"})b/ (from Ilya Zakharevich) + Branch: perl + ! regcomp.c t/op/pat.t +____________________________________________________________________________ +[ 5643] By: gsar on 2000/03/11 09:48:30 + Log: better {local,gm}time documentation (from Mark-Jason Dominus) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 5642] By: gsar on 2000/03/11 09:45:10 + Log: tweaks for lynxos build (from Ed Mooring <mooring@lynx.com>) + Branch: perl + ! doio.c hints/lynxos.sh perl.h +____________________________________________________________________________ +[ 5641] By: gsar on 2000/03/11 09:42:56 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Todo-5.6 config_h.SH hints/irix_6.sh + !> lib/Math/Complex.pm regcomp.c t/op/64bit.t +____________________________________________________________________________ +[ 5640] By: gsar on 2000/03/11 09:24:30 + Log: perldelta update, typos and whitespace adjustments + Branch: perl + ! lib/open.pm miniperlmain.c pod/perldelta.pod win32/perllib.c +____________________________________________________________________________ +[ 5639] By: jhi on 2000/03/11 00:51:48 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 44 files) +____________________________________________________________________________ +[ 5638] By: jhi on 2000/03/11 00:45:46 + Log: Cpp out deadcode that IRIX compiler noticed. + Branch: cfgperl + ! regcomp.c +____________________________________________________________________________ +[ 5637] By: jhi on 2000/03/10 14:22:24 + Log: Do not use Perl's malloc in IRIX. + Branch: cfgperl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 5636] By: jhi on 2000/03/10 05:27:03 + Log: More/modified unused floating point units. + Branch: metaconfig/U/perl + + d_fp_class_l.U d_unordered.U d_unorderedl.U + ! d_fpclass.U +____________________________________________________________________________ +[ 5635] By: jhi on 2000/03/10 01:54:07 + Log: Add various yet-unused units. + Branch: metaconfig/U/perl + + d_class.U d_fchdir.U d_finite.U d_fp_class.U d_fp_classl.U + + d_fpclass.U d_fpclassify.U d_frexpl.U d_futimes.U + + d_getitimer.U d_getrlimit.U d_iconv.U d_isfinite.U d_isinf.U + + d_isnan.U d_isnanl.U d_lchmod.U d_lutimes.U d_setitimer.U + + d_setrlimit.U d_ualarm.U d_utimes.U +____________________________________________________________________________ +[ 5634] By: jhi on 2000/03/10 01:07:54 + Log: Fix goofups noticed by Mark Bixby and Jeff Okamoto. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/compline/nblock_io.U + Branch: metaconfig/U/perl + ! use64bits.U +____________________________________________________________________________ +[ 5633] By: jhi on 2000/03/09 23:22:33 + Log: Remove an obsolete note. + Branch: cfgperl + ! t/op/64bit.t +____________________________________________________________________________ +[ 5632] By: gsar on 2000/03/09 18:50:43 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ +[ 5631] By: gsar on 2000/03/09 18:49:12 + Log: track more of the child state on Windows + Branch: perl + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 5630] By: gsar on 2000/03/09 18:48:05 + Log: UNIVERSAL::isa() and UNIVERSAL::can() fail for magic values + Branch: perl + ! universal.c +____________________________________________________________________________ +[ 5629] By: gsar on 2000/03/09 18:37:35 + Log: tweak Unicode notes, other cleanups + Branch: perl + ! Changes lib/bytes.pm lib/utf8.pm pod/perldelta.pod + ! pod/perlhist.pod pod/perlunicode.pod +____________________________________________________________________________ +[ 5628] By: gsar on 2000/03/09 17:39:58 + Log: support binmode(F,":crlf") and use open IN => ":raw", OUT => ":crlf" + semantics; the pragma sets defaults for both open() and qx// + Branch: perl + ! doio.c dosish.h embed.h embed.pl epoc/epocish.h lib/open.pm + ! mpeix/mpeixish.h op.c op.h opcode.h opcode.pl os2/os2ish.h + ! perl.h perlapi.c plan9/plan9ish.h pod/perlfunc.pod pp.sym + ! pp_proto.h pp_sys.c proto.h sv.h vms/vmsish.h vos/vosish.h +____________________________________________________________________________ +[ 5627] By: gsar on 2000/03/09 12:54:08 + Log: avoid autoflushing behavior of fork/system/exec on Solaris (thanks + to fflush(NULL) bug) + Branch: perl + ! hints/solaris_2.sh pod/perldelta.pod +____________________________________________________________________________ +[ 5626] By: gsar on 2000/03/09 11:34:51 + Log: abort build on HP-UX if bundled non-ANSI compiler is detected + (from Dominic Dunlop <domo@computer.org>) + Branch: perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5625] By: gsar on 2000/03/09 11:17:07 + Log: patch from Larry to make -T filetest algorithm recognize utf8 as + "text" + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 5624] By: gsar on 2000/03/09 11:11:59 + Log: provide support for deleting actions etc. (from Ronald J Kimball + <rjk@linguist.dartmouth.edu>) + Branch: perl + ! lib/perl5db.pl pod/perldebug.pod +____________________________________________________________________________ +[ 5623] By: gsar on 2000/03/09 06:39:21 + Log: new xsubpp keywords should be in all caps + Branch: perl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 5622] By: gsar on 2000/03/09 06:26:04 + Log: demand-load utf8.pm in swash routines + Branch: perl + ! op.c utf8.c +____________________________________________________________________________ +[ 5621] By: gsar on 2000/03/08 19:27:02 + Log: make Dump() call the XSUB implementation transparently (modified + version of patch suggested by David Boyce <dsb@world.std.com>) + Branch: perl + ! ext/Data/Dumper/Dumper.pm ext/Data/Dumper/Dumper.xs + ! pod/perldelta.pod +____________________________________________________________________________ +[ 5620] By: gsar on 2000/03/08 18:35:48 + Log: do FILE should not see outside lexicals (from Rick Delaney + <rick@consumercontact.com>) + Branch: perl + ! op.c pp_ctl.c t/comp/require.t +____________________________________________________________________________ +[ 5619] By: gsar on 2000/03/08 18:04:45 + Log: abstract code for C<use Foo 1.23 @ary;> into a Perl_load_module() + API function + Branch: perl + ! doio.c embed.h embed.pl global.sym objXSUB.h op.c op.h + ! perlapi.c pp_sys.c proto.h +____________________________________________________________________________ +[ 5618] By: jhi on 2000/03/08 18:03:30 + Log: Integrate with Sarathy. + Branch: cfgperl + +> lib/Pod/Plainer.pm + !> Changes MANIFEST dosish.h embedvar.h lib/Pod/InputObjects.pm + !> lib/Pod/Parser.pm makedef.pl op.c op.h perl.c perlapi.h + !> perlvars.h pod/perlop.pod pod/pod2latex.PL sv.c unixish.h + !> vms/vmsish.h +____________________________________________________________________________ +[ 5617] By: jhi on 2000/03/08 15:44:05 + Log: ICU todo fixes. + Branch: cfgperl + ! Todo-5.6 +____________________________________________________________________________ +[ 5616] By: jhi on 2000/03/08 14:30:40 + Log: Even more Todo. + Branch: cfgperl + ! Todo-5.6 +____________________________________________________________________________ +[ 5615] By: jhi on 2000/03/08 14:13:45 + Log: More Todo. + Branch: cfgperl + ! Todo-5.6 +____________________________________________________________________________ +[ 5614] By: jhi on 2000/03/08 13:50:53 + Log: wording changes + Branch: cfgperl + ! lib/Math/Complex.pm +____________________________________________________________________________ +[ 5613] By: gsar on 2000/03/08 12:51:35 + Log: clarify docs on return value from binding operators + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 5612] By: gsar on 2000/03/08 12:41:38 + Log: shore up pod2latex shortcomings, and a Pod::Parser fix (from + Robin Barker) + Branch: perl + + lib/Pod/Plainer.pm + ! MANIFEST lib/Pod/Parser.pm pod/pod2latex.PL +____________________________________________________________________________ +[ 5611] By: gsar on 2000/03/08 12:22:59 + Log: integrate cfgperl changes into mainline + Branch: perl + ! Changes + !> installperl lib/Math/Complex.pm pod/perldelta.pod + !> t/lib/complex.t vms/vmsish.h +____________________________________________________________________________ +[ 5610] By: gsar on 2000/03/08 12:08:17 + Log: add missing locks for op refcounts + Branch: perl + ! dosish.h embedvar.h makedef.pl op.c op.h perl.c perlapi.h + ! perlvars.h sv.c unixish.h vms/vmsish.h +____________________________________________________________________________ +[ 5609] By: gsar on 2000/03/08 11:30:32 + Log: Pod::InputObjects tweak (from Brad Appleton) + Branch: perl + ! lib/Pod/InputObjects.pm +____________________________________________________________________________ +[ 5608] By: jhi on 2000/03/08 05:08:59 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 27 files) +____________________________________________________________________________ +[ 5607] By: jhi on 2000/03/08 05:07:06 + Log: Make the stringification more customizable. + A potentially backward incompatible change. + Based on a suggestion by Roman Kosenko <ra@amk.al.lg.ua>. + Branch: cfgperl + ! lib/Math/Complex.pm pod/perldelta.pod t/lib/complex.t +____________________________________________________________________________ +[ 5606] By: jhi on 2000/03/08 00:49:14 + Log: s/lfs/largefiles/ + Branch: metaconfig + ! U/mksample +____________________________________________________________________________ +[ 5605] By: gsar on 2000/03/07 23:37:48 + Log: VMS build patch (from Peter Prymmer) + Branch: perl + ! configure.com installhtml lib/lib.pm vms/descrip_mms.template + ! vms/subconfigure.com vms/vms.c +____________________________________________________________________________ +[ 5604] By: gsar on 2000/03/07 23:25:46 + Log: CopFILEGV(&PL_compiling) must be reset properly (from Doug MacEachern) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5603] By: gsar on 2000/03/07 23:05:16 + Log: type mismatch + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 5602] By: gsar on 2000/03/07 22:40:55 + Log: add note to INSTALL about C++ compilers (from M J T Guy) + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 5601] By: gsar on 2000/03/07 22:30:35 + Log: separate options to incpush() for adding version directories and + architecture directories (from Andy Dougherty) + Branch: perl + ! embed.h embed.pl perl.c proto.h t/lib/fatal.t +____________________________________________________________________________ +[ 5600] By: gsar on 2000/03/07 20:18:54 + Log: support :void to enable croaking only in void context (from + Simon Cozens <simon@othersideofthe.earth.li>) + Branch: perl + ! lib/Fatal.pm t/lib/fatal.t +____________________________________________________________________________ +[ 5599] By: gsar on 2000/03/07 18:35:21 + Log: Pod::Html tweak to avoid false falses + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 5598] By: gsar on 2000/03/07 18:21:58 + Log: skip null siblings encountered by goto out of loopish block + (from Doug Lankshear) + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 5597] By: gsar on 2000/03/07 16:33:29 + Log: omit XSLoader from bytecode dumps + Branch: perl + ! ext/B/B/Bytecode.pm ext/B/B/Stash.pm ext/B/B/Xref.pm +____________________________________________________________________________ +[ 5596] By: gsar on 2000/03/07 10:58:17 + Log: avoid coredump on C<printf "%vd"> + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 5595] By: gsar on 2000/03/07 10:26:03 + Log: add missing HTML escapes that can be displayed in xterm (from + Tim Jenness <timj@jach.hawaii.edu>) + Branch: perl + ! lib/Pod/Text.pm +____________________________________________________________________________ +[ 5594] By: gsar on 2000/03/07 10:24:55 + Log: Fatal.pm pod tweak (from Matt Sergeant <matt@sergeant.org>) + Branch: perl + ! lib/Fatal.pm +____________________________________________________________________________ +[ 5593] By: gsar on 2000/03/07 09:57:24 + Log: get ByteLoader working again + Branch: perl + ! bytecode.pl ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm + ! ext/B/B/C.pm ext/ByteLoader/bytecode.h + ! ext/ByteLoader/byterun.c +____________________________________________________________________________ +[ 5592] By: gsar on 2000/03/07 05:14:49 + Log: typo in makedef.pl + Branch: perl + ! lib/File/Path.pm makedef.pl +____________________________________________________________________________ +[ 5591] By: jhi on 2000/03/06 22:56:24 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes ext/File/Glob/Glob.xs lib/Pod/Html.pm +____________________________________________________________________________ +[ 5590] By: gsar on 2000/03/06 22:32:44 + Log: fix incorrect prototypes in File::Glob + Branch: perl + ! ext/File/Glob/Glob.xs +____________________________________________________________________________ +[ 5589] By: gsar on 2000/03/06 22:07:38 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ +[ 5588] By: jhi on 2000/03/06 21:46:18 + Log: From: "Craig A. Berry" <craig.berry@metamorgs.com> + To: vmsperl@perl.org, perl5-porters@perl.org + Cc: jhi@iki.fi, Charles Bailey <BAILEY@newman.upenn.edu>, gsar@activestate.com + Subject: [PATCH 5.5.670] circumvent VMS fileno bug in old DEC C version + Date: Mon, 06 Mar 2000 15:36:13 -0600 + Message-Id: <4.2.2.20000306153539.00ca6420@exchi01.midwest.metamorgs.com> + Branch: cfgperl + ! vms/vmsish.h +____________________________________________________________________________ +[ 5587] By: jhi on 2000/03/06 21:23:27 + Log: Use $^O. + Branch: cfgperl + ! installperl +____________________________________________________________________________ +[ 5586] By: jhi on 2000/03/06 21:19:15 + Log: Undo drift from the mainline. + Branch: cfgperl + !> (integrate 1607 files) +____________________________________________________________________________ +[ 5585] By: gsar on 2000/03/06 20:23:37 + Log: change#5513 accidentally undid change#5373, put it back + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 5584] By: jhi on 2000/03/06 17:30:48 + Log: Integrate with Sarathy. + Branch: cfgperl + !> lib/File/Path.pm lib/Getopt/Long.pm lib/IPC/Open2.pm + !> lib/Pod/Man.pm makedef.pl toke.c vms/subconfigure.com +____________________________________________________________________________ +[ 5583] By: gsar on 2000/03/06 17:02:52 + Log: makedef.pl typos + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5582] By: gsar on 2000/03/06 15:24:14 + Log: Pod::Man bugfixes (from Russ Allbery) + Branch: perl + ! lib/Pod/Man.pm +____________________________________________________________________________ +[ 5581] By: gsar on 2000/03/06 15:17:08 + Log: File::Path::rmtree() doesn't delete stale symlinks correctly + Branch: perl + ! lib/File/Path.pm +____________________________________________________________________________ +[ 5580] By: gsar on 2000/03/06 14:55:57 + Log: pod nits + Branch: perl + ! lib/Getopt/Long.pm lib/IPC/Open2.pm +____________________________________________________________________________ +[ 5579] By: gsar on 2000/03/06 14:55:08 + Log: 64-bit build fix on VMS (from Dan Sugalski) + Branch: perl + ! toke.c vms/subconfigure.com +____________________________________________________________________________ +[ 5578] By: jhi on 2000/03/06 14:37:46 + Log: Integrate with Sarathy. + Branch: cfgperl + !> README.win32 configure.com iperlsys.h lib/File/Spec/VMS.pm + !> lib/IPC/Open2.pm lib/IPC/Open3.pm perl.c t/lib/filefind.t + !> t/lib/filespec.t vms/ext/filespec.t vms/subconfigure.com + !> vms/test.com vms/vms.c win32/config.bc win32/config.gc + !> win32/config.vc win32/config_H.bc win32/config_H.gc + !> win32/config_H.vc win32/config_h.PL win32/perlhost.h + !> win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 5577] By: gsar on 2000/03/06 07:26:18 + Log: skip tests that need VMS::Filespec on other platforms + Branch: perl + ! t/lib/filespec.t +____________________________________________________________________________ +[ 5576] By: gsar on 2000/03/06 07:11:21 + Log: integrate vmsperl contents into mainline + Branch: perl + !> configure.com lib/File/Spec/VMS.pm t/lib/filefind.t + !> t/lib/filespec.t vms/ext/filespec.t vms/subconfigure.com + !> vms/test.com vms/vms.c +____________________________________________________________________________ +[ 5575] By: gsar on 2000/03/06 07:05:34 + Log: support for autovivified handles (from Tom Christiansen) + Branch: perl + ! lib/IPC/Open2.pm lib/IPC/Open3.pm +____________________________________________________________________________ +[ 5574] By: gsar on 2000/03/06 06:31:55 + Log: vendorlib support for Windows; regen win32/config* + Branch: perl + ! README.win32 iperlsys.h perl.c win32/config.bc win32/config.gc + ! win32/config.vc win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/config_h.PL win32/perlhost.h + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 5573] By: bailey on 2000/03/06 05:23:23 + Log: Skip openpid.t while VMS subprocess intercommunication in flux (several vmsperlers) + Branch: vmsperl + ! vms/test.com +____________________________________________________________________________ +[ 5572] By: gsar on 2000/03/06 05:21:26 + Log: the incpush()es weren't all quite right on Windows in change#5559 + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5571] By: bailey on 2000/03/06 05:18:59 + Log: Fix ricochet in File::Spec::VMS + Fix eval error in filespec.t + Misc. minor fixes in filespec.t + Branch: vmsperl + ! lib/File/Spec/VMS.pm t/lib/filespec.t +____________________________________________________________________________ +[ 5570] By: gsar on 2000/03/06 05:00:44 + Log: integrate cfgperl changes into mainline + Branch: perl + !> Configure Makefile.SH Porting/Glossary Porting/config.sh + !> Porting/config_H config_h.SH epoc/config.sh + !> ext/DynaLoader/DynaLoader_pm.PL hints/aix.sh patchlevel.h + !> perl.c perl.h toke.c vos/config.def vos/config.h + !> vos/config_h.SH_orig +____________________________________________________________________________ +[ 5569] By: jhi on 2000/03/06 04:51:39 + Log: Integrate with Sarathy. + Branch: cfgperl + !> installperl pp.c +____________________________________________________________________________ +[ 5568] By: gsar on 2000/03/06 04:48:17 + Log: installperl wasn't putting extensions with two or more + nested package names in the archlib + Branch: perl + ! installperl +____________________________________________________________________________ +[ 5567] By: bailey on 2000/03/06 03:43:36 + Log: Set up for vendorarch (and fix 64bitint typo) (Dan Sugalski) + Branch: vmsperl + ! configure.com vms/subconfigure.com +____________________________________________________________________________ +[ 5566] By: bailey on 2000/03/06 03:40:14 + Log: Change $Config{'extensions'} to look Unixy (Charles Lane) + FIx logic error in glob-basic.t (Charles Lane) + Branch: vmsperl + ! configure.com vms/subconfigure.com +____________________________________________________________________________ +[ 5565] By: bailey on 2000/03/06 03:37:46 + Log: Remove trailing . from typeless files (Charles Lane) + Branch: vmsperl + ! t/lib/filefind.t +____________________________________________________________________________ +[ 5564] By: bailey on 2000/03/06 03:36:26 + Log: Resync with mainline, update test in vmsfspec.t + Branch: vmsperl + +> lib/Term/ANSIColor.pm t/lib/ansicolor.t + ! vms/ext/filespec.t + !> (integrate 171 files) +____________________________________________________________________________ +[ 5563] By: gsar on 2000/03/06 03:29:11 + Log: avoid warning + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 5562] By: bailey on 2000/03/06 02:48:17 + Log: Downcase function call to hush picky cc + Branch: vmsperl + ! vms/vms.c +____________________________________________________________________________ +[ 5561] By: jhi on 2000/03/06 00:23:22 + Log: VOS patch from Paul Green. Note that the vos/config_h.SH_orig + is not exactly identical to the current config_h.SH because + Paul needs better $sitearch control. + Branch: cfgperl + ! vos/config.def vos/config.h vos/config_h.SH_orig +____________________________________________________________________________ +[ 5560] By: jhi on 2000/03/05 23:26:41 + Log: Avoid wiping out @dl_{librefs,modules} when XSLoader + falls back to DynaLoader. + + From: Doug MacEachern <dougm@pobox.com> + To: perl5-porters@perl.org + Subject: [PATCH v5.5.670] maintain DynaLoader::dl_{librefs,modules} + Date: Sun, 5 Mar 2000 15:19:01 -0800 (PST) + Message-ID: <Pine.LNX.4.10.10003051509460.16885-100000@mojo.covalent.net> + Branch: cfgperl + ! ext/DynaLoader/DynaLoader_pm.PL +____________________________________________________________________________ +[ 5559] By: jhi on 2000/03/05 22:05:54 + Log: sitelib_stem and vendorlib_stem patches from Andy; + problem reported in + From: schwern@athens.arena-i.com (Michael G Schwern) + To: perl5-porters@perl.org + Subject: [ID 20000305.001] [BUG 5.5.670 perl.c] SITELIB_EXP mangled by hack. + Date: Sun, 5 Mar 2000 06:31:29 -0500 (EST) + Message-Id: <20000305113129.80DC23820@athens.arena-i.com> + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH epoc/config.sh patchlevel.h perl.c perl.h + ! vos/config.def vos/config.h vos/config_h.SH_orig + Branch: metaconfig + ! U/installdirs/instubperl.U U/installdirs/sitelib.U + ! U/installdirs/vendorlib.U +____________________________________________________________________________ +[ 5558] By: jhi on 2000/03/05 21:18:59 + Log: Integrate with Sarathy. + Branch: cfgperl + !> hints/linux.sh lib/Getopt/Long.pm +____________________________________________________________________________ +[ 5557] By: gsar on 2000/03/05 20:35:13 + Log: Getopt-Long v2.21 update (from Johan Vromans) + Branch: perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 5556] By: gsar on 2000/03/05 20:26:57 + Log: Linux needs -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 too + (from Matthias Urlichs <smurf@noris.net>) + Branch: perl + ! hints/linux.sh +____________________________________________________________________________ +[ 5555] By: jhi on 2000/03/05 20:15:34 + Log: Integrate with Sarathy. + Branch: cfgperl + +> lib/Term/ANSIColor.pm t/lib/ansicolor.t + !> MANIFEST lib/Pod/InputObjects.pm opcode.h opcode.pl + !> pod/perldelta.pod pod/perlfunc.pod pp.c pp_sys.c + !> t/comp/proto.t toke.c utils/perlbug.PL +____________________________________________________________________________ +[ 5554] By: gsar on 2000/03/05 20:02:17 + Log: prototype changes for eventually supporting C<binmode(F, ":raw")> + and C<open F, "-|", 'cat', '-v'> + Branch: perl + ! opcode.h opcode.pl pod/perlfunc.pod pp.c pp_sys.c + ! t/comp/proto.t toke.c +____________________________________________________________________________ +[ 5553] By: jhi on 2000/03/05 19:55:02 + Log: AIX gcvt() cannot format long doubles very well. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 5552] By: jhi on 2000/03/05 18:44:37 + Log: the monster cpp expression needs to be on one line to + appease makedepend + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5551] By: jhi on 2000/03/05 18:24:32 + Log: IRIX cpp is fussy. + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5550] By: gsar on 2000/03/05 17:46:18 + Log: perlbug tweak to grok local_patches better + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 5549] By: gsar on 2000/03/05 17:33:10 + Log: add Term::ANSIColor, perldelta notes on Pod::Man, and fix a bug + in Pod::InputObjects (from Russ Allbery) + Branch: perl + + lib/Term/ANSIColor.pm t/lib/ansicolor.t + ! MANIFEST lib/Pod/InputObjects.pm pod/perldelta.pod +____________________________________________________________________________ +[ 5548] By: jhi on 2000/03/05 17:27:06 + Log: clean up the makedepend temp file + Branch: cfgperl + ! Makefile.SH +____________________________________________________________________________ +[ 5547] By: jhi on 2000/03/05 17:23:18 + Log: Integrate with Sarathy. + Branch: cfgperl + !> perl.c +____________________________________________________________________________ +[ 5546] By: jhi on 2000/03/05 17:16:12 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 47 files) +____________________________________________________________________________ +[ 5545] By: gsar on 2000/03/05 17:13:48 + Log: strip last component of SITELIB_EXP only if it looks like a + number + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5544] By: jhi on 2000/03/05 17:12:42 + Log: s/Perl/PeRl/; # yeah + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/cpp_stuff.U +____________________________________________________________________________ +[ 5543] By: gsar on 2000/03/05 16:54:10 + Log: thinko in change#4546 that caused variables to lose their importedness + (GvIMPORTED_XV_off should be !GvIMPORTED_XV) + Branch: perl + ! sv.c t/pragma/strict-vars +____________________________________________________________________________ +[ 5542] By: gsar on 2000/03/05 09:37:26 + Log: regen win32/config*, up version numbers &c. + Branch: perl + ! patchlevel.h win32/Makefile win32/config.bc win32/config.gc + ! win32/config.vc win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 5541] By: gsar on 2000/03/05 09:20:12 + Log: undo change#5506; add patch to make blank line warnings optional + (from Brad Appleton) + Branch: perl + ! lib/Pod/Checker.pm lib/Pod/Parser.pm t/pod/poderrs.xr +____________________________________________________________________________ +[ 5540] By: gsar on 2000/03/05 09:04:52 + Log: fixes for most warnings identified by gcc -Wall + Branch: perl + ! av.c cop.h deb.c doop.c dump.c embed.h embed.pl gv.c hv.c mg.c + ! miniperlmain.c objXSUB.h op.c perl.c perlapi.c pp.c pp_ctl.c + ! pp_hot.c pp_sys.c proto.h regcomp.c regexec.c regexp.h run.c + ! scope.c sv.c sv.h toke.c universal.c util.c xsutils.c +____________________________________________________________________________ +[ 5539] By: gsar on 2000/03/05 06:37:58 + Log: shup up warnings about dNOOP from gcc with __attribute__ ((unused)) + (from Doug MacEachern <dougm@pobox.com>) + Branch: perl + ! patchlevel.h perl.h +____________________________________________________________________________ +[ 5538] By: gsar on 2000/03/05 05:50:44 + Log: tyop + Branch: perl + ! config_h.SH +____________________________________________________________________________ +[ 5537] By: gsar on 2000/03/05 05:41:10 + Log: integrate cfgperl contents into mainline; add new tests from + inc.t into 64bit.t + Branch: perl + ! t/op/64bit.t + !> Configure config_h.SH hints/hpux.sh hints/sco.sh perl.h + !> pod/perl.pod toke.c +____________________________________________________________________________ +[ 5536] By: jhi on 2000/03/05 05:37:22 + Log: dethinko + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5535] By: jhi on 2000/03/05 05:14:40 + Log: Integrate with Sarathy. + Branch: cfgperl + !> pp.c t/op/inc.t toke.c +____________________________________________________________________________ +[ 5534] By: gsar on 2000/03/05 04:50:26 + Log: optimize change#5533 to stick to IVs if constant is <= IV_MAX, + since runtime is highly optimized for IVs rather than UVs + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 5533] By: gsar on 2000/03/05 04:30:02 + Log: scan_num() sticks to UVs rather than IVs (now -2147483648 doesn't + end up being promoted to an NV) + Branch: perl + ! pp.c t/op/inc.t toke.c +____________________________________________________________________________ +[ 5532] By: jhi on 2000/03/05 01:11:37 + Log: more cpp cosmetics, logic cleanup + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5531] By: jhi on 2000/03/05 00:51:20 + Log: Implement #5525 in metaconfig. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/cpp_stuff.U +____________________________________________________________________________ +[ 5530] By: jhi on 2000/03/05 00:32:51 + Log: Integrate with Sarathy. + Branch: cfgperl + !> config_h.SH doio.c lib/Cwd.pm lib/Pod/Html.pm lib/bytes.pm + !> lib/charnames.pm lib/filetest.pm lib/integer.pm lib/locale.pm + !> lib/overload.pm lib/utf8.pm os2/os2ish.h pod/perldebug.pod + !> t/lib/ipc_sysv.t t/pragma/warn/regcomp win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 5529] By: jhi on 2000/03/05 00:31:17 + Log: Sanity check on the strtoll and strtoull. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig/U/perl + ! d_strtoll.U d_strtoull.U +____________________________________________________________________________ +[ 5528] By: jhi on 2000/03/05 00:07:21 + Log: Reformat the fearful cpp expression to be a little bit less fearful. + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5527] By: gsar on 2000/03/04 21:55:03 + Log: make hints available via globals in the respective pragmas to + avoid duplicating the constants everywhere + Branch: perl + ! lib/bytes.pm lib/charnames.pm lib/filetest.pm lib/integer.pm + ! lib/locale.pm lib/overload.pm lib/utf8.pm +____________________________________________________________________________ +[ 5526] By: gsar on 2000/03/04 20:39:36 + Log: remove deadcode + Branch: perl + ! lib/Cwd.pm +____________________________________________________________________________ +[ 5525] By: gsar on 2000/03/04 19:42:55 + Log: make CAT2() portable for use as a macro argument with an extra + level of macros + Branch: perl + ! config_h.SH +____________________________________________________________________________ +[ 5524] By: gsar on 2000/03/04 19:02:27 + Log: avoid looking up stale PL_statbuf (spotted by Charles Lane + <lane@DUPHY4.Physics.Drexel.Edu>) + Branch: perl + ! doio.c +____________________________________________________________________________ +[ 5523] By: gsar on 2000/03/04 18:59:03 + Log: pod tweak + Branch: perl + ! pod/perldebug.pod +____________________________________________________________________________ +[ 5522] By: gsar on 2000/03/04 17:46:58 + Log: regen win32/config_H* + Branch: perl + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 5521] By: jhi on 2000/03/04 16:35:48 + Log: From: "Matthias Urlichs" <smurf@noris.net> + To: perl5-porters@perl.org + Subject: BUG: Integer floatifies? +PATCH: reading BIG integers with SMALL floats + Date: Sat, 4 Mar 2000 12:48:42 +0100 + Message-ID: <20000304124841.A8090@noris.de> + Branch: cfgperl + ! toke.c +____________________________________________________________________________ +[ 5520] By: jhi on 2000/03/04 15:41:12 + Log: unthink wishful thinking + Branch: cfgperl + ! pod/perl.pod +____________________________________________________________________________ +[ 5519] By: gsar on 2000/03/04 06:42:47 + Log: fix OS/2 coredump with POSIX::tmpnam() (from Ilya Zakharevich) + Branch: perl + ! os2/os2ish.h +____________________________________________________________________________ +[ 5518] By: gsar on 2000/03/04 06:02:26 + Log: avoid "scalars leaked" message in test + Branch: perl + ! t/pragma/warn/regcomp +____________________________________________________________________________ +[ 5517] By: jhi on 2000/03/04 06:01:16 + Log: detypo + Branch: cfgperl + ! pod/perl.pod +____________________________________________________________________________ +[ 5516] By: jhi on 2000/03/04 05:59:21 + Log: cleanup AVAILABILITY and mention binaries + Branch: cfgperl + ! pod/perl.pod +____________________________________________________________________________ +[ 5515] By: gsar on 2000/03/04 05:55:02 + Log: syntax error in change#5498 + Branch: perl + ! t/lib/ipc_sysv.t +____________________________________________________________________________ +[ 5514] By: jhi on 2000/03/04 05:50:56 + Log: assuming that removing the libbind will be a good idea + Branch: cfgperl + ! hints/sco.sh +____________________________________________________________________________ +[ 5513] By: gsar on 2000/03/04 05:50:15 + Log: Pod::Html fixups for nicer links to functions (from Wolfgang Laun + <wolfgang.laun@chello.at>) + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 5512] By: jhi on 2000/03/04 05:45:52 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 41 files) +____________________________________________________________________________ +[ 5511] By: jhi on 2000/03/04 05:42:37 + Log: HP-UX 64-bitness cures + Branch: cfgperl + ! hints/hpux.sh perl.h +____________________________________________________________________________ +[ 5510] By: gsar on 2000/03/04 05:40:08 + Log: better error messages when xsubpp fails to find map for a particular + type (from Ilya Zakharevich) + Branch: perl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 5509] By: jhi on 2000/03/04 05:33:27 + Log: scratch #5508 + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5508] By: jhi on 2000/03/04 05:31:19 + Log: In HP-UX there is a secret handshake to get strtoll and strtoull. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5507] By: gsar on 2000/03/04 04:27:51 + Log: more whitespace removal (from Michael G Schwern) + Branch: perl + ! ext/Data/Dumper/Dumper.pm ext/Errno/Errno_pm.PL + ! ext/File/Glob/Glob.pm ext/IO/lib/IO/Select.pm + ! ext/IO/lib/IO/Socket.pm ext/IO/lib/IO/Socket/INET.pm + ! ext/IPC/SysV/Msg.pm ext/IPC/SysV/Semaphore.pm lib/CGI.pm + ! lib/CGI/Cookie.pm lib/CGI/Fast.pm lib/CGI/Push.pm + ! lib/Carp/Heavy.pm lib/DB.pm lib/Exporter/Heavy.pm + ! lib/File/DosGlob.pm lib/File/Find.pm lib/Getopt/Long.pm + ! lib/Math/Trig.pm lib/Net/Ping.pm lib/Net/netent.pm + ! lib/SelfLoader.pm lib/Tie/Array.pm lib/Tie/Handle.pm + ! lib/Tie/Scalar.pm lib/Time/Local.pm lib/filetest.pm + ! lib/overload.pm x2p/s2p.PL +____________________________________________________________________________ +[ 5506] By: gsar on 2000/03/04 04:12:06 + Log: temporarily disable blank line warning from Pod::Parser until + it can be made optional + Branch: perl + ! lib/Pod/Parser.pm t/pod/poderrs.xr +____________________________________________________________________________ +[ 5505] By: gsar on 2000/03/04 04:00:44 + Log: rid blanks in pods (from Michael G Schwern) + Branch: perl + ! README.amiga README.dos README.os2 +____________________________________________________________________________ +[ 5504] By: gsar on 2000/03/04 03:59:07 + Log: avoid warnings from shmread() when given undefined variable + (from Tom Christiansen) + Branch: perl + ! doio.c +____________________________________________________________________________ +[ 5503] By: gsar on 2000/03/04 03:53:43 + Log: fpsetmask() needs include on freebsd (from Slaven Rezic + <eserte@vran.herceg.de>) + Branch: perl + ! unixish.h +____________________________________________________________________________ +[ 5502] By: gsar on 2000/03/04 03:51:05 + Log: avoid ambiguity in indirect object notation (breaks with overridden + run time require) + Branch: perl + ! lib/CGI.pm +____________________________________________________________________________ +[ 5501] By: gsar on 2000/03/04 01:08:54 + Log: adjust perldelta + Branch: perl + ! Todo-5.6 pod/perl.pod pod/perldelta.pod +____________________________________________________________________________ +[ 5500] By: gsar on 2000/03/04 00:33:49 + Log: integrate cfgperl contents into mainline + Branch: perl + !> hints/irix_6.sh hints/solaris_2.sh pod/perl.pod + !> pod/perlfunc.pod t/lib/ipc_sysv.t +____________________________________________________________________________ +[ 5499] By: jhi on 2000/03/03 22:51:53 + Log: solaris hints tweak + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5498] By: jhi on 2000/03/03 22:35:46 + Log: The SysV IPC test must use the native integers + (long or short), also noted this in the msgsnd/semctl + documentation. Reported in + + From: schwern@athens.arena-i.com (Michael G Schwern) + To: perl5-porters@perl.org + Subject: [ID 20000302.006] [BUG 5.5.670 t/ipc_sysv.t] Fails 2,5,6 with 64bit on Linux + Date: Thu, 2 Mar 2000 17:15:03 -0500 (EST) + Message-Id: <20000302221503.EDF6E3830@athens.arena-i.com> + Branch: cfgperl + ! pod/perlfunc.pod t/lib/ipc_sysv.t +____________________________________________________________________________ +[ 5497] By: jhi on 2000/03/03 21:08:53 + Log: Update AVAILABILITY. + Branch: cfgperl + ! pod/perl.pod +____________________________________________________________________________ +[ 5496] By: gsar on 2000/03/03 20:21:05 + Log: perldebug tweak (from M J T Guy) + Branch: perl + ! pod/perldebug.pod +____________________________________________________________________________ +[ 5495] By: jhi on 2000/03/03 19:32:58 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 79 files) +____________________________________________________________________________ +[ 5494] By: jhi on 2000/03/03 19:14:01 + Log: the workaround is needed in all 7.2.* compilers, + not just on IRIX64. + Branch: cfgperl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 5493] By: gsar on 2000/03/03 18:58:45 + Log: whitespace and readabiliti nits in the pods (from Michael G Schwern + and Robin Barker) + Branch: perl + ! Changes pod/perl.pod pod/perl5004delta.pod + ! pod/perl5005delta.pod pod/perlboot.pod pod/perldata.pod + ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod + ! pod/perlembed.pod pod/perlfaq.pod pod/perlfaq2.pod + ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq6.pod + ! pod/perlfaq7.pod pod/perlfaq8.pod pod/perlfaq9.pod + ! pod/perlfilter.pod pod/perlguts.pod pod/perlipc.pod + ! pod/perllexwarn.pod pod/perllocale.pod pod/perlmodinstall.pod + ! pod/perlmodlib.pod pod/perlobj.pod pod/perlopentut.pod + ! pod/perlpod.pod pod/perlport.pod pod/perlre.pod + ! pod/perlref.pod pod/perlreftut.pod pod/perlsub.pod + ! pod/perltie.pod pod/perltodo.pod pod/perltoot.pod + ! pod/perltootc.pod pod/perltrap.pod pod/perlvar.pod + ! pod/perlxstut.pod +____________________________________________________________________________ [ 5492] By: gsar on 2000/03/03 17:48:31 Log: support for list assignment to pseudohashes (from John Tobey <jtobey@john-edwin-tobey.org>) @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Sun Mar 5 02:50:05 EET 2000 [metaconfig 3.0 PL70] +# Generated on Sat Mar 11 20:26:09 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -864,6 +864,7 @@ sitebin='' sitebinexp='' installsitelib='' sitelib='' +sitelib_stem='' sitelibexp='' siteprefix='' siteprefixexp='' @@ -906,6 +907,10 @@ usethreads='' incpath='' mips_type='' usrinc='' +d_vendorarch='' +installvendorarch='' +vendorarch='' +vendorarchexp='' d_vendorbin='' installvendorbin='' vendorbin='' @@ -913,6 +918,7 @@ vendorbinexp='' d_vendorlib='' installvendorlib='' vendorlib='' +vendorlib_stem='' vendorlibexp='' usevendorprefix='' vendorprefix='' @@ -4506,6 +4512,14 @@ esac set use64bitint eval $setvar +case "$use64bitall" in +"$define"|true|[yY]*) dflt='y' ;; +*) case "$longsize" in + 8) dflt='y' ;; + *) dflt='n' ;; + esac + ;; +esac cat <<EOM You may also choose to try maximal 64-bitness. It means using as much @@ -4516,14 +4530,6 @@ have any more 64-bitness available than what you already have chosen. If this doesn't make any sense to you, just accept the default '$dflt'. EOM rp='Try to use maximal 64-bit support, if available?' -case "$use64bitall" in -"$define"|true|[yY]*) dflt='y' ;; -*) case "$longsize" in - 8) dflt='y' ;; - *) dflt='n' ;; - esac - ;; -esac . ./myread case "$ans" in [yY]*) val="$define" ;; @@ -5314,6 +5320,7 @@ case "$vendorprefix" in vendorlibexp="$ansexp" ;; esac +vendorlib_stem=`echo "$vendorlibexp" | sed "s,/$version$,,"` : Change installation prefix, if necessary. if $test X"$prefix" != X"$installprefix"; then installvendorlib=`echo $vendorlibexp | $sed "s#^$prefix#$installprefix#"` @@ -5321,6 +5328,36 @@ else installvendorlib="$vendorlibexp" fi +case "$vendorprefix" in +'') d_vendorarch="$undef" + vendorarch='' + vendorarchexp='' + ;; +*) d_vendorarch="$define" + : determine where vendor-supplied architecture-dependent libraries go. + : vendorlib default is /usr/local/lib/perl5/vendor_perl/$version + : vendorarch default is /usr/local/lib/perl5/vendor_perl/$version/$archname + : vendorlib may have an optional trailing /share. + case "$vendorarch" in + '') dflt=`echo $vendorlib | $sed 's,/share$,,'` + dflt="$dflt/$archname" + ;; + *) dflt="$vendorarch" ;; + esac + fn=d~+ + rp='Pathname for vendor-supplied architecture-dependent files?' + . ./getfile + vendorarch="$ans" + vendorarchexp="$ansexp" + ;; +esac +: Change installation prefix, if necessary. +if $test X"$prefix" != X"$installprefix"; then + installvendorarch=`echo $vendorarchexp | sed "s#^$prefix#$installprefix#"` +else + installvendorarch="$vendorarchexp" +fi + : Cruising for prototypes echo " " echo "Checking out function prototypes..." >&4 @@ -5467,6 +5504,7 @@ rp='Pathname for the site-specific library files?' . ./getfile sitelib="$ans" sitelibexp="$ansexp" +sitelib_stem=`echo "$sitelibexp" | sed "s,/$version$,,"` : Change installation prefix, if necessary. if $test X"$prefix" != X"$installprefix"; then installsitelib=`echo $sitelibexp | $sed "s#^$prefix#$installprefix#"` @@ -5573,7 +5611,7 @@ $rm -f getverlist echo " " if $test -d /usr/bin -a "X$installbin" != X/usr/bin; then $cat <<EOM -Many scripts expect to perl to be installed as /usr/bin/perl. +Many scripts expect perl to be installed as /usr/bin/perl. I can install the perl you are about to compile also as /usr/bin/perl (in addition to $installbin/perl). EOM @@ -8598,7 +8636,8 @@ extern int errno; #ifdef I_UNISTD #include <unistd.h> #endif -#ifdef $i_string +#$i_string I_STRING +#ifdef I_STRING #include <string.h> #else #include <strings.h> @@ -12515,9 +12554,52 @@ EOM $rm -f core try.core core.try.* case "$fflushNULL" in x) $cat >&4 <<EOM -Your fflush(NULL) works okay. +Your fflush(NULL) works okay for output streams. +Let's see if it clobbers input pipes... +EOM +# As of mid-March 2000 all versions of Solaris appear to have a stdio +# bug that improperly flushes the input end of pipes. So we avoid the +# autoflush on fork/system/exec support for now. :-( +$cat >tryp.c <<EOCP +#include <stdio.h> +int +main(int argc, char **argv) +{ + char buf[1024]; + int i; + char *bp = buf; + while (1) { + while ((i = getc(stdin)) != -1 + && (*bp++ = i) != '\n' + && bp < &buf[1024]) + /* DO NOTHING */ ; + *bp = '\0'; + fprintf(stdout, "%s", buf); + fflush(NULL); + if (i == -1) + return 0; + bp = buf; + } +} +EOCP + fflushNULL="$define" + set tryp + if eval $compile; then + $rm -f tryp.out + $cat tryp.c | ./tryp$exe_ext 2>/dev/null > tryp.out + if cmp tryp.c tryp.out >/dev/null 2>&1; then + $cat >&4 <<EOM +fflush(NULL) seems to behave okay with input streams. +EOM + fflushNULL="$define" + else + $cat >&4 <<EOM +Ouch, fflush(NULL) clobbers input pipes! We will not use it. EOM - fflushNULL="$define" + fflushNULL="$undef" + fi + fi + $rm -f core tryp.c tryp.core core.tryp.* ;; '') $cat >&4 <<EOM Your fflush(NULL) isn't working (contrary to ANSI C). @@ -12539,57 +12621,100 @@ $define|true|[yY]*) fflushNULL="$undef" ;; esac -: check explicit looping only if NULL did not work +: check explicit looping only if NULL did not work, and if the pipe +: bug does not show up on an explicit flush too case "$fflushNULL" in "$undef") - : check for fflush all behaviour - case "$fflushall" in - '') set try -DTRY_FFLUSH_ALL $output - if eval $compile; then - $cat >&4 <<EOM -(Now testing the other method--but note that also this may fail.) + $cat >tryp.c <<EOCP +#include <stdio.h> +int +main(int argc, char **argv) +{ + char buf[1024]; + int i; + char *bp = buf; + while (1) { + while ((i = getc(stdin)) != -1 + && (*bp++ = i) != '\n' + && bp < &buf[1024]) + /* DO NOTHING */ ; + *bp = '\0'; + fprintf(stdout, "%s", buf); + fflush(stdin); + if (i == -1) + return 0; + bp = buf; + } +} +EOCP + set tryp + if eval $compile; then + $rm -f tryp.out + $cat tryp.c | ./tryp$exe_ext 2>/dev/null > tryp.out + if cmp tryp.c tryp.out >/dev/null 2>&1; then + $cat >&4 <<EOM +Good, at least fflush(stdin) seems to behave okay when stdin is a pipe. EOM - $rm -f try.out - ./try$exe_ext 2>/dev/null - if $test -s try.out -a "X$?" = X42; then - fflushall="`$cat try.out`" - fi - fi - $rm -f core try.core core.try.* + : now check for fflushall behaviour case "$fflushall" in - x) $cat >&4 <<EOM + '') set try -DTRY_FFLUSH_ALL $output + if eval $compile; then + $cat >&4 <<EOM +(Now testing the other method--but note that this also may fail.) +EOM + $rm -f try.out + ./try$exe_ext 2>/dev/null + if $test -s try.out -a "X$?" = X42; then + fflushall="`$cat try.out`" + fi + fi + $rm -f core try.core core.try.* + case "$fflushall" in + x) $cat >&4 <<EOM Whew. Flushing explicitly all the stdio streams works. EOM - fflushall="$define" - ;; - '') $cat >&4 <<EOM + fflushall="$define" + ;; + '') $cat >&4 <<EOM Sigh. Flushing explicitly all the stdio streams doesn't work. EOM - fflushall="$undef" - ;; - *) $cat >&4 <<EOM + fflushall="$undef" + ;; + *) $cat >&4 <<EOM Cannot figure out whether flushing stdio streams explicitly works or not. I'm assuming it doesn't. EOM + fflushall="$undef" + ;; + esac + ;; + "$define"|true|[yY]*) + fflushall="$define" + ;; + *) fflushall="$undef" ;; esac - ;; - "$define"|true|[yY]*) - fflushall="$define" - ;; - *) + else + $cat >&4 <<EOM +All is futile. Even fflush(stdin) clobbers input pipes! +EOM fflushall="$undef" - ;; - esac + fi + else + fflushall="$undef" + fi + $rm -f core tryp.c tryp.core core.tryp.* ;; -*) fflushall="$undef" +*) fflushall="$undef" ;; esac + case "$fflushNULL$fflushall" in undefundef) $cat <<EOM -I cannot figure out how to flush pending stdio output. +OK, I give up. I cannot figure out how to flush pending stdio output. +We won't be flushing handles at all before fork/exec/popen. EOM ;; esac @@ -15245,6 +15370,7 @@ d_umask='$d_umask' d_uname='$d_uname' d_union_semun='$d_union_semun' d_ustat='$d_ustat' +d_vendorarch='$d_vendorarch' d_vendorbin='$d_vendorbin' d_vendorlib='$d_vendorlib' d_vfork='$d_vfork' @@ -15406,6 +15532,7 @@ installsitebin='$installsitebin' installsitelib='$installsitelib' installstyle='$installstyle' installusrbinperl='$installusrbinperl' +installvendorarch='$installvendorarch' installvendorbin='$installvendorbin' installvendorlib='$installvendorlib' intsize='$intsize' @@ -15561,6 +15688,7 @@ sitearchexp='$sitearchexp' sitebin='$sitebin' sitebinexp='$sitebinexp' sitelib='$sitelib' +sitelib_stem='$sitelib_stem' sitelibexp='$sitelibexp' siteprefix='$siteprefix' siteprefixexp='$siteprefixexp' @@ -15645,9 +15773,12 @@ uvsize='$uvsize' uvtype='$uvtype' uvuformat='$uvuformat' uvxformat='$uvxformat' +vendorarch='$vendorarch' +vendorarchexp='$vendorarchexp' vendorbin='$vendorbin' vendorbinexp='$vendorbinexp' vendorlib='$vendorlib' +vendorlib_stem='$vendorlib_stem' vendorlibexp='$vendorlibexp' vendorprefix='$vendorprefix' vendorprefixexp='$vendorprefixexp' @@ -128,6 +128,9 @@ If you succeed in automatically converting the sources to a K&R compatible form, be sure to email perlbug@perl.com to let us know the steps you followed. This will enable us to officially support this option. +Although Perl can be compiled using a C++ compiler, the Configure script +does not work with some C++ compilers. + =head1 Space Requirements The complete perl5 source tree takes up about 20 MB of disk space. @@ -641,6 +641,7 @@ lib/Pod/InputObjects.pm Pod-Parser - define objects for input streams lib/Pod/Man.pm Convert POD data to *roff lib/Pod/ParseUtils.pm Pod-Parser - pod utility functions lib/Pod/Parser.pm Pod-Parser - define base class for parsing POD +lib/Pod/Plainer.pm Pod migration utility module lib/Pod/Select.pm Pod-Parser - select portions of POD docs lib/Pod/Text.pm Pod-Parser - convert POD data to formatted ASCII text lib/Pod/Text/Color.pm Convert POD data to color ASCII text diff --git a/Makefile.SH b/Makefile.SH index 26c13c29fd..285269de44 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -696,7 +696,7 @@ _cleaner: -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \ $(LDLIBPTH) sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \ done - rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) + rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl .?*.c so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) rm -rf $(addedbyconf) rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old rm -f $(private) @@ -783,6 +783,9 @@ okfile: utilities nok: utilities $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' +nokfile: utilities + $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' -F perl.nok + clist: $(c) echo $(c) | tr ' ' $(TRNL) >.clist diff --git a/Porting/Glossary b/Porting/Glossary index 6c6109c161..e00110c6c8 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -1573,6 +1573,9 @@ d_ustat (d_ustat.U): This variable conditionally defines HAS_USTAT if ustat() is available to query file system statistics by dev_t. +d_vendorarch (vendorarch.U): + This variable conditionally defined PERL_VENDORARCH. + d_vendorbin (vendorbin.U): This variable conditionally defines PERL_VENDORBIN. @@ -2316,6 +2319,11 @@ installusrbinperl (instubperl.U): /usr/bin/perl in addition to $installbin/perl +installvendorarch (vendorarch.U): + This variable is really the same as vendorarchexp but may differ on + those systems using AFS. For extra portability, only this variable + should be used in makefiles. + installvendorbin (vendorbin.U): This variable is really the same as vendorbinexp but may differ on those systems using AFS. For extra portability, only this variable @@ -3068,6 +3076,11 @@ sitelib (sitelib.U): MakeMaker Makefile.PL or equivalent. See INSTALL for details. +sitelib_stem (sitelib.U): + This variable is $sitelibexp with any trailing version-specific component + removed. The elements in inc_version_list (inc_version_list.U) can + be tacked onto this variable to generate a list of directories to search. + sitelibexp (sitelib.U): This variable is the ~name expanded version of sitelib, so that you may use it directly in Makefiles or shell scripts. @@ -3503,6 +3516,19 @@ uvxformat (perlxvf.U): This variable contains the format string used for printing a Perl UV as an unsigned hexadecimal integer. +vendorarch (vendorarch.U): + This variable contains the value of the PERL_VENDORARCH symbol. + It may have a ~ on the front. + The standard distribution will put nothing in this directory. + Vendors who distribute perl may wish to place their own + architecture-dependent modules and extensions in this directory with + MakeMaker Makefile.PL INSTALLDIRS=vendor + or equivalent. See INSTALL for details. + +vendorarchexp (vendorarch.U): + This variable is the ~name expanded version of vendorarch, so that you + may use it directly in Makefiles or shell scripts. + vendorbin (vendorbin.U): This variable contains the eventual value of the VENDORBIN symbol. It may have a ~ on the front. @@ -3525,6 +3551,11 @@ vendorlib (vendorlib.U): MakeMaker Makefile.PL INSTALLDIRS=vendor or equivalent. See INSTALL for details. +vendorlib_stem (vendorlib.U): + This variable is $vendorlibexp with any trailing version-specific component + removed. The elements in inc_version_list (inc_version_list.U) can + be tacked onto this variable to generate a list of directories to search. + vendorlibexp (vendorlib.U): This variable is the ~name expanded version of vendorlib, so that you may use it directly in Makefiles or shell scripts. diff --git a/Porting/config.sh b/Porting/config.sh index 0fe3d67ac9..18e3506f00 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Fri Mar 3 17:00:59 EET 2000 +# Configuration time: Mon Mar 6 00:00:30 EET 2000 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -35,8 +35,8 @@ api_subversion='0' api_version='5' api_versionstring='5.005' ar='ar' -archlib='/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi' -archlibexp='/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi' +archlib='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' +archlibexp='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' archname64='' archname='alpha-dec_osf-thread-multi' archobjs='' @@ -54,12 +54,12 @@ castflags='0' cat='cat' cc='cc' cccdlflags=' ' -ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi/CORE' +ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi/CORE' ccflags='-pthread -std -DLANGUAGE_C' ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1 unix=1' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Fri Mar 3 17:00:59 EET 2000' +cf_time='Mon Mar 6 00:00:30 EET 2000' charsize='1' chgrp='' chmod='' @@ -360,6 +360,7 @@ d_umask='define' d_uname='define' d_union_semun='undef' d_ustat='define' +d_vendorarch='undef' d_vendorbin='undef' d_vendorlib='undef' d_vfork='undef' @@ -508,19 +509,20 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi' +installarchlib='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.5.670' +installprivlib='/opt/perl/lib/5.6.0' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi' +installsitearch='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' installsitebin='/opt/perl/bin' -installsitelib='/opt/perl/lib/site_perl/5.5.670' +installsitelib='/opt/perl/lib/site_perl/5.6.0' installstyle='lib' installusrbinperl='define' +installvendorarch='' installvendorbin='' installvendorlib='' intsize='4' @@ -608,7 +610,7 @@ osvers='4.0' package='perl5' pager='/c/bin/less' passcat='cat /etc/passwd' -patchlevel='5' +patchlevel='6' path_sep=':' perl5='/u/vieraat/vieraat/jhi/Perl/bin/perl' perl='' @@ -623,8 +625,8 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.5.670' -privlibexp='/opt/perl/lib/5.5.670' +privlib='/opt/perl/lib/5.6.0' +privlibexp='/opt/perl/lib/5.6.0' prototype='define' ptrsize='8' quadkind='2' @@ -671,12 +673,13 @@ sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE" sig_num='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 6 6 16 20 23 23 23 29 48 ' sig_num_init='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, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi' -sitearchexp='/opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi' +sitearch='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' +sitearchexp='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' -sitelib='/opt/perl/lib/site_perl/5.5.670' -sitelibexp='/opt/perl/lib/site_perl/5.5.670' +sitelib='/opt/perl/lib/site_perl/5.6.0' +sitelib_stem='/opt/perl/lib/site_perl' +sitelibexp='/opt/perl/lib/site_perl/5.6.0' siteprefix='/opt/perl' siteprefixexp='/opt/perl' sizetype='size_t' @@ -705,7 +708,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='_iob' strings='/usr/include/string.h' submit='' -subversion='670' +subversion='0' sysman='/usr/man/man1' tail='' tar='' @@ -760,17 +763,20 @@ uvsize='8' uvtype='unsigned long' uvuformat='"lu"' uvxformat='"lx"' +vendorarch='' +vendorarchexp='' vendorbin='' vendorbinexp='' vendorlib='' +vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.5.670' +version='5.6.0' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' -xs_apiversion='5.5.670' +xs_apiversion='5.6.0' zcat='' zip='zip' # Configure command line arguments. @@ -789,8 +795,8 @@ config_arg9='-Dmydomain=.yourplace.com' config_arg10='-Dmyhostname=yourhost' config_arg11='-dE' PERL_REVISION=5 -PERL_VERSION=5 -PERL_SUBVERSION=670 +PERL_VERSION=6 +PERL_SUBVERSION=0 PERL_API_REVISION=5 PERL_API_VERSION=5 PERL_API_SUBVERSION=0 diff --git a/Porting/config_H b/Porting/config_H index c627afafee..7a63d00575 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Fri Mar 3 17:00:59 EET 2000 + * Configuration time: Mon Mar 6 00:00:30 EET 2000 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -1098,8 +1098,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.5.670/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB "/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi" /**/ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -1190,14 +1190,18 @@ * This macro surrounds its token with double quotes. */ #if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" +# define CAT2(a,b) a/**/b +# define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) +# define PeRl_CaTiFy(a, b) a ## b +# define PeRl_StGiFy(a) #a +/* the additional level of indirection enables these macros to be + * used as arguments to other macros. See K&R 2nd ed., page 231. */ +# define CAT2(a,b) PeRl_CaTiFy(a,b) +# define StGiFy(a) PeRl_StGiFy(a) +# define STRINGIFY(a) PeRl_StGiFy(a) #endif #if 42 != 1 && 42 != 42 #include "Bletch: How does this C preprocessor catenate tokens?" @@ -2675,8 +2679,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.5.670" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.5.670" /**/ +#define PRIVLIB "/opt/perl/lib/5.6.0" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.6.0" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2774,8 +2778,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2792,8 +2796,14 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "/opt/perl/lib/site_perl/5.5.670" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.5.670" /**/ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ +#define SITELIB "/opt/perl/lib/site_perl/5.6.0" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.6.0" /**/ +#define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2942,11 +2952,23 @@ #endif /*#define OLD_PTHREADS_API / **/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH_EXP "" / **/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ /*#define PERL_VENDORLIB_EXP "" / **/ +/*#define PERL_VENDORLIB_STEM "" / **/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -2976,7 +2998,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.5.670/alpha-dec_osf-thread-multi for older + * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -2995,7 +3017,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /opt/perl/lib/site_perl/5.5.670 for older directories across major versions + * search in /opt/perl/lib/site_perl/5.6.0 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's @@ -3005,7 +3027,7 @@ * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION "5.5.670" +#define PERL_XS_APIVERSION "5.6.0" #define PERL_PM_APIVERSION "5.005" /* HAS_GETFSSTAT: diff --git a/README.win32 b/README.win32 index 830e129d7d..b39961b625 100644 --- a/README.win32 +++ b/README.win32 @@ -275,14 +275,16 @@ C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>. Entries in the former override entries in the latter. One or more of the following entries (of type REG_SZ or REG_EXPAND_SZ) may be set: - lib-$] version-specific path to add to @INC - lib path to add to @INC - sitelib-$] version-specific path to add to @INC - sitelib path to add to @INC + lib-$] version-specific standard library path to add to @INC + lib standard library path to add to @INC + sitelib-$] version-specific site library path to add to @INC + sitelib site library path to add to @INC + vendorlib-$] version-specific vendor library path to add to @INC + vendorlib vendor library path to add to @INC PERL* fallback for all %ENV lookups that begin with "PERL" Note the C<$]> in the above is not literal. Substitute whatever version -of perl you want to honor that entry, e.g. C<5.00502>. Paths must be +of perl you want to honor that entry, e.g. C<5.6.0>. Paths must be separated with semicolons, as usual on win32. =item File Globbing @@ -407,6 +409,8 @@ CPAN: http://www.perl.com/CPAN/authors/id/NI-S/Make-0.03.tar.gz +You may also use dmake. See L</"Borland C++"> above on how to get it. + Note that MakeMaker actually emits makefiles with different syntax depending on what 'make' it thinks you are using. Therefore, it is important that one of the following values appears in Config.pm: @@ -8,10 +8,11 @@ Tie Modules ShiftSplice Defines shift et al in terms of splice method Would be nice to have - pack "(stuff)*", "(stuff)4", ... + pack "(stuff)*", "(stuff)?", "(stuff)+", "(stuff)4", ... contiguous bitfields in pack/unpack lexperl - bundled perl preprocessor + bundled perl preprocessor/macro facility + this would solve many of the syntactic nice-to-haves use posix calls internally where possible gettimeofday (possibly best left for a module?) format BOTTOM @@ -21,34 +22,26 @@ Would be nice to have support in perlmain to rerun debugger regression tests using __DIE__ hook lexically scoped functions: my sub foo { ... } - lvalue functions - wantlvalue? more generalized want()/caller()? + wantlvalue? more generalized want()/caller()? named prototypes: sub foo ($foo, @bar) { ... } ? regression/sanity tests for suidperl iterators/lazy evaluation/continuations/first/ first_defined/short-circuiting grep/?? This is a very thorny and hotly debated subject, tread carefully and do your homework first - full 64 bit support (i.e. "long long"). Things to consider: - how to store/retrieve 32+ integers into/from Perl scalars? - 32+ constants in Perl code? (non-portable!) - 32+ arguments/return values to/from system calls? (seek et al) - 32+ bit ops (&|^~, currently explicitly disabled) generalise Errno way of extracting cpp symbols and use that in - Errno and Fcntl (ExtUtils::CppSymbol?) + Errno, Fcntl, POSIX (ExtUtils::CppSymbol?) the _r-problem: for all the {set,get,end}*() system database calls (and a couple more: readdir, *rand*, crypt, *time, tmpnam) there are in many systems the _r versions to be used in re-entrant (=multithreaded) code Icky things: the _r API is not standardized and the _r-forms require per-thread data to store their state - memory profiler: turn malloc.c:Perl_dump_mstats() into + memory profiler: turn malloc.c:Perl_get_mstats() into an extension (Devel::MProf?) that would return the malloc stats in a nice Perl datastructure (also a simple interface to return just the grand total would be good) - Unicode: [=bar=], combining characters equivalence - (U+4001 + U+0308 should be equal to U+00C4, in other words - A+diaereres should equal Ä), Unicode collation + a way to make << and >> to shift bitvectors instead of numbers Possible pragmas debugger @@ -58,12 +51,12 @@ Optimizations constant function cache switch structures foreach(reverse...) - optimize away constant split at compile time (a la qw[f o o]) cache eval tree (unless lexical outer scope used (mark in &compiling?)) rcatmaybe shrink opcode tables via multiple implementations selected in peep cache hash value? (Not a win, according to Guido) optimize away @_ where possible + tail recursion removal "one pass" global destruction rewrite regexp parser for better integrated optimization LRU cache of regexp: foreach $pat (@pats) { foo() if /$pat/ } @@ -16,6 +16,7 @@ Unicode support autoload utf8_heavy.pl's swash routines in swash_init() autoload byte.pm when byte:: is seen by the parser check uv_to_utf8() calls for buffer overflow + (see also "Locales", "Regexen", and "Miscellaneous") Multi-threading support "use Thread;" under useithreads @@ -45,22 +46,56 @@ Configure make configuring+building away from source directory work (VPATH et al) _r support cross-compilation configuring - POSIX 1003.1 1996 Edition support + POSIX 1003.1 1996 Edition support--realtime stuff: + POSIX semaphores, message queues, shared memory, realtime clocks, + timers, signals (the metaconfig units mostly already exist for these) + UNIX98 support: reader-writer locks, realtime/asynchronous IO + +Long doubles + figure out where the PV->NV->PV conversion gets it wrong at least + in AIX and Tru64 (V5.0 and onwards) when using long doubles: see the + regexp tricks we had to insert to t/comp/use.t and t/lib/bigfltpm.t, + (?:9|8999\d+) and the like. + +64-bit support + Configure probe for quad_t, uquad_t, and (argh) u_quad_t, they might + be in some systems the only thing working as quadtype and uquadtype. Locales deprecate traditional/legacy locales? + How do locales work across packages? figure out how to support Unicode locales - locales across packages? + suggestion: integrate the IBM Classes for Unicode (ICU) + http://oss.software.ibm.com/developerworks/opensource/icu/project/ + and check out also the Locale Converter: + http://alphaworks.ibm.com/tech/localeconverter + ICU is "portable, open-source Unicode library with: + charset-independent locales (with multiple locales simultaneously + supported in same thread; character conversions; formatting/parsing + for numbers, currencies, date/time and messages; message catalogs + (resources) ; transliteration, collation, normalization, and text + boundaries (grapheme, word, line-break))". + There is also 'iconv', either from XPG4 or GNU (glibc). + iconv is about character set conversions. + Either ICU or iconv would be valuable to get integrated + into Perl, Configure already probes for libiconv and <iconv.h>. Regexen make RE engine thread-safe POSIX [=bar=] and [.zap.] would nice too but there's no API for them - (=bar= could be done with Unicode, though, see TR about normalization forms) + =bar= could be done with Unicode, though, see the Unicode TR #15 about + normalization forms: + http://www.unicode.org/unicode/reports/tr15/ + this is also a part of the Unicode 3.0: + http://www.unicode.org/unicode/uni2book/u2.html + executive summary: there are several different levels of 'equivalence' approximate matching Security use fchown, fchmod (and futimes?) internally when possible use fchdir(how portable?) + create secure reliable portable temporary file modules + audit the standard utilities for security problems and fix them Reliable Signals custom opcodes @@ -74,11 +109,25 @@ Win32 stuff Miscellaneous add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) - sub-second sleep? (integrate Time::HiRes?) - floating point handling: nans, infinities, fp exception masks, etc + sub-second sleep()? alarm()? time()? (integrate Time::HiRes? + Configure doesn't yet probe for usleep/nanosleep/ualarm but + the units exist) + floating point handling: nans, infinities, fp exception masks, etc. + at least the following interfaces exist: fp_classify(), fp_class(), + class(), isnan(), isinf(), isfinite(), finite(), isnormal(), + ordered(), fp_setmask(), fp_getmask(), fp_setround(), fp_getround(), + ieeefp.h, fp_class.h. There are metaconfig units for most of these. + Search for ifdef __osf__ in pp.c to find a temporary fix that + needs to be done right. + fix the basic arithmetics (+ - * / %) to preserve IVness/UVness if + both arguments are IVs/UVs replace pod2html with new PodtoHtml? (requires other modules from CPAN) automate testing with large parts of CPAN - Unicode collation? + Unicode collation? http://www.unicode.org/unicode/reports/tr10/ + turn Cwd into an XS module? (Configure already probes for getcwd()) + mmap for speeding up input? (Configure already probes for the mmap family) + sendmsg, recvmsg? (Configure doesn't probe for these but the units exist) + setitimer, getitimer? (the metaconfig units exist) Ongoing keep filenames 8.3 friendly, where feasible diff --git a/bytecode.pl b/bytecode.pl index 0ffe8e4443..d1e1c708c0 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -343,7 +343,7 @@ xcv_file CvFILE(bytecode_sv) pvcontents xcv_depth CvDEPTH(bytecode_sv) long xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex -xcv_flags CvFLAGS(bytecode_sv) U8 +xcv_flags CvFLAGS(bytecode_sv) U16 av_extend bytecode_sv SSize_t x av_push bytecode_sv svindex x xav_fill AvFILLp(bytecode_sv) SSize_t diff --git a/config_h.SH b/config_h.SH index 73f4ae6563..108b6739cb 100644 --- a/config_h.SH +++ b/config_h.SH @@ -1412,6 +1412,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getcwd HAS_GETCWD /**/ +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. + */ +#$d_getfsstat HAS_GETFSSTAT /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1638,13 +1644,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_isascii HAS_ISASCII /**/ -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -#$d_lchown HAS_LCHOWN /**/ - /* HAS_LDBL_DIG: * This symbol, if defined, indicates that this system's <float.h> * or <limits.h> defines the symbol LDBL_DIG, which is the number @@ -1680,6 +1679,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define LONGLONGSIZE $longlongsize /**/ #endif +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); + */ +#$d_lseekproto HAS_LSEEK_PROTO /**/ + /* HAS_MADVISE: * This symbol, if defined, indicates that the madvise system call is * available to map a file into memory. @@ -2274,6 +2281,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_iconv I_ICONV /**/ +/* I_IEEEFP: + * This symbol, if defined, indicates that <ieeefp.h> exists and + * should be included. + */ +#$i_ieeefp I_IEEEFP /**/ + /* I_INTTYPES: * This symbol, if defined, indicates to the C program that it should * include <inttypes.h>. @@ -2810,8 +2823,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "$sitelib" /**/ #define SITELIB_EXP "$sitelibexp" /**/ +#define SITELIB_STEM "$sitelib_stem" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2821,6 +2840,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Size_t $sizetype /* length paramater for string functions */ +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t $socksizetype /**/ + /* SSize_t: * This symbol holds the type used by functions that return * a count of bytes or an error condition. It must be a signed type. @@ -2960,11 +2985,35 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #endif #$d_oldpthreads OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH: + * If defined, this symbol contains the name of a private library. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. + * It may have a ~ on the front. + * The standard distribution will put nothing in this directory. + * Vendors who distribute perl may wish to place their own + * architecture-dependent modules and extensions in this directory with + * MakeMaker Makefile.PL INSTALLDIRS=vendor + * or equivalent. See INSTALL for details. + */ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#$d_vendorarch PERL_VENDORARCH "$vendorarch" /**/ +#$d_vendorarch PERL_VENDORARCH_EXP "$vendorarchexp" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ +#$d_vendorlib PERL_VENDORLIB_STEM "$vendorlib_stem" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this @@ -3026,31 +3075,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PERL_XS_APIVERSION "$xs_apiversion" #define PERL_PM_APIVERSION "$pm_apiversion" -/* HAS_GETFSSTAT: - * This symbol, if defined, indicates that the getfsstat routine is - * available to stat filesystems in bulk. - */ -#$d_getfsstat HAS_GETFSSTAT /**/ - -/* I_IEEEFP: - * This symbol, if defined, indicates that <ieeefp.h> exists and - * should be included. - */ -#$i_ieeefp I_IEEEFP /**/ - -/* HAS_LSEEK_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the lseek() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern off_t lseek(int, off_t, int); - */ -#$d_lseekproto HAS_LSEEK_PROTO /**/ - -/* Sock_size_t: - * This symbol holds the type used for the size argument of - * various socket calls (just the base type, not the pointer-to). +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). */ -#define Sock_size_t $socksizetype /**/ +#$d_lchown HAS_LCHOWN /**/ #endif !GROK!THIS! diff --git a/configure.com b/configure.com index 89671e5948..84ac265024 100644 --- a/configure.com +++ b/configure.com @@ -38,7 +38,7 @@ $ cat = "type" $ gcc_symbol = "gcc" $ ans = "" $ macros = "" -$ extra_fags = "" +$ extra_flags = "" $ user_c_flags = "" $ use_debugging_perl = "y" $ use_ieee_math = "n" @@ -2218,6 +2218,8 @@ $ file_2_find = "[-]''packageup'.cld" $ echo "" $ echo4 "%Config-I-VMS, The perl.cld file is now being written..." $ OPEN/WRITE CONFIG 'file_2_find' +$ ext = ".exe" +$ IF ((sharedperl) .AND. (f$getsyi("ARCH_NAME") .NES. "VAX")) THEN ext := .AXE $ IF (use_vmsdebug_perl) $ THEN $ WRITE CONFIG "define verb dbgperl" @@ -361,6 +361,7 @@ struct context { /* private flags for CXt_EVAL */ #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */ +#define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */ #ifdef USE_ITHREADS /* private flags for CXt_LOOP */ @@ -374,6 +375,8 @@ struct context { #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) #define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \ == (CXt_EVAL|CXp_REAL)) +#define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK)) \ + == (CXt_EVAL|CXp_TRYBLOCK)) #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) @@ -93,9 +93,19 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int fd; int result; bool was_fdopen = FALSE; + bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0; PL_forkprocess = 1; /* assume true if no fork */ + if (PL_op && PL_op->op_type == OP_OPEN) { + /* set up disciplines */ + U8 flags = PL_op->op_private; + in_raw = (flags & OPpOPEN_IN_RAW); + in_crlf = (flags & OPpOPEN_IN_CRLF); + out_raw = (flags & OPpOPEN_OUT_RAW); + out_crlf = (flags & OPpOPEN_OUT_CRLF); + } + if (IoIFP(io)) { fd = PerlIO_fileno(IoIFP(io)); if (IoTYPE(io) == '-') @@ -153,15 +163,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (fd == -1) fp = NULL; else { - char *fpmode; + char fpmode[4]; + STRLEN ix = 0; if (result == O_RDONLY) - fpmode = "r"; + fpmode[ix++] = 'r'; #ifdef O_APPEND - else if (rawmode & O_APPEND) - fpmode = (result == O_WRONLY) ? "a" : "a+"; + else if (rawmode & O_APPEND) { + fpmode[ix++] = 'a'; + if (result != O_WRONLY) + fpmode[ix++] = '+'; + } #endif - else - fpmode = (result == O_WRONLY) ? "w" : "r+"; + else { + if (result == O_WRONLY) + fpmode[ix++] = 'w'; + else { + fpmode[ix++] = 'r'; + fpmode[ix++] = '+'; + } + } + if (rawmode & O_BINARY) + fpmode[ix++] = 'b'; + fpmode[ix] = '\0'; fp = PerlIO_fdopen(fd, fpmode); if (!fp) PerlLIO_close(fd); @@ -172,7 +195,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, char *oname = name; STRLEN tlen; STRLEN olen = len; - char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ + char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ int dodup; type = savepvn(name, len); @@ -191,7 +214,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, name = type; len = tlen; } - mode[0] = mode[1] = mode[2] = '\0'; + mode[0] = mode[1] = mode[2] = mode[3] = '\0'; IoTYPE(io) = *type; if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */ mode[1] = *type++; @@ -226,7 +249,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); } - fp = PerlProc_popen(name,"w"); + { + char *mode; + if (out_raw) + mode = "wb"; + else if (out_crlf) + mode = "wt"; + else + mode = "w"; + fp = PerlProc_popen(name,mode); + } writing = 1; } else if (*type == '>') { @@ -241,6 +273,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, mode[0] = 'w'; writing = 1; + if (out_raw) + strcat(mode, "b"); + else if (out_crlf) + strcat(mode, "t"); + if (num_svs && tlen != 1) goto unknown_desr; if (*type == '&') { @@ -317,6 +354,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, /*SUPPRESS 530*/ for (type++; isSPACE(*type); type++) ; mode[0] = 'r'; + if (in_raw) + strcat(mode, "b"); + else if (in_crlf) + strcat(mode, "t"); + if (*type == '&') { name = type; goto duplicity; @@ -351,7 +393,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (strNE(name,"-") || num_svs) TAINT_ENV(); TAINT_PROPER("piped open"); - fp = PerlProc_popen(name,"r"); + { + char *mode; + if (in_raw) + mode = "rb"; + else if (in_crlf) + mode = "rt"; + else + mode = "r"; + fp = PerlProc_popen(name,mode); + } IoTYPE(io) = '|'; } else { @@ -365,8 +416,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, fp = PerlIO_stdin(); IoTYPE(io) = '-'; } - else - fp = PerlIO_open(name,"r"); + else { + char *mode; + if (in_raw) + mode = "rb"; + else if (in_crlf) + mode = "rt"; + else + mode = "r"; + fp = PerlIO_open(name,mode); + } } } if (!fp) { @@ -444,8 +503,17 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (writing) { dTHR; if (IoTYPE(io) == 's' - || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) { - if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) { + || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) + { + char *mode; + if (out_raw) + mode = "wb"; + else if (out_crlf) + mode = "wt"; + else + mode = "w"; + + if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) { PerlIO_close(fp); IoIFP(io) = Nullfp; goto say_false; @@ -902,19 +970,72 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) } int -Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag) +Perl_mode_from_discipline(pTHX_ SV *discp) +{ + int mode = O_BINARY; + if (discp) { + STRLEN len; + char *s = SvPV(discp,len); + while (*s) { + if (*s == ':') { + switch (s[1]) { + case 'r': + if (len > 3 && strnEQ(s+1, "raw", 3) + && (!s[4] || s[4] == ':' || isSPACE(s[4]))) + { + mode = O_BINARY; + s += 4; + len -= 4; + break; + } + /* FALL THROUGH */ + case 'c': + if (len > 4 && strnEQ(s+1, "crlf", 4) + && (!s[5] || s[5] == ':' || isSPACE(s[5]))) + { + mode = O_TEXT; + s += 5; + len -= 5; + break; + } + /* FALL THROUGH */ + default: + goto fail_discipline; + } + } + else if (isSPACE(*s)) { + ++s; + --len; + } + else { + char *end; +fail_discipline: + end = strchr(s+1, ':'); + if (!end) + end = s+len; + Perl_croak(aTHX_ "Unknown discipline '%.*s'", end-s, s); + } + } + } + return mode; +} + +int +Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) { - if (flag != TRUE) - Perl_croak(aTHX_ "panic: unsetting binmode"); /* Not implemented yet */ #ifdef DOSISH -#if defined(atarist) || defined(__MINT__) - if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) +# if defined(atarist) || defined(__MINT__) + if (!PerlIO_flush(fp)) { + if (mode & O_BINARY) + ((FILE*)fp)->_flag |= _IOBIN; + else + ((FILE*)fp)->_flag &= ~ _IOBIN; return 1; - else - return 0; -#else - if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) { -#if defined(WIN32) && defined(__BORLANDC__) + } + return 0; +# else + if (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1) { +# if defined(WIN32) && defined(__BORLANDC__) /* The translation mode of the stream is maintained independent * of the translation mode of the fd in the Borland RTL (heavy * digging through their runtime sources reveal). User has to @@ -922,22 +1043,25 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag) * document this anywhere). GSAR 97-5-24 */ PerlIO_seek(fp,0L,0); - ((FILE*)fp)->flags |= _F_BIN; -#endif + if (mode & O_BINARY) + ((FILE*)fp)->flags |= _F_BIN; + else + ((FILE*)fp)->flags &= ~ _F_BIN; +# endif return 1; } else return 0; -#endif +# endif #else -#if defined(USEMYBINMODE) - if (my_binmode(fp,iotype) != FALSE) +# if defined(USEMYBINMODE) + if (my_binmode(fp, iotype, mode) != FALSE) return 1; else return 0; -#else +# else return 1; -#endif +# endif #endif } @@ -1670,8 +1794,11 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { struct semid_ds semds; union semun semun; - +#ifdef EXTRA_F_IN_SEMUN_BUF + semun.buff = &semds; +#else semun.buf = &semds; +#endif getinfo = (cmd == GETALL); if (Semctl(id, 0, IPC_STAT, semun) == -1) return -1; @@ -1726,7 +1853,11 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) #ifdef Semctl union semun unsemds; +#ifdef EXTRA_F_IN_SEMUN_BUF + unsemds.buff = (struct semid_ds *)a; +#else unsemds.buf = (struct semid_ds *)a; +#endif ret = Semctl(id, n, cmd, unsemds); #else Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); @@ -1098,6 +1098,9 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) STRLEN dulen = 0; I32 ulen; + if (optype != OP_BIT_AND) + dc = SvGROW(sv, leftlen+rightlen+1); + switch (optype) { case OP_BIT_AND: while (lulen && rulen) { @@ -30,7 +30,7 @@ # endif #endif /* DJGPP */ -#define PERL_SYS_TERM() MALLOC_TERM +#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM #define dXSUB_SYS /* @@ -52,7 +52,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -429,6 +429,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } if (o->op_private) { SV *tmpsv = newSVpvn("", 0); + if (PL_opargs[o->op_type] & OA_TARGLEX) { + if (o->op_private & OPpTARGET_MY) + sv_catpv(tmpsv, ",TARGET_MY"); + } if (o->op_type == OP_AASSIGN) { if (o->op_private & OPpASSIGN_COMMON) sv_catpv(tmpsv, ",COMMON"); @@ -116,6 +116,7 @@ #define die_nocontext Perl_die_nocontext #define deb_nocontext Perl_deb_nocontext #define form_nocontext Perl_form_nocontext +#define load_module_nocontext Perl_load_module_nocontext #define mess_nocontext Perl_mess_nocontext #define warn_nocontext Perl_warn_nocontext #define warner_nocontext Perl_warner_nocontext @@ -322,6 +323,8 @@ #define linklist Perl_linklist #define list Perl_list #define listkids Perl_listkids +#define load_module Perl_load_module +#define vload_module Perl_vload_module #define localize Perl_localize #define looks_like_number Perl_looks_like_number #define magic_clearenv Perl_magic_clearenv @@ -392,6 +395,7 @@ #define mg_set Perl_mg_set #define mg_size Perl_mg_size #define mod Perl_mod +#define mode_from_discipline Perl_mode_from_discipline #define moreswitches Perl_moreswitches #define my Perl_my #define my_atof Perl_my_atof @@ -1138,6 +1142,7 @@ #define ck_match Perl_ck_match #define ck_method Perl_ck_method #define ck_null Perl_ck_null +#define ck_open Perl_ck_open #define ck_repeat Perl_ck_repeat #define ck_require Perl_ck_require #define ck_rfun Perl_ck_rfun @@ -1762,6 +1767,7 @@ #define linklist(a) Perl_linklist(aTHX_ a) #define list(a) Perl_list(aTHX_ a) #define listkids(a) Perl_listkids(aTHX_ a) +#define vload_module(a,b,c,d) Perl_vload_module(aTHX_ a,b,c,d) #define localize(a,b) Perl_localize(aTHX_ a,b) #define looks_like_number(a) Perl_looks_like_number(aTHX_ a) #define magic_clearenv(a,b) Perl_magic_clearenv(aTHX_ a,b) @@ -1831,6 +1837,7 @@ #define mg_set(a) Perl_mg_set(aTHX_ a) #define mg_size(a) Perl_mg_size(aTHX_ a) #define mod(a,b) Perl_mod(aTHX_ a,b) +#define mode_from_discipline(a) Perl_mode_from_discipline(aTHX_ a) #define moreswitches(a) Perl_moreswitches(aTHX_ a) #define my(a) Perl_my(aTHX_ a) #define my_atof(a) Perl_my_atof(aTHX_ a) @@ -2319,7 +2326,7 @@ #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) #define find_beginning() S_find_beginning(aTHX) #define forbid_setid(a) S_forbid_setid(aTHX_ a) -#define incpush(a,b) S_incpush(aTHX_ a,b) +#define incpush(a,b,c) S_incpush(aTHX_ a,b,c) #define init_interp() S_init_interp(aTHX) #define init_ids() S_init_ids(aTHX) #define init_lexer() S_init_lexer(aTHX) @@ -2567,6 +2574,7 @@ #define ck_match(a) Perl_ck_match(aTHX_ a) #define ck_method(a) Perl_ck_method(aTHX_ a) #define ck_null(a) Perl_ck_null(aTHX_ a) +#define ck_open(a) Perl_ck_open(aTHX_ a) #define ck_repeat(a) Perl_ck_repeat(aTHX_ a) #define ck_require(a) Perl_ck_require(aTHX_ a) #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) @@ -3055,6 +3063,8 @@ #define deb_nocontext Perl_deb_nocontext #define Perl_form_nocontext CPerlObj::Perl_form_nocontext #define form_nocontext Perl_form_nocontext +#define Perl_load_module_nocontext CPerlObj::Perl_load_module_nocontext +#define load_module_nocontext Perl_load_module_nocontext #define Perl_mess_nocontext CPerlObj::Perl_mess_nocontext #define mess_nocontext Perl_mess_nocontext #define Perl_warn_nocontext CPerlObj::Perl_warn_nocontext @@ -3456,6 +3466,10 @@ #define list Perl_list #define Perl_listkids CPerlObj::Perl_listkids #define listkids Perl_listkids +#define Perl_load_module CPerlObj::Perl_load_module +#define load_module Perl_load_module +#define Perl_vload_module CPerlObj::Perl_vload_module +#define vload_module Perl_vload_module #define Perl_localize CPerlObj::Perl_localize #define localize Perl_localize #define Perl_looks_like_number CPerlObj::Perl_looks_like_number @@ -3590,6 +3604,8 @@ #define mg_size Perl_mg_size #define Perl_mod CPerlObj::Perl_mod #define mod Perl_mod +#define Perl_mode_from_discipline CPerlObj::Perl_mode_from_discipline +#define mode_from_discipline Perl_mode_from_discipline #define Perl_moreswitches CPerlObj::Perl_moreswitches #define moreswitches Perl_moreswitches #define Perl_my CPerlObj::Perl_my @@ -4981,6 +4997,8 @@ #define ck_method Perl_ck_method #define Perl_ck_null CPerlObj::Perl_ck_null #define ck_null Perl_ck_null +#define Perl_ck_open CPerlObj::Perl_ck_open +#define ck_open Perl_ck_open #define Perl_ck_repeat CPerlObj::Perl_ck_repeat #define ck_repeat Perl_ck_repeat #define Perl_ck_require CPerlObj::Perl_ck_require @@ -5751,6 +5769,7 @@ # define deb Perl_deb_nocontext # define die Perl_die_nocontext # define form Perl_form_nocontext +# define load_module Perl_load_module_nocontext # define mess Perl_mess_nocontext # define newSVpvf Perl_newSVpvf_nocontext # define sv_catpvf Perl_sv_catpvf_nocontext @@ -5769,6 +5788,7 @@ # define Perl_die_nocontext Perl_die # define Perl_deb_nocontext Perl_deb # define Perl_form_nocontext Perl_form +# define Perl_load_module_nocontext Perl_load_module # define Perl_mess_nocontext Perl_mess # define Perl_newSVpvf_nocontext Perl_newSVpvf # define Perl_sv_catpvf_nocontext Perl_sv_catpvf @@ -500,6 +500,7 @@ print EM <<'END'; # define deb Perl_deb_nocontext # define die Perl_die_nocontext # define form Perl_form_nocontext +# define load_module Perl_load_module_nocontext # define mess Perl_mess_nocontext # define newSVpvf Perl_newSVpvf_nocontext # define sv_catpvf Perl_sv_catpvf_nocontext @@ -518,6 +519,7 @@ print EM <<'END'; # define Perl_die_nocontext Perl_die # define Perl_deb_nocontext Perl_deb # define Perl_form_nocontext Perl_form +# define Perl_load_module_nocontext Perl_load_module # define Perl_mess_nocontext Perl_mess # define Perl_newSVpvf_nocontext Perl_newSVpvf # define Perl_sv_catpvf_nocontext Perl_sv_catpvf @@ -931,6 +933,7 @@ my %vfuncs = qw( Perl_warner Perl_vwarner Perl_die Perl_vdie Perl_form Perl_vform + Perl_load_module Perl_vload_module Perl_mess Perl_vmess Perl_deb Perl_vdeb Perl_newSVpvf Perl_vnewSVpvf @@ -1399,6 +1402,7 @@ Afnrp |void |croak_nocontext|const char* pat|... Afnp |OP* |die_nocontext |const char* pat|... Afnp |void |deb_nocontext |const char* pat|... Afnp |char* |form_nocontext |const char* pat|... +Afnp |void |load_module_nocontext|U32 flags|SV* name|SV* ver|... Afnp |SV* |mess_nocontext |const char* pat|... Afnp |void |warn_nocontext |const char* pat|... Afnp |void |warner_nocontext|U32 err|const char* pat|... @@ -1616,6 +1620,8 @@ p |void |lex_start |SV* line p |OP* |linklist |OP* o p |OP* |list |OP* o p |OP* |listkids |OP* o +Afp |void |load_module|U32 flags|SV* name|SV* ver|... +Ap |void |vload_module|U32 flags|SV* name|SV* ver|va_list* args p |OP* |localize |OP* arg|I32 lexical Apd |I32 |looks_like_number|SV* sv p |int |magic_clearenv |SV* sv|MAGIC* mg @@ -1686,6 +1692,7 @@ Apd |void |mg_magical |SV* sv Apd |int |mg_set |SV* sv Ap |I32 |mg_size |SV* sv p |OP* |mod |OP* o|I32 type +p |int |mode_from_discipline|SV* discp Ap |char* |moreswitches |char* s p |OP* |my |OP* o Ap |NV |my_atof |const char *s @@ -2228,7 +2235,7 @@ s |void* |Slab_Alloc |int m|size_t sz #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) s |void |find_beginning s |void |forbid_setid |char * -s |void |incpush |char *|int +s |void |incpush |char *|int|int s |void |init_interp s |void |init_ids s |void |init_lexer diff --git a/embedvar.h b/embedvar.h index f7549406ea..f8387c519d 100644 --- a/embedvar.h +++ b/embedvar.h @@ -1648,6 +1648,7 @@ #define PL_do_undump (PL_Vars.Gdo_undump) #define PL_hexdigit (PL_Vars.Ghexdigit) #define PL_malloc_mutex (PL_Vars.Gmalloc_mutex) +#define PL_op_mutex (PL_Vars.Gop_mutex) #define PL_patleave (PL_Vars.Gpatleave) #define PL_thr_key (PL_Vars.Gthr_key) @@ -1659,6 +1660,7 @@ #define PL_Gdo_undump PL_do_undump #define PL_Ghexdigit PL_hexdigit #define PL_Gmalloc_mutex PL_malloc_mutex +#define PL_Gop_mutex PL_op_mutex #define PL_Gpatleave PL_patleave #define PL_Gthr_key PL_thr_key diff --git a/epoc/config.sh b/epoc/config.sh index 71316834c8..a3051d479e 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -630,6 +630,7 @@ signal_t='void' sitearch='/perl/lib/site_perl/5.5.670/epoc' sitearchexp='/perl/lib/site_perl/5.5.670/epoc' sitelib='/perl/lib/site_perl/5.5.670/' +sitelib_stem='/perl/lib/site_perl' sitelibexp='/perl/lib/site_perl/5.5.670/' siteprefix='' siteprefixexp='' @@ -697,6 +698,7 @@ usevfork='' usrinc='' uuname='' vendorlib='' +vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' diff --git a/epoc/epocish.h b/epoc/epocish.h index ca992cfdfb..f4be0ff677 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -36,7 +36,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm index d62967fe12..bc0eda935b 100644 --- a/ext/B/B/Asmdata.pm +++ b/ext/B/B/Asmdata.pm @@ -72,7 +72,7 @@ $insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"]; $insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"]; $insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"]; +$insn_data{xcv_flags} = [52, \&PUT_U16, "GET_U16"]; $insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"]; $insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"]; $insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"]; diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm index cb061f3038..27003b6bd0 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -463,20 +463,23 @@ sub B::GV::bytecode { return if saved($gv); my $ix = $gv->objix; mark_saved($gv); - my $gvname = $gv->NAME; - my $name = cstring($gv->STASH->NAME . "::" . $gvname); - my $egv = $gv->EGV; - my $egvix = $egv->objix; ldsv($ix); - printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE, pvstring($gv->FILE); + printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS; sv_flags 0x%x xgv_flags 0x%x +EOT + my $refcnt = $gv->REFCNT; + printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1; + return if $gv->is_empty; + printf <<"EOT", $gv->LINE, pvstring($gv->FILE); gp_line %d newpv %s gp_file EOT - my $refcnt = $gv->REFCNT; - printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1; + my $gvname = $gv->NAME; + my $name = cstring($gv->STASH->NAME . "::" . $gvname); + my $egv = $gv->EGV; + my $egvix = $egv->objix; my $gvrefcnt = $gv->GvREFCNT; printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1; if ($gvrefcnt > 1 && $ix != $egvix) { @@ -580,7 +583,7 @@ sub B::CV::bytecode { for ($i = 0; $i < @ixes; $i++) { printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; } - printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS; + printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS; printf "newpv %s\nxcv_file\n", pvstring($cv->FILE); # Now save all the subfields (except for CvROOT which was handled # above) and CvSTART (now the initial element of @subfields). @@ -650,7 +653,7 @@ sub bytecompile_main { walkoptree(main_root, "bytecode"); warn "done main program, now walking symbol table\n" if $debug_bc; my ($pack, %exclude); - foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS strict vars + foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS strict vars FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol SelectSaver blib Cwd)) { diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index dafef33bb1..d0c8159d9f 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -1068,7 +1068,7 @@ typedef struct { perl_mutex *xcv_mutexp; struct perl_thread *xcv_owner; /* current owner thread */ #endif /* USE_THREADS */ - U8 xcv_flags; + cv_flags_t xcv_flags; } XPVCV_or_similar; #define ANYINIT(i) i #else diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm index fca3443c13..0a3543eed4 100644 --- a/ext/B/B/Stash.pm +++ b/ext/B/B/Stash.pm @@ -29,7 +29,7 @@ sub scan{ } sub omit{ my $module = shift; - my %omit=("DynaLoader::" => 1 , "CORE::" => 1 , + my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 , "CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 ); return 1 if $omit{$module}; if ($module eq "IO::" or $module eq "IO::Handle::"){ diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index 0a5ceabda1..b4078b8bd3 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -324,7 +324,7 @@ sub xref_definitions { my ($pack, %exclude); return if $nodefs; $subname = "(definitions)"; - foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS + foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS strict vars FileHandle Exporter Carp)) { $exclude{$pack."::"} = 1; } diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h index 6e19e129df..1621fed4eb 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -30,8 +30,22 @@ typedef IV IV64; } \ } STMT_END -#define BGET_comment_t(arg) \ +#ifdef BYTELOADER_LOG_COMMENTS +# define BGET_comment_t(arg) \ + STMT_START { \ + char buf[1024]; \ + int i = 0; \ + do { \ + arg = BGET_FGETC(); \ + buf[i++] = (char)arg; \ + } while (arg != '\n' && arg != EOF); \ + buf[i] = '\0'; \ + PerlIO_printf(PerlIO_stderr(), "%s", buf); \ + } STMT_END +#else +# define BGET_comment_t(arg) \ do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) +#endif /* * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV @@ -113,7 +127,8 @@ typedef IV IV64; ((PMOP*)o)->op_pmregexp = arg ? \ CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 #define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) -#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg]) +#define BSET_newop(o, arg) ((o = (OP*)safemalloc(optype_size[arg])), \ + memzero((char*)o,optype_size[arg])) #define BSET_newopn(o, arg) STMT_START { \ OP *oldop = o; \ BSET_newop(o, arg); \ diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 595fd4e18d..a1044ab2c0 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -431,8 +431,8 @@ byterun(pTHXo_ struct bytestream bs) } case INSN_XCV_FLAGS: /* 52 */ { - U8 arg; - BGET_U8(arg); + U16 arg; + BGET_U16(arg); CvFLAGS(bytecode_sv) = arg; break; } diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm index c86299c619..93b87f9aba 100644 --- a/ext/Data/Dumper/Dumper.pm +++ b/ext/Data/Dumper/Dumper.pm @@ -146,11 +146,17 @@ sub Names { sub DESTROY {} +sub Dump { + return &Dumpxs + unless $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq}); + return &Dumpperl; +} + # # dump the refs in the current dumper object. # expects same args as new() if called via package name. # -sub Dump { +sub Dumpperl { my($s) = shift; my(@out, $val, $name); my($i) = 0; @@ -440,9 +446,7 @@ sub Dumper { return Data::Dumper->Dump([@_]); } -# -# same, only calls the XS version -# +# compat stub sub DumperX { return Data::Dumper->Dumpxs([@_], []); } @@ -687,12 +691,6 @@ of strings corresponding to the supplied values. The second form, for convenience, simply calls the C<new> method on its arguments before dumping the object immediately. -=item I<$OBJ>->Dumpxs I<or> I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>) - -This method is available if you were able to compile and install the XSUB -extension to C<Data::Dumper>. It is exactly identical to the C<Dump> method -above, only about 4 to 5 times faster, since it is written entirely in C. - =item I<$OBJ>->Seen(I<[HASHREF]>) Queries or adds to the internal table of already encountered references. @@ -736,12 +734,6 @@ configuration options below. The values will be named C<$VAR>I<n> in the output, where I<n> is a numeric suffix. Will return a list of strings in an array context. -=item DumperX(I<LIST>) - -Identical to the C<Dumper()> function above, but this calls the XSUB -implementation. Only available if you were able to compile and install -the XSUB extensions in C<Data::Dumper>. - =back =head2 Configuration Variables or Methods @@ -797,8 +789,8 @@ When set, enables the use of double quotes for representing string values. Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe" characters will be backslashed, and unprintable characters will be output as quoted octal integers. Since setting this variable imposes a performance -penalty, the default is 0. The C<Dumpxs()> method does not honor this -flag yet. +penalty, the default is 0. C<Dump()> will run slower if this flag is set, +since the fast XSUB implementation doesn't support it yet. =item $Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>) @@ -1031,8 +1023,8 @@ to have, you can use the C<Seen> method to pre-seed the internal reference table and make the dumped output point to them, instead. See L<EXAMPLES> above. -The C<Useqq> flag is not honored by C<Dumpxs()> (it always outputs -strings in single quotes). +The C<Useqq> flag makes Dump() run slower, since the XSUB implementation +does not support it. SCALAR objects have the weirdest looking C<bless> workaround. diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs index 6394a63b28..990ea74699 100644 --- a/ext/Data/Dumper/Dumper.xs +++ b/ext/Data/Dumper/Dumper.xs @@ -711,23 +711,17 @@ Data_Dumper_Dumpxs(href, ...) I32 gimme = GIMME; if (!SvROK(href)) { /* call new to get an object first */ - SV *valarray; - SV *namearray; - - if (items == 3) { - valarray = ST(1); - namearray = ST(2); - } - else - croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, NAME_ARY_REF)"); + if (items < 2) + croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])"); ENTER; SAVETMPS; PUSHMARK(sp); XPUSHs(href); - XPUSHs(sv_2mortal(newSVsv(valarray))); - XPUSHs(sv_2mortal(newSVsv(namearray))); + XPUSHs(sv_2mortal(newSVsv(ST(1)))); + if (items >= 3) + XPUSHs(sv_2mortal(newSVsv(ST(2)))); PUTBACK; i = perl_call_method("new", G_SCALAR); SPAGAIN; diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 0e0f79263d..e0eb604c73 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -77,8 +77,8 @@ $Is_MacOS = $^O eq 'MacOS'; @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @dl_library_path = (); # path to look for files -@dl_librefs = (); # things we have loaded -@dl_modules = (); # Modules we have loaded +#@dl_librefs = (); # things we have loaded +#@dl_modules = (); # Modules we have loaded # This is a fix to support DLD's unfortunate desire to relink -lc @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs index 1805f68a96..e01ae7e85a 100644 --- a/ext/File/Glob/Glob.xs +++ b/ext/File/Glob/Glob.xs @@ -170,7 +170,7 @@ MODULE = File::Glob PACKAGE = File::Glob void doglob(pattern,...) char *pattern -PROTOTYPE: +PROTOTYPE: $;$ PREINIT: glob_t pglob; int i; @@ -206,4 +206,4 @@ double constant(name,arg) char *name int arg -PROTOTYPE: +PROTOTYPE: $$ diff --git a/global.sym b/global.sym index e34d5c08c7..10b5303d78 100644 --- a/global.sym +++ b/global.sym @@ -58,6 +58,7 @@ Perl_croak_nocontext Perl_die_nocontext Perl_deb_nocontext Perl_form_nocontext +Perl_load_module_nocontext Perl_mess_nocontext Perl_warn_nocontext Perl_warner_nocontext @@ -195,6 +196,8 @@ Perl_is_utf8_punct Perl_is_utf8_xdigit Perl_is_utf8_mark Perl_leave_scope +Perl_load_module +Perl_vload_module Perl_looks_like_number Perl_markstack_grow Perl_mess diff --git a/hints/aix.sh b/hints/aix.sh index d679ba9ee8..d6f3dd78e0 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -360,6 +360,7 @@ $define|true|[yY]*) ccflags="$ccflags -qlongdouble" # The explicit cc128, xlc128, xlC128 are not needed, # the -qlongdouble should do the trick. --jhi + d_Gconvert='sprintf((b),"%.*llg",(n),(x))' ;; esac EOCBU diff --git a/hints/hpux.sh b/hints/hpux.sh index 9a0d362b24..91ba86831e 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -21,8 +21,10 @@ # Don't assume every OS != 10 is < 10, (e.g., 11). # From: Chuck Phillips <cdp@fc.hp.com> # HP-UX 10 pthreads hints: Matthew T Harden <mthard@mthard1.monsanto.com> +# From: Dominic Dunlop <domo@computer.org> +# Abort and offer advice if bundled (non-ANSI) C compiler selected -# This version: August 15, 1997 +# This version: March 8, 2000 # Current maintainer: Jeff Okamoto <okamoto@corp.hp.com> #-------------------------------------------------------------------- @@ -64,21 +66,19 @@ ccflags="$ccflags -D_HPUX_SOURCE" # Check if you're using the bundled C compiler. This compiler doesn't support -# ANSI C (the -Aa flag) nor can it produce shared libraries. Thus we have -# to turn off dynamic loading. +# ANSI C (the -Aa flag) and so is not suitable for perl 5.5 and later. case "$cc" in '') if cc $ccflags -Aa 2>&1 | $contains 'option' >/dev/null then - case "$usedl" in - '') usedl="$undef" cat <<'EOM' >&4 -The bundled C compiler can not produce shared libraries, so you will -not be able to use dynamic loading. +The bundled C compiler is not ANSI-compliant, and so cannot be used to +build perl. Please see the file README.hpux for advice on alternative +compilers. +Cannot continue, aborting. EOM - ;; - esac + exit 1 else ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C # cppstdin and cpprun need the -Aa option if you use the unbundled @@ -92,12 +92,15 @@ EOM cppminus='-' cpplast='-' fi - # For HP's ANSI C compiler, up to "+O3" is safe for everything - # except shared libraries (PIC code). Max safe for PIC is "+O2". - # Setting both causes innocuous warnings. - #optimize='+O3' - #cccdlflags='+z +O2' - optimize='-O' + case "$optimize" in + # For HP's ANSI C compiler, up to "+O3" is safe for everything + # except shared libraries (PIC code). Max safe for PIC is "+O2". + # Setting both causes innocuous warnings. + '') optimize='-O' + #optimize='+O3' + #cccdlflags='+z +O2' + ;; + esac cc=cc ;; esac diff --git a/hints/irix_6.sh b/hints/irix_6.sh index 6119c0d282..9d9852d049 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -142,8 +142,17 @@ case "$cc" in ld=$cc # perl's malloc can return improperly aligned buffer - # usemymalloc='undef' -malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' + # which (under 5.6.0RC1) leads into really bizarre bus errors + # and freak test failures (lib/safe1 #18, for example), + # even more so with -Duse64bitall: for example lib/io_linenumtb. + # fails under the harness but succeeds when run separately, + # under make test pragma/warnings #98 fails, and lib/io_dir + # apparently coredumps (the last two don't happen under + # the harness. Helmut Jarausch is seeing bus errors from + # miniperl, as was Scott Henry with snapshots from just before + # the RC1. --jhi + usemymalloc='undef' +#malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' nm_opt='-p' nm_so_opt='-p' diff --git a/hints/lynxos.sh b/hints/lynxos.sh index bde461f27b..0023e831b0 100644 --- a/hints/lynxos.sh +++ b/hints/lynxos.sh @@ -4,11 +4,16 @@ # These hints were submitted by: # Greg Seibert # seibert@Lynx.COM +# and +# Ed Mooring +# mooring@lynx.com # cc='gcc' so='none' usemymalloc='n' +d_union_semun='define' +ccflags="$ccflags -DEXTRA_F_IN_SEMUN_BUF -D__NO_INCLUDE_WARN__" # When LynxOS runs a script with "#!" it sets argv[0] to the script name toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' diff --git a/installhtml b/installhtml index c268f54b36..cfbbe9f5c6 100755 --- a/installhtml +++ b/installhtml @@ -159,6 +159,10 @@ $pod2html = "pod/pod2html"; usage("") unless @ARGV; +# Overcome shell's p1,..,p8 limitation. +# See vms/descrip_mms.template -> descrip.mms for invokation. +if ( $^O eq 'VMS' ) { @ARGV = split(/\s+/,$ARGV[0]); } + # parse the command-line $result = GetOptions( qw( help diff --git a/installperl b/installperl index dd6d66394d..b2ddc84c24 100755 --- a/installperl +++ b/installperl @@ -86,12 +86,28 @@ if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) } find(sub { - if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { - (my $pm = $1) =~ s{^lib/}{}; - $archpms{$pm} = 1; + if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) { + my($path, $modname) = ($1,$2); + + # strip trailing component first + $path =~ s{/[^/]*$}{}; + + # strip optional "/lib"; + $path =~ s{/lib\b}{}; + + # strip any leading / + $path =~ s{^/}{}; + + # reconstitute canonical module name + $modname = "$path/$modname" if length $path; + + # remember it + $archpms{$modname} = 1; } }, 'ext'); +# print "[$_]\n" for sort keys %archpms; + my $ver = $Config{version}; my $release = substr($],0,3); # Not used presently. my $patchlevel = substr($],3,2); @@ -359,7 +375,7 @@ if (! $versiononly) { if (! $versiononly) { safe_unlink("$installscript/pstruct$scr_ext"); - if ($^O eq 'dos' or $Is_VMS) { + if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') { copy("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext"); } else { link("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext"); diff --git a/iperlsys.h b/iperlsys.h index d07d525edc..f36dcd5f32 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -595,8 +595,9 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*, #endif #ifdef WIN32 typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*); -typedef char* (*LPEnvLibPath)(struct IPerlEnv*, char*); -typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, char*); +typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*); +typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*); +typedef char* (*LPEnvVendorLibPath)(struct IPerlEnv*, const char*); typedef void (*LPEnvGetChildIO)(struct IPerlEnv*, child_IO_table*); #endif @@ -619,6 +620,7 @@ struct IPerlEnv LPEnvOsID pEnvOsID; LPEnvLibPath pLibPath; LPEnvSiteLibPath pSiteLibPath; + LPEnvVendorLibPath pVendorLibPath; LPEnvGetChildIO pGetChildIO; #endif }; @@ -665,6 +667,8 @@ struct IPerlEnvInfo (*PL_Env->pLibPath)(PL_Env,(str)) #define PerlEnv_sitelib_path(str) \ (*PL_Env->pSiteLibPath)(PL_Env,(str)) +#define PerlEnv_vendorlib_path(str) \ + (*PL_Env->pVendorLibPath)(PL_Env,(str)) #define PerlEnv_get_child_IO(ptr) \ (*PL_Env->pGetChildIO)(PL_Env, ptr) #endif @@ -690,6 +694,9 @@ struct IPerlEnvInfo #ifdef WIN32 #define PerlEnv_os_id() win32_os_id() +#define PerlEnv_lib_path(str) win32_get_privlib(str) +#define PerlEnv_sitelib_path(str) win32_get_sitelib(str) +#define PerlEnv_vendorlib_path(str) win32_get_vendorlib(str) #define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr) #endif diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 08e7436760..96e1bb44c4 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -273,7 +273,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline) $BLOCK_re= '\s*(' . join('|', qw( REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE - SCOPE INTERFACE INTERFACE_MACRO C_ARGS POST_CALL + SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL )) . "|$END)\\s*:"; # Input: ($_, @line) == unparsed input. @@ -436,7 +436,7 @@ sub INPUT_handler { $func_args =~ s/\b($var_name)\b/&$1/; } if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/ - or $in_out{$var_name} and $in_out{$var_name} eq 'outlist' + or $in_out{$var_name} and $in_out{$var_name} eq 'OUTLIST' and $var_init !~ /\S/) { if ($name_printed) { print ";\n"; @@ -522,7 +522,7 @@ EOF sub CLEANUP_handler() { print_section() } sub PREINIT_handler() { print_section() } -sub POST_CALL_handler() { print_section() } +sub POSTCALL_handler() { print_section() } sub INIT_handler() { print_section() } sub GetAliases @@ -1041,10 +1041,10 @@ while (fetch_para()) { next unless length $pre; my $out_type; my $inout_var; - if ($process_inout and s/^(in|in_outlist|outlist)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) { my $type = $1; - $out_type = $type if $type ne 'in'; - $arg =~ s/^(in|in_outlist|outlist)\s+//; + $out_type = $type if $type ne 'IN'; + $arg =~ s/^(IN|IN_OUTLIST|OUTLIST)\s+//; } if (/\W/) { # Has a type push @arg_with_types, $arg; @@ -1052,7 +1052,7 @@ while (fetch_para()) { $arg_types{$name} = $arg; $_ = "$name$default"; } - $out_vars{$_} = 1 if $out_type eq 'outlist'; + $out_vars{$_} = 1 if $out_type eq 'OUTLIST'; push @in_out, $name if $out_type; $in_out{$name} = $out_type if $out_type; } @@ -1063,10 +1063,10 @@ while (fetch_para()) { } else { @args = split(/\s*,\s*/, $orig_args); for (@args) { - if ($process_inout and s/^(in|in_outlist|outlist)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) { my $out_type = $1; - next if $out_type eq 'in'; - $out_vars{$_} = 1 if $out_type eq 'outlist'; + next if $out_type eq 'IN'; + $out_vars{$_} = 1 if $out_type eq 'OUTLIST'; push @in_out, $name; $in_out{$_} = $out_type; } @@ -1278,7 +1278,7 @@ EOF # $wantRETVAL set if 'RETVAL =' autogenerated ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return; undef %outargs ; - process_keyword("POST_CALL|OUTPUT|ALIAS|PROTOTYPE"); + process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); # all OUTPUT done, so now push the return value on the stack if ($gotRETVAL && $RETVAL_code) { diff --git a/lib/Fatal.pm b/lib/Fatal.pm index 5b832f6427..1496117c89 100644 --- a/lib/Fatal.pm +++ b/lib/Fatal.pm @@ -12,9 +12,15 @@ $Debug = 0 unless defined $Debug; sub import { my $self = shift(@_); my($sym, $pkg); + my $void = 0; $pkg = (caller)[0]; foreach $sym (@_) { - &_make_fatal($sym, $pkg); + if ($sym eq ":void") { + $void = 1; + } + else { + &_make_fatal($sym, $pkg, $void); + } } }; @@ -42,11 +48,11 @@ sub fill_protos { } sub write_invocation { - my ($core, $call, $name, @argvs) = @_; + my ($core, $call, $name, $void, @argvs) = @_; if (@argvs == 1) { # No optional arguments my @argv = @{$argvs[0]}; shift @argv; - return "\t" . one_invocation($core, $call, $name, @argv) . ";\n"; + return "\t" . one_invocation($core, $call, $name, $void, @argv) . ";\n"; } else { my $else = "\t"; my (@out, @argv, $n); @@ -56,7 +62,7 @@ sub write_invocation { push @out, "$ {else}if (\@_ == $n) {\n"; $else = "\t} els"; push @out, - "\t\treturn " . one_invocation($core, $call, $name, @argv) . ";\n"; + "\t\treturn " . one_invocation($core, $call, $name, $void, @argv) . ";\n"; } push @out, <<EOC; } @@ -67,21 +73,27 @@ EOC } sub one_invocation { - my ($core, $call, $name, @argv) = @_; + my ($core, $call, $name, $void, @argv) = @_; local $" = ', '; - return qq{$call(@argv) || croak "Can't $name(\@_)} . - ($core ? ': $!' : ', \$! is \"$!\"') . '"'; + if ($void) { + return qq/(defined wantarray)?$call(@argv): + $call(@argv) || croak "Can't $name(\@_)/ . + ($core ? ': $!' : ', \$! is \"$!\"') . '"' + } else { + return qq{$call(@argv) || croak "Can't $name(\@_)} . + ($core ? ': $!' : ', \$! is \"$!\"') . '"'; + } } sub _make_fatal { - my($sub, $pkg) = @_; + my($sub, $pkg, $void) = @_; my($name, $code, $sref, $real_proto, $proto, $core, $call); my $ini = $sub; $sub = "${pkg}::$sub" unless $sub =~ /::/; $name = $sub; $name =~ s/.*::// or $name =~ s/^&//; - print "# _make_fatal: sub=$sub pkg=$pkg name=$name\n" if $Debug; + print "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug; croak "Bad subroutine name for Fatal: $name" unless $name =~ /^\w+$/; if (defined(&$sub)) { # user subroutine $sref = \&$sub; @@ -109,7 +121,7 @@ sub$real_proto { local(\$", \$!) = (', ', 0); EOS my @protos = fill_protos($proto); - $code .= write_invocation($core, $call, $name, @protos); + $code .= write_invocation($core, $call, $name, $void, @protos); $code .= "}\n"; print $code if $Debug; { @@ -139,11 +151,10 @@ Fatal - replace functions with equivalents which succeed or die =head1 DESCRIPTION C<Fatal> provides a way to conveniently replace functions which normally -return a false value when they fail with equivalents which halt execution +return a false value when they fail with equivalents which raise exceptions if they are not successful. This lets you use these functions without -having to test their return values explicitly on each call. Errors are -reported via C<die>, so you can trap them using C<$SIG{__DIE__}> if you -wish to take some action before the program exits. +having to test their return values explicitly on each call. Exceptions +can be caught using C<eval{}>. See L<perlfunc> and L<perlvar> for details. The do-or-die equivalents are set up simply by calling Fatal's C<import> routine, passing it the names of the functions to be @@ -151,6 +162,21 @@ replaced. You may wrap both user-defined functions and overridable CORE operators (except C<exec>, C<system> which cannot be expressed via prototypes) in this way. +If the symbol C<:void> appears in the import list, then functions +named later in that import list raise an exception only when +these are called in void context--that is, when their return +values are ignored. For example + + use Fatal qw/:void open close/; + + # properly checked, so no exception raised on error + if(open(FH, "< /bogotic") { + warn "bogo file, dude: $!"; + } + + # not checked, so error raises an exception + close FH; + =head1 AUTHOR Lionel.Cons@cern.ch diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm index e5a2467927..d7dea7b46c 100644 --- a/lib/File/DosGlob.pm +++ b/lib/File/DosGlob.pm @@ -19,13 +19,18 @@ sub doglob { my $sepchr = '/'; next OUTER unless defined $_ and $_ ne ''; # if arg is within quotes strip em and do no globbing - if (/^"(.*)"$/) { + if (/^"(.*)"\z/s) { $_ = $1; if ($cond eq 'd') { push(@retval, $_) if -d $_ } else { push(@retval, $_) if -e $_ } next OUTER; } - if (m|^(.*)([\\/])([^\\/]*)$|) { + # wildcards with a drive prefix such as h:*.pm must be changed + # to h:./*.pm to expand correctly + if (m|^([A-Za-z]:)[^/\\]|s) { + substr($_,0,2) = $1 . "./"; + } + if (m|^(.*)([\\/])([^\\/]*)\z|s) { my $tail; ($head, $sepchr, $tail) = ($1,$2,$3); #print "div: |$head|$sepchr|$tail|\n"; @@ -35,7 +40,7 @@ sub doglob { push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)), next OUTER if @globdirs; } - $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:$/; + $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s; $_ = $tail; } # @@ -142,7 +147,7 @@ sub import { my $pkg = shift; return unless @_; my $sym = shift; - my $callpkg = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0)); + my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0)); *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob'; } diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 79fdfb6ca1..46f360a461 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -73,7 +73,7 @@ than VMS is settled. (defaults to FALSE) =back It returns the number of files successfully deleted. Symlinks are -treated as ordinary files. +simply deleted and not followed. B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure> in the face of failure or interruption. Files and directories which @@ -205,7 +205,9 @@ sub rmtree { } else { if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { + ($Is_VMS ? !&VMS::Filespec::candelete($root) + : !(-l $root || -w $root))) + { print "skipped $root\n" if $verbose; next; } diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 28c1050576..cf048c5f0a 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -142,6 +142,13 @@ sub canonpath { else { return vmsify($path); } } else { +>>>> ORIGINAL VMS.pm#13 + $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar + $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo + if ($reduce_ricochet) { + $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/g; + $path =~ s/([\[<\.])([^\[<\.]+)\.-\.?/$1/g; + } $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo 1 while $path =~ s{-\.-}{--}; # -.- ==> -- diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 4e9ef8b6a0..097e14a7d6 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -100,75 +100,6 @@ sub ConfigDefaults () { ConfigDefaults(); -################ Object Oriented routines ################ - -=experimental - -# NOTE: The object oriented routines use $error for thread locking. -eval "sub lock{}" if $] < 5.005; - -# Store a copy of the default configuration. Since ConfigDefaults has -# just been called, what we get from Configure is the default. -my $default_config = do { lock ($error); Configure () }; - -sub new { - my $that = shift; - my $class = ref($that) || $that; - - # Register the callers package. - my $self = { caller => (caller)[0] }; - - bless ($self, $class); - - # Process construct time configuration. - if ( @_ > 0 ) { - lock ($error); - my $save = Configure ($default_config, @_); - $self->{settings} = Configure ($save); - } - # Else use default config. - else { - $self->{settings} = $default_config; - } - - $self; -} - -sub configure { - my ($self) = shift; - - lock ($error); - - # Restore settings, merge new settings in. - my $save = Configure ($self->{settings}, @_); - - # Restore orig config and save the new config. - $self->{settings} = Configure ($save); -} - -sub getoptions { - my ($self) = shift; - - lock ($error); - - # Restore config settings. - my $save = Configure ($self->{settings}); - - # Call main routine. - my $ret = 0; - $caller = $self->{caller}; - eval { $ret = GetOptions (@_); }; - - # Restore saved settings. - Configure ($save); - - # Handle errors and return value. - die ($@) if $@; - return $ret; -} - -=cut - ################ Package return ################ 1; diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm index 32282d62b3..161620ba24 100644 --- a/lib/IPC/Open2.pm +++ b/lib/IPC/Open2.pm @@ -1,7 +1,7 @@ package IPC::Open2; use strict; -use vars qw($VERSION @ISA @EXPORT); +our ($VERSION, @ISA, @EXPORT); require 5.000; require Exporter; @@ -17,47 +17,64 @@ IPC::Open2, open2 - open a process for both reading and writing =head1 SYNOPSIS use IPC::Open2; - $pid = open2(\*RDR, \*WTR, 'some cmd and args'); - # or - $pid = open2(\*RDR, \*WTR, 'some', 'cmd', 'and', 'args'); + + $pid = open2(\*RDRFH, \*WTRFH, 'some cmd and args'); + # or without using the shell + $pid = open2(\*RDRFH, \*WTRFH, 'some', 'cmd', 'and', 'args'); + + # or with handle autovivification + my($rdrfh, $wtrfh); + $pid = open2($rdrfh, $wtrfh, 'some cmd and args'); + # or without using the shell + $pid = open2($rdrfh, $wtrfh, 'some', 'cmd', 'and', 'args'); =head1 DESCRIPTION -The open2() function spawns the given $cmd and connects $rdr for -reading and $wtr for writing. It's what you think should work +The open2() function runs the given $cmd and connects $rdrfh for +reading and $wtrfh for writing. It's what you think should work when you try - open(HANDLE, "|cmd args|"); + $pid = open(HANDLE, "|cmd args|"); The write filehandle will have autoflush turned on. -If $rdr is a string (that is, a bareword filehandle rather than a glob -or a reference) and it begins with ">&", then the child will send output -directly to that file handle. If $wtr is a string that begins with -"<&", then WTR will be closed in the parent, and the child will read +If $rdrfh is a string (that is, a bareword filehandle rather than a glob +or a reference) and it begins with C<< >& >>, then the child will send output +directly to that file handle. If $wtrfh is a string that begins with +C<< <& >>, then $wtrfh will be closed in the parent, and the child will read from it directly. In both cases, there will be a dup(2) instead of a pipe(2) made. -open2() returns the process ID of the child process. It doesn't return on -failure: it just raises an exception matching C</^open2:/>. - -=head1 WARNING +If either reader or writer is the null string, this will be replaced +by an autogenerated filehandle. If so, you must pass a valid lvalue +in the parameter slot so it can be overwritten in the caller, or +an exception will be raised. -It will not create these file handles for you. You have to do this yourself. -So don't pass it empty variables expecting them to get filled in for you. +open2() returns the process ID of the child process. It doesn't return on +failure: it just raises an exception matching C</^open2:/>. However, +C<exec> failures in the child are not detected. You'll have to +trap SIGPIPE yourself. -Additionally, this is very dangerous as you may block forever. -It assumes it's going to talk to something like B<bc>, both writing to -it and reading from it. This is presumably safe because you "know" -that commands like B<bc> will read a line at a time and output a line at -a time. Programs like B<sort> that read their entire input stream first, -however, are quite apt to cause deadlock. +This whole affair is quite dangerous, as you may block forever. It +assumes it's going to talk to something like B<bc>, both writing +to it and reading from it. This is presumably safe because you +"know" that commands like B<bc> will read a line at a time and +output a line at a time. Programs like B<sort> that read their +entire input stream first, however, are quite apt to cause deadlock. The big problem with this approach is that if you don't have control over source code being run in the child process, you can't control what it does with pipe buffering. Thus you can't just open a pipe to C<cat -v> and continually read and write a line from it. +The IO::Pty and Expect modules from CPAN can help with this, as they +provide a real tty (well, a pseudo-tty, actually), which gets you +back to line buffering in the invoked command again. + +=head1 WARNING + +The order of arguments differs from that of open3(). + =head1 SEE ALSO See L<IPC::Open3> for an alternative that handles STDERR as well. This @@ -86,10 +103,9 @@ function is really just a wrapper around open3(). require IPC::Open3; sub open2 { - my ($read, $write, @cmd) = @_; local $Carp::CarpLevel = $Carp::CarpLevel + 1; return IPC::Open3::_open3('open2', scalar caller, - $write, $read, '>&STDERR', @cmd); + $_[1], $_[0], '>&STDERR', @_[2 .. $#_]); } 1 diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index d0790417bc..d43f1bdb4b 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -2,9 +2,8 @@ package IPC::Open3; use strict; no strict 'refs'; # because users pass me bareword filehandles -use vars qw($VERSION @ISA @EXPORT $Me); +our ($VERSION, @ISA, @EXPORT); -require 5.001; require Exporter; use Carp; @@ -23,37 +22,43 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'some cmd and args', 'optarg', ...); + my($wtr, $rdr, $err); + $pid = open3($wtr, $rdr, $err, + 'some cmd and args', 'optarg', ...); + =head1 DESCRIPTION Extremely similar to open2(), open3() spawns the given $cmd and connects RDRFH for reading, WTRFH for writing, and ERRFH for errors. If -ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are -on the same file handle. The WTRFH will have autoflush turned on. +ERRFH is false, or the same file descriptor as RDRFH, then STDOUT and +STDERR of the child are on the same filehandle. The WTRFH will have +autoflush turned on. -If WTRFH begins with "E<lt>&", then WTRFH will be closed in the parent, and +If WTRFH begins with C<< <& >>, then WTRFH will be closed in the parent, and the child will read from it directly. If RDRFH or ERRFH begins with -"E<gt>&", then the child will send output directly to that file handle. +C<< >& >>, then the child will send output directly to that filehandle. In both cases, there will be a dup(2) instead of a pipe(2) made. -If you try to read from the child's stdout writer and their stderr -writer, you'll have problems with blocking, which means you'll -want to use select(), which means you'll have to use sysread() instead -of normal stuff. +If either reader or writer is the null string, this will be replaced +by an autogenerated filehandle. If so, you must pass a valid lvalue +in the parameter slot so it can be overwritten in the caller, or +an exception will be raised. open3() returns the process ID of the child process. It doesn't return on -failure: it just raises an exception matching C</^open3:/>. - -=head1 WARNING - -It will not create these file handles for you. You have to do this -yourself. So don't pass it empty variables expecting them to get filled -in for you. +failure: it just raises an exception matching C</^open3:/>. However, +C<exec> failures in the child are not detected. You'll have to +trap SIGPIPE yourself. -Additionally, this is very dangerous as you may block forever. It -assumes it's going to talk to something like B<bc>, both writing to it -and reading from it. This is presumably safe because you "know" that -commands like B<bc> will read a line at a time and output a line at a -time. Programs like B<sort> that read their entire input stream first, +If you try to read from the child's stdout writer and their stderr +writer, you'll have problems with blocking, which means you'll want +to use select() or the IO::Select, which means you'd best use +sysread() instead of readline() for normal stuff. + +This is very dangerous, as you may block forever. It assumes it's +going to talk to something like B<bc>, both writing to it and reading +from it. This is presumably safe because you "know" that commands +like B<bc> will read a line at a time and output a line at a time. +Programs like B<sort> that read their entire input stream first, however, are quite apt to cause deadlock. The big problem with this approach is that if you don't have control @@ -61,12 +66,17 @@ over source code being run in the child process, you can't control what it does with pipe buffering. Thus you can't just open a pipe to C<cat -v> and continually read and write a line from it. +=head1 WARNING + +The order of arguments differs from that of open2(). + =cut # &open3: Marc Horowitz <marc@mit.edu> # derived mostly from &open2 by tom christiansen, <tchrist@convex.com> # fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com> # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career +# fixed for autovivving FHs, tchrist again # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -94,7 +104,7 @@ C<cat -v> and continually read and write a line from it. # rdr or wtr are null # a system call fails -$Me = 'open3 (bug)'; # you should never see this, it's always localized +our $Me = 'open3 (bug)'; # you should never see this, it's always localized # Fatal.pm needs to be fixed WRT prototypes. @@ -126,15 +136,27 @@ sub _open3 { my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; my($dup_wtr, $dup_rdr, $dup_err, $kidpid); - $dad_wtr or croak "$Me: wtr should not be null"; - $dad_rdr or croak "$Me: rdr should not be null"; - $dad_err = $dad_rdr if ($dad_err eq ''); + # simulate autovivification of filehandles because + # it's too ugly to use @_ throughout to make perl do it for us + # tchrist 5-Mar-00 + + unless (eval { + $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr; + $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr; + 1; }) + { + # must strip crud for croak to add back, or looks ugly + $@ =~ s/(?<=value attempted) at .*//s; + croak "$Me: $@"; + } + + $dad_err ||= $dad_rdr; $dup_wtr = ($dad_wtr =~ s/^[<>]&//); $dup_rdr = ($dad_rdr =~ s/^[<>]&//); $dup_err = ($dad_err =~ s/^[<>]&//); - # force unqualified filehandles into callers' package + # force unqualified filehandles into caller's package $dad_wtr = qualify $dad_wtr, $package; $dad_rdr = qualify $dad_rdr, $package; $dad_err = qualify $dad_err, $package; @@ -185,7 +207,7 @@ sub _open3 { xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); } local($")=(" "); - exec @cmd + exec @cmd # XXX: wrong process to croak from or croak "$Me: exec of @cmd failed"; } elsif ($do_spawn) { # All the bookkeeping of coincidence between handles is diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm index 5b7ddb6f2c..1a47f4af5e 100644 --- a/lib/Math/Complex.pm +++ b/lib/Math/Complex.pm @@ -66,9 +66,10 @@ use overload # Package "privates" # -my $package = 'Math::Complex'; # Package name -my $display = 'cartesian'; # Default display format -my $eps = 1e-14; # Epsilon +my $package = 'Math::Complex'; # Package name +my %DISPLAY_FORMAT = ('style' => 'cartesian', + 'polar_pretty_print' => 1); +my $eps = 1e-14; # Epsilon # # Object attributes (internal): @@ -161,7 +162,7 @@ sub new { &make } # For backward compatibility only. # sub cplx { my ($re, $im) = @_; - return $package->make($re, defined $im ? $im : 0); + return __PACKAGE__->make($re, defined $im ? $im : 0); } # @@ -172,7 +173,7 @@ sub cplx { # sub cplxe { my ($rho, $theta) = @_; - return $package->emake($rho, defined $theta ? $theta : 0); + return __PACKAGE__->emake($rho, defined $theta ? $theta : 0); } # @@ -836,7 +837,7 @@ sub acos { 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); + return __PACKAGE__->make($u, $v); } # @@ -858,7 +859,7 @@ sub asin { 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); + return __PACKAGE__->make($u, $v); } # @@ -1154,34 +1155,53 @@ sub atan2 { # display_format # ->display_format # -# Set (fetch if no argument) display format for all complex numbers that +# Set (get if no argument) the display format for all complex numbers that # don't happen to have overridden it via ->display_format # -# When called as a method, this actually sets the display format for +# When called as an object method, this actually sets the display format for # the current object. # # Valid object formats are 'c' and 'p' for cartesian and polar. The first # letter is used actually, so the type can be fully spelled out for clarity. # sub display_format { - my $self = shift; - my $format = undef; + my $self = shift; + my %display_format = %DISPLAY_FORMAT; - if (ref $self) { # Called as a method - $format = shift; - } else { # Regular procedure call - $format = $self; - undef $self; + if (ref $self) { # Called as an object method + if (exists $self->{display_format}) { + my %obj = %{$self->{display_format}}; + @display_format{keys %obj} = values %obj; + } + if (@_ == 1) { + $display_format{style} = shift; + } else { + my %new = @_; + @display_format{keys %new} = values %new; + } + } else { # Called as a class method + if (@_ = 1) { + $display_format{style} = $self; + } else { + my %new = @_; + @display_format{keys %new} = values %new; + } + undef $self; } if (defined $self) { - return defined $self->{display} ? $self->{display} : $display - unless defined $format; - return $self->{display} = $format; + $self->{display_format} = { %display_format }; + return + wantarray ? + %{$self->{display_format}} : + $self->{display_format}->{style}; } - return $display unless defined $format; - return $display = $format; + %DISPLAY_FORMAT = %display_format; + return + wantarray ? + %DISPLAY_FORMAT : + $DISPLAY_FORMAT{style}; } # @@ -1196,12 +1216,12 @@ sub display_format { # sub stringify { my ($z) = shift; - my $format; - $format = $display; - $format = $z->{display} if defined $z->{display}; + my $style = $z->display_format; + + $style = $DISPLAY_FORMAT{style} unless defined $style; - return $z->stringify_polar if $format =~ /^p/i; + return $z->stringify_polar if $style =~ /^p/i; return $z->stringify_cartesian; } @@ -1221,17 +1241,27 @@ sub stringify_cartesian { 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 %format = $z->display_format; + my $format = $format{format}; + + if ($y == 1) { $im = 'i' } + elsif ($y == -1) { $im = '-i' } + elsif (CORE::abs($y) >= $eps) { + $im = (defined $format ? sprintf($format, $y) : $y) . "i"; + } my $str = ''; - $str = $re if defined $re; - $str .= "+$im" if defined $im; - $str =~ s/\+-/-/; - $str =~ s/^\+//; - $str =~ s/([-+])1i/$1i/; # Not redundant with the above 1/-1 tests. - $str = '0' unless $str; + $str = defined $format ? sprintf($format, $re) : $re + if defined $re; + if (defined $im) { + if ($y < 0) { + $str .= $im; + } elsif ($y > 0) { + $str .= "+" if defined $re; + $str .= $im; + } + } return $str; } @@ -1278,6 +1308,8 @@ sub stringify_polar { return '[0,0]' if $r <= $eps; + my %format = $z->display_format; + my $nt = $t / pit2; $nt = ($nt - int($nt)) * pit2; $nt += pit2 if $nt < 0; # Range [0, 2pi] @@ -1300,7 +1332,7 @@ sub stringify_polar { $nt -= pit2 if $nt > pi; - if (CORE::abs($nt) >= deg1) { + if ($format{polar_pretty_print} && CORE::abs($nt) >= deg1) { my ($n, $k, $kpi); for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) { @@ -1329,12 +1361,19 @@ sub stringify_polar { if ($theta !~ m(^-?\d*pi/\d+$) and int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps)); + my $format = $format{format}; + if (defined $format) { + $r = sprintf($format, $r); + $theta = sprintf($format, $theta); + } + return "\[$r,$theta\]"; } 1; __END__ +=pod =head1 NAME Math::Complex - complex numbers and associated mathematical functions @@ -1618,9 +1657,9 @@ It is possible to write: $x = cplxe(-3, pi/4); -but that will be silently converted into C<[3,-3pi/4]>, since the modulus -must be non-negative (it represents the distance to the origin in the complex -plane). +but that will be silently converted into C<[3,-3pi/4]>, since the +modulus must be non-negative (it represents the distance to the origin +in the complex plane). It is also possible to have a complex number as either argument of either the C<make> or C<emake>: the appropriate component of @@ -1632,31 +1671,67 @@ the argument will be used. =head1 STRINGIFICATION When printed, a complex number is usually shown under its cartesian -form I<a+bi>, but there are legitimate cases where the polar format +style I<a+bi>, but there are legitimate cases where the polar style I<[r,t]> is more appropriate. -By calling the routine C<Math::Complex::display_format> and supplying either -C<"polar"> or C<"cartesian">, you override the default display format, -which is C<"cartesian">. Not supplying any argument returns the current -setting. +By calling the class method C<Math::Complex::display_format> and +supplying either C<"polar"> or C<"cartesian"> as an argument, you +override the default display style, which is C<"cartesian">. Not +supplying any argument returns the current settings. This default can be overridden on a per-number basis by calling the C<display_format> method instead. As before, not supplying any argument -returns the current display format for this number. Otherwise whatever you -specify will be the new display format for I<this> particular number. +returns the current display style for this number. Otherwise whatever you +specify will be the new display style for I<this> particular number. For instance: use Math::Complex; Math::Complex::display_format('polar'); - $j = ((root(1, 3))[1]; - print "j = $j\n"; # Prints "j = [1,2pi/3] + $j = (root(1, 3))[1]; + print "j = $j\n"; # Prints "j = [1,2pi/3]" $j->display_format('cartesian'); print "j = $j\n"; # Prints "j = -0.5+0.866025403784439i" -The polar format attempts to emphasize arguments like I<k*pi/n> -(where I<n> is a positive integer and I<k> an integer within [-9,+9]). +The polar style attempts to emphasize arguments like I<k*pi/n> +(where I<n> is a positive integer and I<k> an integer within [-9,+9]), +this is called I<polar pretty-printing>. + +=head2 CHANGED IN PERL 5.6 + +The C<display_format> class method and the corresponding +C<display_format> object method can now be called using +a parameter hash instead of just a one parameter. + +The old display format style, which can have values C<"cartesian"> or +C<"polar">, can be changed using the C<"style"> parameter. (The one +parameter calling convention also still works.) + +There are two new display parameters. + +The first one is C<"format">, which is a sprintf()-style format +string to be used for both parts of the complex number(s). The +default is C<undef>, which corresponds usually (this is somewhat +system-dependent) to C<"%.15g">. You can revert to the default by +setting the format string to C<undef>. + + # the $j from the above example + + $j->display_format('format' => '%.5f'); + print "j = $j\n"; # Prints "j = -0.50000+0.86603i" + $j->display_format('format' => '%.6f'); + print "j = $j\n"; # Prints "j = -0.5+0.86603i" + +Notice that this affects also the return values of the +C<display_format> methods: in list context the whole parameter hash +will be returned, as opposed to only the style parameter value. If +you want to know the whole truth for a complex number, you must call +both the class method and the object method: + +The second new display parameter is C<"polar_pretty_print">, which can +be set to true or false, the default being true. See the previous +section for what this means. =head1 USAGE diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index d8dced66c8..89e3d0f432 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1399,7 +1399,9 @@ sub process_puretext { # converted to html commands. # -sub process_text1($$;$); +sub process_text1($$;$$); +sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' } +sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 } sub process_text { return if $ignore; @@ -1408,12 +1410,15 @@ sub process_text { $$tref = $res; } -sub process_text1($$;$){ - my( $lev, $rstr, $func ) = @_; - $lev++ unless defined $func; +sub process_text1($$;$$){ + my( $lev, $rstr, $func, $closing ) = @_; my $res = ''; - $func ||= ''; + unless (defined $func) { + $func = ''; + $lev++; + } + if( $func eq 'B' ){ # B<text> - boldface $res = '<STRONG>' . process_text1( $lev, $rstr ) . '</STRONG>'; @@ -1421,7 +1426,7 @@ sub process_text1($$;$){ } elsif( $func eq 'C' ){ # C<code> - can be a ref or <CODE></CODE> # need to extract text - my $par = go_ahead( $rstr, 'C' ); + my $par = go_ahead( $rstr, 'C', $closing ); ## clean-up of the link target my $text = depod( $par ); @@ -1449,7 +1454,7 @@ sub process_text1($$;$){ ## L<text|cross-ref> => produce text, use cross-ref for linking ## L<cross-ref> => make text from cross-ref ## need to extract text - my $par = go_ahead( $rstr, 'L' ); + my $par = go_ahead( $rstr, 'L', $closing ); # some L<>'s that shouldn't be: # a) full-blown URL's are emitted as-is @@ -1574,17 +1579,17 @@ sub process_text1($$;$){ unless $$rstr =~ s/^>//; } else { - while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)//s ){ + my $term = pattern $closing; + while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){ # all others: either recurse into new function or - # terminate at closing angle bracket + # terminate at closing angle bracket(s) my $pt = $1; - $pt .= '>' if $2 eq '>' && $lev == 1; + $pt .= $2 if !$3 && $lev == 1; $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt ); - return $res if $2 eq '>' && $lev > 1; - if( $2 ne '>' ){ - $res .= process_text1( $lev, $rstr, substr($2,0,1) ); - } - + return $res if !$3 && $lev > 1; + if( $3 ){ + $res .= process_text1( $lev, $rstr, $3, closing $4 ); + } } if( $lev == 1 ){ $res .= pure_text( $$rstr ); @@ -1598,16 +1603,18 @@ sub process_text1($$;$){ # # go_ahead: extract text of an IS (can be nested) # -sub go_ahead($$){ - my( $rstr, $func ) = @_; +sub go_ahead($$$){ + my( $rstr, $func, $closing ) = @_; my $res = ''; - my $level = 1; - while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)//s ){ + my @closing = ($closing); + while( $$rstr =~ + s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){ $res .= $1; - if( $2 eq '>' ){ - return $res if --$level == 0; + unless( $3 ){ + shift @closing; + return $res unless @closing; } else { - ++$level; + unshift @closing, closing $4; } $res .= $2; } @@ -1621,7 +1628,7 @@ sub go_ahead($$){ # sub emit_C($;$$){ my( $text, $nocode, $args ) = @_; - $args ||= ''; + $args = '' unless defined $args; my $res; my( $url, $fid ) = coderef( undef(), $text ); @@ -1907,7 +1914,7 @@ $E2c{sol} = '/'; $E2c{verbar} = '|'; $E2c{amp} = '&'; # in Tk's pods -sub depod1($;$); +sub depod1($;$$); sub depod($){ my $string; @@ -1920,15 +1927,15 @@ sub depod($){ } } -sub depod1($;$){ - my( $rstr, $func ) = @_; +sub depod1($;$$){ + my( $rstr, $func, $closing ) = @_; my $res = ''; return $res unless defined $$rstr; if( ! defined( $func ) ){ # skip to next begin of an interior sequence - while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<// ){ + while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){ # recurse into its text - $res .= $1 . depod1( $rstr, $2 ); + $res .= $1 . depod1( $rstr, $2, closing $3); } $res .= $$rstr; } elsif( $func eq 'E' ){ @@ -1944,10 +1951,11 @@ sub depod1($;$){ } else { # all others: either recurse into new function or # terminate at closing angle bracket - while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)// ){ + my $term = pattern $closing; + while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){ $res .= $1; - last if $2 eq '>'; - $res .= depod1( $rstr, substr($2,0,1) ); + last unless $3; + $res .= depod1( $rstr, $3, closing $4 ); } ## If we're here and $2 ne '>': undelimited interior sequence. ## Ignored, as this is called without proper indication of where we are. diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm index 9029f8ccf3..646c00862a 100644 --- a/lib/Pod/InputObjects.pm +++ b/lib/Pod/InputObjects.pm @@ -523,7 +523,9 @@ sub _set_child2parent_links { ## Make sure any sequences know who their parent is for (@children) { next if (!ref || ref eq 'SCALAR'); - if ($_->isa('Pod::InteriorSequence') or $_->can('nested')) { + if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or + UNIVERSAL::can($_, 'nested')) + { $_->nested($self); } } @@ -537,7 +539,8 @@ sub _unset_child2parent_links { my $ptree = $self->{'-ptree'}; for (@$ptree) { next unless (length and ref and ref ne 'SCALAR'); - $_->_unset_child2parent_links() if $_->isa('Pod::InteriorSequence'); + $_->_unset_child2parent_links() + if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); } } @@ -890,7 +893,8 @@ sub _unset_child2parent_links { local *ptree = $self; for (@ptree) { next unless (length and ref and ref ne 'SCALAR'); - $_->_unset_child2parent_links() if $_->isa('Pod::InteriorSequence'); + $_->_unset_child2parent_links() + if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); } } diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm index f096c626c8..898b5442a1 100644 --- a/lib/Pod/Man.pm +++ b/lib/Pod/Man.pm @@ -1,15 +1,21 @@ # Pod::Man -- Convert POD data to formatted *roff input. -# $Id: Man.pm,v 0.8 1999/10/07 09:39:37 eagle Exp $ +# $Id: Man.pm,v 1.0 2000/03/06 10:16:31 eagle Exp $ # -# Copyright 1999 by Russ Allbery <rra@stanford.edu> +# Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu> # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # -# This module is intended to be a replacement for pod2man, and attempts to -# match its output except for some specific circumstances where other -# decisions seemed to produce better output. It uses Pod::Parser and is -# designed to be very easy to subclass. +# This module is intended to be a replacement for the pod2man script +# distributed with versions of Perl prior to 5.6, and attempts to match its +# output except for some specific circumstances where other decisions seemed +# to produce better output. It uses Pod::Parser and is designed to be easy +# to subclass. +# +# Perl core hackers, please note that this module is also separately +# maintained outside of the Perl core as part of the podlators. Please send +# me any patches at the address above in addition to sending them to the +# standard Perl mailing lists. ############################################################################ # Modules and declarations @@ -28,7 +34,11 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); @ISA = qw(Pod::Parser); -($VERSION = (split (' ', q$Revision: 0.8 $ ))[1]) =~ s/\.(\d)$/.0$1/; +# Don't use the CVS revision as the version, since this module is also in +# Perl core and too many things could munge CVS magic revision strings. +# This number should ideally be the same as the CVS revision in podlators, +# however. +$VERSION = 1.00; ############################################################################ @@ -254,8 +264,15 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; # Static helper functions ############################################################################ -# Protect leading quotes and periods against interpretation as commands. -sub protect { local $_ = shift; s/^([.\'])/\\&$1/mg; $_ } +# Protect leading quotes and periods against interpretation as commands. A +# leading *roff font escape apparently still leaves a period interpretable +# as a command by some *roff implementations, so look for a period even +# after one of those. +sub protect { + local $_ = shift; + s{ ^ ( (?: \\f(?:.|\(..) )* [.\'] ) } {\\&$1}xmg; + $_; +} # Given a command and a single argument that may or may not contain double # quotes, handle double-quote formatting for it. If there are no double @@ -336,16 +353,20 @@ sub initialize { # We used to try first to get the version number from a local binary, # but we shouldn't need that any more. Get the version from the running - # Perl. + # Perl. Work a little magic to handle subversions correctly under both + # the pre-5.6 and the post-5.6 version numbering schemes. if (!defined $$self{release}) { - my ($rev, $ver, $sver) = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); - $sver ||= 0; $sver *= 10 ** (3-length($sver)); - $rev += 0; $ver += 0; $sver += 0; - $$self{release} = "perl v$rev.$ver.$sver"; + my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); + $version[2] ||= 0; + $version[2] *= 10 ** (3 - length $version[2]); + for (@version) { $_ += 0 } + $$self{release} = 'perl v' . join ('.', @version); } # Double quotes in things that will be quoted. - for (qw/center date release/) { $$self{$_} =~ s/\"/\"\"/g } + for (qw/center date release/) { + $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; + } $$self{INDENT} = 0; # Current indentation level. $$self{INDENTS} = []; # Stack of indentations. @@ -378,11 +399,11 @@ sub begin_pod { # which works. Should be fixed to use File::Spec. for ($name) { s%//+%/%g; - if ( s%^.*?/lib/[^/]*perl[^/]*/%%is - or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%is) { - s%^site(_perl)?/%%s; # site and site_perl - s%^(.*-$^O|$^O-.*)/%%os; # arch - s%^\d+\.\d+%%s; # version + if ( s%^.*?/lib/[^/]*perl[^/]*/%%si + or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) { + s%^site(_perl)?/%%s; # site and site_perl + s%^(.*-$^O|$^O-.*)/%%so; # arch + s%^\d+\.\d+%%s; # version } s%/%::%g; } @@ -396,7 +417,7 @@ sub begin_pod { my ($day, $month, $year) = (localtime $time)[3,4,5]; $month++; $year += 1900; - $$self{date} = join ('-', $year, $month, $day); + $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day); } # Now, print out the preamble and the title. @@ -469,7 +490,8 @@ sub textblock { # Perform a little magic to collapse multiple L<> references. We'll # just rewrite the whole thing into actual text at this part, bypassing # the whole internal sequence parsing thing. - s{ + my $text = shift; + $text =~ s{ (L< # A link of the form L</something>. / ( @@ -487,25 +509,26 @@ sub textblock { ) } { local $_ = $1; - s{ L< / ([^>]+ ) } {$1}g; + s{ L< / ( [^>]+ ) > } {$1}xg; my @items = split /(?:,?\s+(?:and\s+)?)/; - my $string = "the "; + my $string = 'the '; my $i; for ($i = 0; $i < @items; $i++) { $string .= $items[$i]; - $string .= ", " if @items > 2 && $i != $#items; - $string .= " and " if ($i == $#items - 1); + $string .= ', ' if @items > 2 && $i != $#items; + $string .= ' ' if @items == 2 && $i == 2; + $string .= 'and ' if ($i == $#items - 1); } - $string .= " entries elsewhere in this document"; + $string .= ' entries elsewhere in this document'; $string; }gex; # Parse the tree and output it. collapse knows about references to # scalars as well as scalars and does the right thing with them. - local $_ = $self->parse (@_); - s/\n\s*$/\n/; + $text = $self->parse ($text, @_); + $text =~ s/\n\s*$/\n/; $self->makespace if $$self{NEEDSPACE}; - $self->output (protect $self->mapfonts ($_)); + $self->output (protect $self->mapfonts ($text)); $self->outindex; $$self{NEEDSPACE} = 1; } @@ -520,7 +543,9 @@ sub sequence { # Zero-width characters. if ($command eq 'Z') { - my $v = '\&'; return bless \ $v, 'Pod::Man::String'; + # Workaround to generate a blessable reference, needed by 5.005. + my $tmp = '\&'; + return bless \ "$tmp", 'Pod::Man::String'; } # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. @@ -557,10 +582,9 @@ sub sequence { # Handle links. if ($command eq 'L') { - # XXX bug in lvalue subroutines prevents this from working - #return bless \ ($self->buildlink ($_)), 'Pod::Man::String'; - my $v = $self->buildlink($_); - return bless \$v, 'Pod::Man::String'; + # A bug in lvalue subs in 5.6 requires the temporary variable. + my $tmp = $self->buildlink ($_); + return bless \ "$tmp", 'Pod::Man::String'; } # Whitespace protection replaces whitespace with "\ ". @@ -692,7 +716,6 @@ sub cmd_end { sub cmd_for { my $self = shift; local $_ = shift; - my $line = shift; return unless s/^(?:man|roff)\b[ \t]*\n?//; $self->output ($_); } @@ -842,7 +865,7 @@ sub guesswork { ( ^ | [\s\(\"\'\`\[\{<>] ) ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* ) (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ ) - } { $1 . '\s-1' . $2 . '\s0' . $3 }egx; + } { $1 . '\s-1' . $2 . '\s0' }egx; # Turn PI into a pretty pi. s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx; @@ -1166,11 +1189,6 @@ separators. Pod::Man is excessively slow. -=head1 NOTES - -The intention is for this module and its driver script to eventually replace -B<pod2man> in Perl core. - =head1 SEE ALSO L<Pod::Parser|Pod::Parser>, perlpod(1), pod2man(1), nroff(1), troff(1), diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm index 9ad5d161ed..88d9aa7a8f 100644 --- a/lib/Pod/Parser.pm +++ b/lib/Pod/Parser.pm @@ -956,8 +956,7 @@ sub parse_paragraph { ## and whatever sequence of characters was used to separate them $pfx = $1; $_ = substr($text, length $pfx); - $sep = /(\s+)(?=\S)/ ? $1 : ''; - ($cmd, $text) = split(" ", $_, 2); + ($cmd, $sep, $text) = split /(\s+)/, $_, 2; ## If this is a "cut" directive then we dont need to do anything ## except return to "cutting" mode. if ($cmd eq 'cut') { diff --git a/lib/Pod/Plainer.pm b/lib/Pod/Plainer.pm new file mode 100644 index 0000000000..373e8d090a --- /dev/null +++ b/lib/Pod/Plainer.pm @@ -0,0 +1,69 @@ +package Pod::Plainer; +use strict; +use Pod::Parser; +our @ISA = qw(Pod::Parser); +our $VERSION = '0.01'; + +our %E = qw( < lt > gt ); + +sub escape_ltgt { + (undef, my $text) = @_; + $text =~ s/([<>])/E<$E{$1}>/g; + $text +} + +sub simple_delimiters { + (undef, my $seq) = @_; + $seq -> left_delimiter( '<' ); + $seq -> right_delimiter( '>' ); + $seq; +} + +sub textblock { + my($parser,$text,$line) = @_; + print {$parser->output_handle()} + $parser->parse_text( + { -expand_text => q(escape_ltgt), + -expand_seq => q(simple_delimiters) }, + $text, $line ) -> raw_text(); +} + +1; + +__END__ + +=head1 NAME + +Pod::Plainer - Perl extension for converting Pod to old style Pod. + +=head1 SYNOPSIS + + use Pod::Plainer; + + my $parser = Pod::Plainer -> new (); + $parser -> parse_from_filehandle(\*STDIN); + +=head1 DESCRIPTION + +Pod::Plainer uses Pod::Parser which takes Pod with the (new) +'CE<lt>E<lt> .. E<gt>E<gt>' constructs +and returns the old(er) style with just 'CE<lt>E<gt>'; +'<' and '>' are replaced by 'EE<lt>ltE<gt>' and 'EE<lt>gtE<gt>'. + +This can be used to pre-process Pod before using tools which do not +recognise the new style Pods. + +=head2 EXPORT + +None by default. + +=head1 AUTHOR + +Robin Barker, rmb1@cise.npl.co.uk + +=head1 SEE ALSO + +See L<Pod::Parser>. + +=cut + diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index 1425ea2438..d93e5a4b71 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -43,6 +43,7 @@ use vars qw(@ISA @EXPORT %ESCAPES $VERSION); # This table is taken near verbatim from Pod::PlainText in Pod::Parser, # which got it near verbatim from the original Pod::Text. It is therefore # credited to Tom Christiansen, and I'm glad I didn't have to write it. :) +# "iexcl" to "divide" added by Tim Jenness %ESCAPES = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than @@ -112,8 +113,42 @@ use vars qw(@ISA @EXPORT %ESCAPES $VERSION); "yacute" => "\xFD", # small y, acute accent "yuml" => "\xFF", # small y, dieresis or umlaut mark - "lchevron" => "\xAB", # left chevron (double less than) - "rchevron" => "\xBB", # right chevron (double greater than) + "lchevron" => "\xAB", # left chevron (double less than) laquo + "rchevron" => "\xBB", # right chevron (double greater than) raquo + + "iexcl" => "\xA1", # inverted exclamation mark + "cent" => "\xA2", # cent sign + "pound" => "\xA3", # (UK) pound sign + "curren" => "\xA4", # currency sign + "yen" => "\xA5", # yen sign + "brvbar" => "\xA6", # broken vertical bar + "sect" => "\xA7", # section sign + "uml" => "\xA8", # diaresis + "copy" => "\xA9", # Copyright symbol + "ordf" => "\xAA", # feminine ordinal indicator + "laquo" => "\xAB", # left pointing double angle quotation mark + "not" => "\xAC", # not sign + "shy" => "\xAD", # soft hyphen + "reg" => "\xAE", # registered trademark + "macr" => "\xAF", # macron, overline + "deg" => "\xB0", # degree sign + "plusmn" => "\xB1", # plus-minus sign + "sup2" => "\xB2", # superscript 2 + "sup3" => "\xB3", # superscript 3 + "acute" => "\xB4", # acute accent + "micro" => "\xB5", # micro sign + "para" => "\xB6", # pilcrow sign = paragraph sign + "middot" => "\xB7", # middle dot = Georgian comma + "cedil" => "\xB8", # cedilla + "sup1" => "\xB9", # superscript 1 + "ordm" => "\xBA", # masculine ordinal indicator + "raquo" => "\xBB", # right pointing double angle quotation mark + "frac14" => "\xBC", # vulgar fraction one quarter + "frac12" => "\xBD", # vulgar fraction one half + "frac34" => "\xBE", # vulgar fraction three quarters + "iquest" => "\xBF", # inverted question mark + "times" => "\xD7", # multiplication sign + "divide" => "\xF7", # division sign ); diff --git a/lib/bytes.pm b/lib/bytes.pm index ae7b5fbf5a..f93d6158d9 100644 --- a/lib/bytes.pm +++ b/lib/bytes.pm @@ -32,7 +32,7 @@ bytes - Perl pragma to force byte semantics rather than character semantics =head1 DESCRIPTION WARNING: The implementation of Unicode support in Perl is incomplete. -Expect sudden and unannounced changes! +See L<perlunicode> for the exact details. The C<use bytes> pragma disables character semantics for the rest of the lexical scope in which it appears. C<no bytes> can be used to reverse diff --git a/lib/lib.pm b/lib/lib.pm index e46c5fefa6..98e2f733cb 100644 --- a/lib/lib.pm +++ b/lib/lib.pm @@ -3,9 +3,10 @@ package lib; use 5.005_64; use Config; -my $archname = $Config{'archname'}; -my $ver = $Config{'version'}; -my @inc_version_list = reverse split / /, $Config{'inc_version_list'}; +my $archname = defined($Config{'archname'}) ? $Config{'archname'} : ''; +my $ver = defined($Config{'version'}) ? $Config{'version'} : ''; +my @inc_version_list = defined($Config{'inc_version_list'}) ? + reverse split / /, $Config{'inc_version_list'} : (); our @ORIG_INC = @INC; # take a handy copy of 'original' value our $VERSION = '0.5564'; diff --git a/lib/open.pm b/lib/open.pm index da8a04453c..a845459da6 100644 --- a/lib/open.pm +++ b/lib/open.pm @@ -1,4 +1,27 @@ package open; +$open::hint_bits = 0x20000; + +sub import { + shift; + die "`use open' needs explicit list of disciplines" unless @_; + $^H |= $open::hint_bits; + while (@_) { + my $type = shift; + if ($type =~ /^(IN|OUT)\z/s) { + my $discp = shift; + unless ($discp =~ /^\s*:(raw|crlf)\s*\z/s) { + die "Unknown discipline '$discp'"; + } + $^H{"open_$type"} = $discp; + } + else { + die "Unknown discipline class '$type'"; + } + } +} + +1; +__END__ =head1 NAME @@ -6,31 +29,48 @@ open - perl pragma to set default disciplines for input and output =head1 SYNOPSIS - use open IN => ":any", OUT => ":utf8"; # unimplemented + use open IN => ":crlf", OUT => ":raw"; =head1 DESCRIPTION -NOTE: This pragma is not yet implemented. - The open pragma is used to declare one or more default disciplines for -I/O operations. Any constructors for file, socket, pipe, or directory -handles found within the lexical scope of this pragma will use the -declared default. +I/O operations. Any open() and readpipe() (aka qx//) operators found +within the lexical scope of this pragma will use the declared defaults. +Neither open() with an explicit set of disciplines, nor sysopen() are +influenced by this pragma. + +Only the two pseudo-disciplines ":raw" and ":crlf" are currently +available. + +The ":raw" discipline corresponds to "binary mode" and the ":crlf" +discipline corresponds to "text mode" on platforms that distinguish +between the two modes when opening files (which is many DOS-like +platforms, including Windows). These two disciplines are currently +no-ops on platforms where binmode() is a no-op, but will be +supported everywhere in future. -Handle constructors that are called with an explicit set of disciplines -are not influenced by the declared defaults. +=head1 UNIMPLEMENTED FUNCTIONALITY -The default disciplines so declared are available by the special -discipline name ":def", and can be used within handle constructors -that allow disciplines to be specified. This makes it possible to -stack new disciplines over the default ones. +Full-fledged support for I/O disciplines is currently unimplemented. +When they are eventually supported, this pragma will serve as one of +the interfaces to declare default disciplines for all I/O. + +In future, any default disciplines declared by this pragma will be +available by the special discipline name ":def", and could be used +within handle constructors that allow disciplines to be specified. +This would make it possible to stack new disciplines over the default +ones. open FH, "<:para :def", $file or die "can't open $file: $!"; +Socket and directory handles will also support disciplines in +future. + +Full support for I/O disciplines will enable all of the supported +disciplines to work on all platforms. + =head1 SEE ALSO -L<perlunicode>, L<perlfunc/"open"> +L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode> =cut - -1; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index de75bd7d86..7c5b0a909c 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2,7 +2,7 @@ package DB; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.05; +$VERSION = 1.06; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -530,7 +530,7 @@ EOP } next CMD; }; $cmd =~ /^t$/ && do { - ($trace & 1) ? ($trace &= ~1) : ($trace |= 1); + $trace ^= 1; print $OUT "Trace = " . (($trace & 1) ? "on" : "off" ) . "\n"; next CMD; }; @@ -700,11 +700,14 @@ EOP } } } + + if (not $had_breakpoints{$file} &= ~1) { + delete $had_breakpoints{$file}; + } } undef %postponed; undef %postponed_file; undef %break_on_load; - undef %had_breakpoints; next CMD; }; $cmd =~ /^L$/ && do { my $file; @@ -779,7 +782,7 @@ EOP $break_on_load{$::INC{$file}} = 1 if $::INC{$file}; $file .= '.pm', redo unless $file =~ /\./; } - $had_breakpoints{$file} = 1; + $had_breakpoints{$file} |= 1; print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n"; next CMD; }; $cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do { @@ -805,7 +808,7 @@ EOP if ($i) { local $filename = $file; local *dbline = $main::{'_<' . $filename}; - $had_breakpoints{$filename} = 1; + $had_breakpoints{$filename} |= 1; $max = $#dbline; ++$i while $dbline[$i] == 0 && $i < $max; $dbline{$i} =~ s/^[^\0]*/$cond/; @@ -814,21 +817,22 @@ EOP } next CMD; }; $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do { - $i = ($1?$1:$line); + $i = $1 || $line; $cond = $2 || '1'; if ($dbline[$i] == 0) { print $OUT "Line $i not breakable.\n"; } else { - $had_breakpoints{$filename} = 1; + $had_breakpoints{$filename} |= 1; $dbline{$i} =~ s/^[^\0]*/$cond/; } next CMD; }; - $cmd =~ /^d\b\s*(\d+)?/ && do { - $i = ($1?$1:$line); + $cmd =~ /^d\b\s*(\d*)/ && do { + $i = $1 || $line; $dbline{$i} =~ s/^[^\0]*//; delete $dbline{$i} if $dbline{$i} eq ''; next CMD; }; $cmd =~ /^A$/ && do { + print $OUT "Deleting all actions...\n"; my $file; for $file (keys %had_breakpoints) { local *dbline = $main::{'_<' . $file}; @@ -841,6 +845,10 @@ EOP delete $dbline{$i} if $dbline{$i} eq ''; } } + + if (not $had_breakpoints{$file} &= ~2) { + delete $had_breakpoints{$file}; + } } next CMD; }; $cmd =~ /^O\s*$/ && do { @@ -872,13 +880,19 @@ EOP $pretype = [], next CMD unless $1; $pretype = [$1]; next CMD; }; - $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do { - $i = $1; $j = $3; - if ($dbline[$i] == 0) { - print $OUT "Line $i may not have an action.\n"; + $cmd =~ /^a\b\s*(\d*)\s*(.*)/ && do { + $i = $1 || $line; $j = $2; + if (length $j) { + if ($dbline[$i] == 0) { + print $OUT "Line $i may not have an action.\n"; + } else { + $had_breakpoints{$filename} |= 2; + $dbline{$i} =~ s/\0[^\0]*//; + $dbline{$i} .= "\0" . action($j); + } } else { $dbline{$i} =~ s/\0[^\0]*//; - $dbline{$i} .= "\0" . action($j); + delete $dbline{$i} if $dbline{$i} eq ''; } next CMD; }; $cmd =~ /^n$/ && do { @@ -906,7 +920,7 @@ EOP if ($i) { $filename = $file; *dbline = $main::{'_<' . $filename}; - $had_breakpoints{$filename}++; + $had_breakpoints{$filename} |= 1; $max = $#dbline; ++$i while $dbline[$i] == 0 && $i < $max; } else { @@ -1086,7 +1100,7 @@ EOP next CMD; }; $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do { pop(@hist) if length($cmd) > 1; - $i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist); + $i = $1 ? ($#hist-($2||1)) : ($2||$#hist); $cmd = $hist[$i]; print $OUT $cmd, "\n"; redo CMD; }; @@ -1301,7 +1315,7 @@ sub postponed_sub { $i += $offset; local *dbline = $main::{'_<' . $file}; local $^W = 0; # != 0 is magical below - $had_breakpoints{$file}++; + $had_breakpoints{$file} |= 1; my $max = $#dbline; ++$i until $dbline[$i] != 0 or $i >= $max; $dbline{$i} = delete $postponed{$subname}; @@ -1329,7 +1343,7 @@ sub postponed { if $break_on_load{$filename}; print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame; return unless $postponed_file{$filename}; - $had_breakpoints{$filename}++; + $had_breakpoints{$filename} |= 1; #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic my $key; for $key (keys %{$postponed_file{$filename}}) { @@ -1821,7 +1835,7 @@ B<l> I<min>B<+>I<incr> List I<incr>+1 lines starting at I<min>. B<l> I<min>B<->I<max> List lines I<min> through I<max>. B<l> I<line> List single I<line>. B<l> I<subname> List first window of lines from subroutine. -B<l> I<$var> List first window of lines from subroutine referenced by I<$var>. +B<l> I<\$var> List first window of lines from subroutine referenced by I<\$var>. B<l> List next window of lines. B<-> List previous window of lines. B<w> [I<line>] List window around I<line>. @@ -1844,7 +1858,7 @@ B<b> [I<line>] [I<condition>] I<condition> breaks if it evaluates to true, defaults to '1'. B<b> I<subname> [I<condition>] Set breakpoint at first line of subroutine. -B<b> I<$var> Set breakpoint at first line of subroutine referenced by I<$var>. +B<b> I<\$var> Set breakpoint at first line of subroutine referenced by I<\$var>. B<b> B<load> I<filename> Set breakpoint on `require'ing the given file. B<b> B<postpone> I<subname> [I<condition>] Set breakpoint at first line of subroutine after @@ -1854,10 +1868,12 @@ B<b> B<compile> I<subname> B<d> [I<line>] Delete the breakpoint for I<line>. B<D> Delete all breakpoints. B<a> [I<line>] I<command> - Set an action to be done before the I<line> is executed. + Set an action to be done before the I<line> is executed; + I<line> defaults to the current execution line. Sequence is: check for breakpoint/watchpoint, print line if necessary, do action, prompt user if necessary, - execute expression. + execute line. +B<a> [I<line>] Delete the action for I<line>. B<A> Delete all actions. B<W> I<expr> Add a global watch-expression. B<W> Delete all watch-expressions. @@ -1877,14 +1893,14 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]... I<signalLevel> I<warnLevel> I<dieLevel>: level of verbosity; I<inhibit_exit> Allows stepping off the end of the script. I<ImmediateStop> Debugger should stop as early as possible. - I<RemotePort>: Remote hostname:port for remote debugging + I<RemotePort>: Remote hostname:port for remote debugging The following options affect what happens with B<V>, B<X>, and B<x> commands: I<arrayDepth>, I<hashDepth>: print only first N elements ('' for all); I<compactDump>, I<veryCompact>: change style of array and hash dump; I<globPrint>: whether to print contents of globs; I<DumpDBFiles>: dump arrays holding debugged files; I<DumpPackages>: dump symbol tables of packages; - I<DumpReused>: dump contents of \"reused\" addresses; + I<DumpReused>: dump contents of \"reused\" addresses; I<quote>, I<HighBit>, I<undefPrint>: change style of string dump; I<bareStringify>: Do not print the overload-stringified value; Option I<PrintRet> affects printing of return value after B<r> command, @@ -1899,7 +1915,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]... B<<> I<expr> Define Perl command to run before each prompt. B<<<> I<expr> Add to the list of Perl commands to run before each prompt. B<>> I<expr> Define Perl command to run after each prompt. -B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt. +B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt. B<{> I<db_command> Define debugger command to run before each prompt. B<{{> I<db_command> Add to the list of debugger commands to run before each prompt. B<$prc> I<number> Redo a previous command (default previous command). diff --git a/lib/utf8.pm b/lib/utf8.pm index c362a1c516..17ec37bbe2 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -31,7 +31,7 @@ utf8 - Perl pragma to enable/disable UTF-8 in source code =head1 DESCRIPTION WARNING: The implementation of Unicode support in Perl is incomplete. -Expect sudden and unannounced changes! +See L<perlunicode> for the exact details. The C<use utf8> pragma tells the Perl parser to allow UTF-8 in the program text in the current lexical scope. The C<no utf8> pragma diff --git a/makedef.pl b/makedef.pl index ed3f1cccf8..2e74878977 100644 --- a/makedef.pl +++ b/makedef.pl @@ -103,14 +103,14 @@ close(CFG); # perl.h logic duplication begins if ($define{USE_ITHREADS}) { - if (!$define{MULTIPLICITY} && !defined{PERL_OBJECT}) { + if (!$define{MULTIPLICITY} && !$define{PERL_OBJECT}) { $define{MULTIPLICITY} = 1; } } $define{PERL_IMPLICIT_CONTEXT} ||= $define{USE_ITHREADS} || - $define{USE_THREADS} || + $define{USE_5005THREADS} || $define{MULTIPLICITY} ; if ($define{PERL_CAPI}) { @@ -413,6 +413,7 @@ unless ($define{'USE_5005THREADS'}) { unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( PL_ptr_table + PL_op_mutex Perl_dirp_dup Perl_cx_dup Perl_si_dup @@ -440,6 +441,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) { Perl_die_nocontext Perl_deb_nocontext Perl_form_nocontext + Perl_load_module_nocontext Perl_mess_nocontext Perl_warn_nocontext Perl_warner_nocontext @@ -150,8 +150,8 @@ warn(format, arg) fprintf(stderr, idem) # Locking/unlocking for MT operation - MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) - MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) + MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) + MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) # Locking/unlocking mutex for MT operation MUTEX_LOCK(l) void @@ -319,11 +319,11 @@ #endif #ifndef MALLOC_LOCK -# define MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) +# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) #endif #ifndef MALLOC_UNLOCK -# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) +# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) #endif # ifndef fatalcroak /* make depend */ diff --git a/miniperlmain.c b/miniperlmain.c index 9bbdaf4c86..d1b3e8ed99 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -43,21 +43,21 @@ main(int argc, char **argv, char **env) my_perl = perl_alloc(); if (!my_perl) exit(1); - perl_construct( my_perl ); + perl_construct(my_perl); PL_perl_destruct_level = 0; } - exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); + exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); if (!exitstatus) { - exitstatus = perl_run( my_perl ); + exitstatus = perl_run(my_perl); } - perl_destruct( my_perl ); - perl_free( my_perl ); + perl_destruct(my_perl); + perl_free(my_perl); PERL_SYS_TERM(); - exit( exitstatus ); + exit(exitstatus); return exitstatus; } @@ -68,5 +68,5 @@ main(int argc, char **argv, char **env) static void xs_init(pTHX) { - dXSUB_SYS; + dXSUB_SYS; } diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h index b5e4fa4455..562462106b 100644 --- a/mpeix/mpeixish.h +++ b/mpeix/mpeixish.h @@ -34,7 +34,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -188,6 +188,10 @@ #define Perl_form_nocontext pPerl->Perl_form_nocontext #undef form_nocontext #define form_nocontext Perl_form_nocontext +#undef Perl_load_module_nocontext +#define Perl_load_module_nocontext pPerl->Perl_load_module_nocontext +#undef load_module_nocontext +#define load_module_nocontext Perl_load_module_nocontext #undef Perl_mess_nocontext #define Perl_mess_nocontext pPerl->Perl_mess_nocontext #undef mess_nocontext @@ -747,6 +751,14 @@ #define Perl_leave_scope pPerl->Perl_leave_scope #undef leave_scope #define leave_scope Perl_leave_scope +#undef Perl_load_module +#define Perl_load_module pPerl->Perl_load_module +#undef load_module +#define load_module Perl_load_module +#undef Perl_vload_module +#define Perl_vload_module pPerl->Perl_vload_module +#undef vload_module +#define vload_module Perl_vload_module #undef Perl_looks_like_number #define Perl_looks_like_number pPerl->Perl_looks_like_number #undef looks_like_number @@ -22,19 +22,6 @@ /* #define PL_OP_SLAB_ALLOC */ -/* XXXXXX testing */ -#ifdef USE_ITHREADS -# define OP_REFCNT_LOCK NOOP -# define OP_REFCNT_UNLOCK NOOP -# define OpREFCNT_set(o,n) ((o)->op_targ = (n)) -# define OpREFCNT_dec(o) (--(o)->op_targ) -#else -# define OP_REFCNT_LOCK NOOP -# define OP_REFCNT_UNLOCK NOOP -# define OpREFCNT_set(o,n) NOOP -# define OpREFCNT_dec(o) 0 -#endif - #ifdef PL_OP_SLAB_ALLOC #define SLAB_SIZE 8192 static char *PL_OpPtr = NULL; @@ -369,8 +356,9 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, if (CxREALEVAL(cx)) saweval = i; break; + case OP_DOFILE: case OP_REQUIRE: - /* require must have its own scope */ + /* require/do must have their own scope */ return 0; } break; @@ -1834,7 +1822,6 @@ S_dup_attrlist(pTHX_ OP *o) STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) { - OP *modname; /* for 'use' */ SV *stashsv; /* fake up C<use attributes $pkg,$rv,@attrs> */ @@ -1844,19 +1831,18 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) stashsv = newSVpv(HvNAME(stash), 0); else stashsv = &PL_sv_no; + #define ATTRSMODULE "attributes" - modname = newSVOP(OP_CONST, 0, - newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1)); - modname->op_private |= OPpCONST_BARE; - /* that flag is required to make 'use' work right */ - utilize(1, start_subparse(FALSE, 0), - Nullop, /* version */ - modname, - prepend_elem(OP_LIST, - newSVOP(OP_CONST, 0, stashsv), - prepend_elem(OP_LIST, - newSVOP(OP_CONST, 0, newRV(target)), - dup_attrlist(attrs)))); + + Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, + newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1), + Nullsv, + prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, stashsv), + prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, + newRV(target)), + dup_attrlist(attrs)))); LEAVE; } @@ -3188,6 +3174,58 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) PL_expect = XSTATE; } +void +Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...) +{ + va_list args; + va_start(args, ver); + vload_module(flags, name, ver, &args); + va_end(args); +} + +#ifdef PERL_IMPLICIT_CONTEXT +void +Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...) +{ + dTHX; + va_list args; + va_start(args, ver); + vload_module(flags, name, ver, &args); + va_end(args); +} +#endif + +void +Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) +{ + OP *modname, *veop, *imop; + + modname = newSVOP(OP_CONST, 0, name); + modname->op_private |= OPpCONST_BARE; + if (ver) { + veop = newSVOP(OP_CONST, 0, ver); + } + else + veop = Nullop; + if (flags & PERL_LOADMOD_NOIMPORT) { + imop = sawparens(newNULLLIST()); + } + else if (flags & PERL_LOADMOD_IMPORT_OPS) { + imop = va_arg(*args, OP*); + } + else { + SV *sv; + imop = Nullop; + sv = va_arg(*args, SV*); + while (sv) { + imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); + sv = va_arg(*args, SV*); + } + } + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), + veop, modname, imop); +} + OP * Perl_dofile(pTHX_ OP *term) { @@ -5523,11 +5561,10 @@ Perl_ck_glob(pTHX_ OP *o) #if !defined(PERL_EXTERNAL_GLOB) /* XXX this can be tightened up and made more failsafe. */ if (!gv) { - OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10)); - modname->op_private |= OPpCONST_BARE; ENTER; - utilize(1, start_subparse(FALSE, 0), Nullop, modname, - newSVOP(OP_CONST, 0, newSVpvn(":globally", 9))); + Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv, + /* null-terminated import list */ + newSVpvn(":globally", 9), Nullsv); gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); LEAVE; } @@ -5799,6 +5836,36 @@ Perl_ck_null(pTHX_ OP *o) } OP * +Perl_ck_open(pTHX_ OP *o) +{ + HV *table = GvHV(PL_hintgv); + if (table) { + SV **svp; + I32 mode; + svp = hv_fetch(table, "open_IN", 7, FALSE); + if (svp && *svp) { + mode = mode_from_discipline(*svp); + if (mode & O_BINARY) + o->op_private |= OPpOPEN_IN_RAW; + else if (mode & O_TEXT) + o->op_private |= OPpOPEN_IN_CRLF; + } + + svp = hv_fetch(table, "open_OUT", 8, FALSE); + if (svp && *svp) { + mode = mode_from_discipline(*svp); + if (mode & O_BINARY) + o->op_private |= OPpOPEN_OUT_RAW; + else if (mode & O_TEXT) + o->op_private |= OPpOPEN_OUT_CRLF; + } + } + if (o->op_type == OP_BACKTICK) + return o; + return ck_fun(o); +} + +OP * Perl_ck_repeat(pTHX_ OP *o) { if (cBINOPo->op_first->op_flags & OPf_PARENS) { @@ -5825,7 +5892,13 @@ Perl_ck_require(pTHX_ OP *o) --SvCUR(kid->op_sv); } } - sv_catpvn(kid->op_sv, ".pm", 3); + if (SvREADONLY(kid->op_sv)) { + SvREADONLY_off(kid->op_sv); + sv_catpvn(kid->op_sv, ".pm", 3); + SvREADONLY_on(kid->op_sv); + } + else + sv_catpvn(kid->op_sv, ".pm", 3); } } return ck_fun(o); @@ -6317,19 +6390,16 @@ Perl_peep(pTHX_ register OP *o) o->op_targ = ix; } #endif - /* FALL THROUGH */ - case OP_UC: - case OP_UCFIRST: - case OP_LC: - case OP_LCFIRST: + o->op_seq = PL_op_seqmax++; + break; + case OP_CONCAT: - case OP_JOIN: - case OP_QUOTEMETA: if (o->op_next && o->op_next->op_type == OP_STRINGIFY) { if (o->op_next->op_private & OPpTARGET_MY) { if (o->op_flags & OPf_STACKED) /* chained concats */ goto ignore_optimization; else { + /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */ o->op_targ = o->op_next->op_targ; o->op_next->op_targ = 0; o->op_private |= OPpTARGET_MY; @@ -197,6 +197,12 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_THREADSV */ #define OPpDONE_SVREF 64 /* Been through newSVREF once */ +/* Private for OP_OPEN and OP_BACKTICK */ +#define OPpOPEN_IN_RAW 16 /* binmode(F,":raw") on input fh */ +#define OPpOPEN_IN_CRLF 32 /* binmode(F,":crlf") on input fh */ +#define OPpOPEN_OUT_RAW 64 /* binmode(F,":raw") on output fh */ +#define OPpOPEN_OUT_CRLF 128 /* binmode(F,":crlf") on output fh */ + struct op { BASEOP }; @@ -401,3 +407,25 @@ struct loop { #define OA_SCALARREF 7 #define OA_OPTIONAL 8 +#ifdef USE_ITHREADS +# define OP_REFCNT_INIT MUTEX_INIT(&PL_op_mutex) +# define OP_REFCNT_LOCK MUTEX_LOCK(&PL_op_mutex) +# define OP_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_op_mutex) +# define OP_REFCNT_TERM MUTEX_DESTROY(&PL_op_mutex) +# define OpREFCNT_set(o,n) ((o)->op_targ = (n)) +# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop) +# define OpREFCNT_dec(o) (--(o)->op_targ) +#else +# define OP_REFCNT_INIT NOOP +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OP_REFCNT_TERM NOOP +# define OpREFCNT_set(o,n) NOOP +# define OpREFCNT_inc(o) (o) +# define OpREFCNT_dec(o) 0 +#endif + +/* flags used by Perl_load_module() */ +#define PERL_LOADMOD_DENY 0x1 +#define PERL_LOADMOD_NOIMPORT 0x2 +#define PERL_LOADMOD_IMPORT_OPS 0x4 @@ -1118,7 +1118,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* srefgen */ MEMBER_TO_FPTR(Perl_ck_fun), /* ref */ MEMBER_TO_FPTR(Perl_ck_fun), /* bless */ - MEMBER_TO_FPTR(Perl_ck_null), /* backtick */ + MEMBER_TO_FPTR(Perl_ck_open), /* backtick */ MEMBER_TO_FPTR(Perl_ck_glob), /* glob */ MEMBER_TO_FPTR(Perl_ck_null), /* readline */ MEMBER_TO_FPTR(Perl_ck_null), /* rcatline */ @@ -1285,7 +1285,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* dump */ MEMBER_TO_FPTR(Perl_ck_null), /* goto */ MEMBER_TO_FPTR(Perl_ck_fun), /* exit */ - MEMBER_TO_FPTR(Perl_ck_fun), /* open */ + MEMBER_TO_FPTR(Perl_ck_open), /* open */ MEMBER_TO_FPTR(Perl_ck_fun), /* close */ MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */ MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */ @@ -377,7 +377,7 @@ bless bless ck_fun s@ S S? # Pushy I/O. -backtick quoted execution (``, qx) ck_null t% +backtick quoted execution (``, qx) ck_open t% # glob defaults its first arg to $_ glob glob ck_glob t@ S? readline <HANDLE> ck_null t% @@ -605,7 +605,7 @@ exit exit ck_fun ds% S? # I/O. -open open ck_fun ist@ F S? L +open open ck_open ist@ F S? L close close ck_fun is% F? pipe_op pipe ck_fun is@ F F @@ -777,7 +777,7 @@ U32 addflag; long enough. */ a--; } - while (nargs-- >= 0) + while (--nargs >= 0) PL_Argv[nargs] = argsp[nargs]; /* Enable pathless exec if #! (as pdksh). */ pass = (buf[0] == '#' ? 2 : 3); diff --git a/os2/os2ish.h b/os2/os2ish.h index 8b7613eb32..76d1b8c4f3 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -19,7 +19,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/patchlevel.h b/patchlevel.h index 0b8d9beeda..7da61f042c 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -68,7 +68,7 @@ applied different patches than you. */ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) -static char * __attribute__ ((unused)) local_patches[] = { +static char *local_patches[] = { NULL , "v5.6.0-RC1" ,NULL @@ -64,8 +64,12 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen); PERL_SET_INTERP(my_perl); \ INIT_THREADS; \ ALLOC_THREAD_KEY; \ + PERL_SET_THX(my_perl); \ + OP_REFCNT_INIT; \ + } \ + else { \ + PERL_SET_THX(my_perl); \ } \ - PERL_SET_THX(my_perl); \ } STMT_END # else # define INIT_TLS_AND_INTERP \ @@ -591,6 +595,10 @@ perl_destruct(pTHXx) if (!specialWARN(PL_compiling.cop_warnings)) SvREFCNT_dec(PL_compiling.cop_warnings); PL_compiling.cop_warnings = Nullsv; +#ifndef USE_ITHREADS + SvREFCNT_dec(CopFILEGV(&PL_compiling)); + CopFILEGV_set(&PL_compiling, Nullgv); +#endif /* Prepare to destruct main symbol table. */ @@ -675,10 +683,15 @@ perl_destruct(pTHXx) SvREFCNT(&PL_sv_yes) = 0; sv_clear(&PL_sv_yes); SvANY(&PL_sv_yes) = NULL; + SvREADONLY_off(&PL_sv_yes); SvREFCNT(&PL_sv_no) = 0; sv_clear(&PL_sv_no); SvANY(&PL_sv_no) = NULL; + SvREADONLY_off(&PL_sv_no); + + SvREFCNT(&PL_sv_undef) = 0; + SvREADONLY_off(&PL_sv_undef); if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count); @@ -971,7 +984,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) char *p; STRLEN len = strlen(s); p = savepvn(s, len); - incpush(p, TRUE); + incpush(p, TRUE, TRUE); sv_catpvn(sv, "-I", 2); sv_catpvn(sv, p, len); sv_catpvn(sv, " ", 1); @@ -1632,7 +1645,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) SAVETMPS; push_return(PL_op->op_next); - PUSHBLOCK(cx, CXt_EVAL, PL_stack_sp); + PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp); PUSHEVAL(cx, 0, 0); PL_eval_root = PL_op; /* Only needed so that goto works right. */ @@ -2062,7 +2075,7 @@ Perl_moreswitches(pTHX_ char *s) p++; } while (*p && *p != '-'); e = savepvn(s, e-s); - incpush(e, TRUE); + incpush(e, TRUE, TRUE); Safefree(e); s = p; if (*s == '-') @@ -3212,9 +3225,9 @@ S_init_perllib(pTHX) #ifndef VMS s = PerlEnv_getenv("PERL5LIB"); if (s) - incpush(s, TRUE); + incpush(s, TRUE, TRUE); else - incpush(PerlEnv_getenv("PERLLIB"), FALSE); + incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE); #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the * "natural" VMS idiom for a Unix path string. We allow each @@ -3223,62 +3236,73 @@ S_init_perllib(pTHX) char buf[256]; int idx = 0; if (my_trnlnm("PERL5LIB",buf,0)) - do { incpush(buf,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx)); + do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx)); else - while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE); + while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE); #endif /* VMS */ } /* Use the ~-expanded versions of APPLLIB (undocumented), - ARCHLIB PRIVLIB SITEARCH and SITELIB + ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB */ #ifdef APPLLIB_EXP - incpush(APPLLIB_EXP, TRUE); + incpush(APPLLIB_EXP, TRUE, TRUE); #endif #ifdef ARCHLIB_EXP - incpush(ARCHLIB_EXP, FALSE); + incpush(ARCHLIB_EXP, FALSE, FALSE); #endif #ifndef PRIVLIB_EXP -#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" +# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" #endif #if defined(WIN32) - incpush(PRIVLIB_EXP, TRUE); + incpush(PRIVLIB_EXP, TRUE, FALSE); #else - incpush(PRIVLIB_EXP, FALSE); + incpush(PRIVLIB_EXP, FALSE, FALSE); +#endif + +#ifdef SITEARCH_EXP + /* sitearch is always relative to sitelib on Windows for + * DLL-based path intuition to work correctly */ +# if !defined(WIN32) + incpush(SITEARCH_EXP, FALSE, FALSE); +# endif #endif -#if defined(WIN32) - incpush(SITELIB_EXP, TRUE); /* XXX Win32 needs inc_version_list support */ -#else #ifdef SITELIB_EXP - { - char *path = SITELIB_EXP; +# if defined(WIN32) + incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */ +# else + incpush(SITELIB_EXP, FALSE, FALSE); +# endif +#endif - if (path) { - char buf[1024]; - char *ver = strrchr(path,'/'); /* XXX Hack, Configure var needed */ - if (ver && ver[1] == (STRINGIFY(PERL_REVISION))[0] - && strlen(path) < sizeof(buf)) - { - strcpy(buf,path); - buf[ver-path] = '\0'; - path = buf; - } - incpush(path, TRUE); - } - } +#ifdef SITELIB_STEM /* Search for version-specific dirs below here */ + incpush(SITELIB_STEM, FALSE, TRUE); #endif + +#ifdef PERL_VENDORARCH_EXP + /* vendorarch is always relative to vendorlib on Windows for + * DLL-based path intuition to work correctly */ +# if !defined(WIN32) + incpush(PERL_VENDORARCH_EXP, FALSE, FALSE); +# endif #endif -#if defined(PERL_VENDORLIB_EXP) -#if defined(WIN32) - incpush(PERL_VENDORLIB_EXP, TRUE); -#else - incpush(PERL_VENDORLIB_EXP, FALSE); + +#ifdef PERL_VENDORLIB_EXP +# if defined(WIN32) + incpush(PERL_VENDORLIB_EXP, TRUE, FALSE); /* this picks up vendorarch as well */ +# else + incpush(PERL_VENDORLIB_EXP, FALSE, FALSE); +# endif #endif + +#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */ + incpush(PERL_VENDORLIB_STEM, FALSE, TRUE); #endif + if (!PL_tainting) - incpush(".", FALSE); + incpush(".", FALSE, FALSE); } #if defined(DOSISH) @@ -3295,14 +3319,14 @@ S_init_perllib(pTHX) #endif STATIC void -S_incpush(pTHX_ char *p, int addsubdirs) +S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) { SV *subdir = Nullsv; - if (!p) + if (!p || !*p) return; - if (addsubdirs) { + if (addsubdirs || addoldvers) { subdir = sv_newmortal(); } @@ -3332,7 +3356,7 @@ S_incpush(pTHX_ char *p, int addsubdirs) * BEFORE pushing libdir onto @INC we may first push version- and * archname-specific sub-directories. */ - if (addsubdirs) { + if (addsubdirs || addoldvers) { #ifdef PERL_INC_VERSION_LIST /* Configure terminates PERL_INC_VERSION_LIST with a NULL */ const char *incverlist[] = { PERL_INC_VERSION_LIST }; @@ -3353,36 +3377,41 @@ S_incpush(pTHX_ char *p, int addsubdirs) "Failed to unixify @INC element \"%s\"\n", SvPV(libdir,len)); #endif - /* .../version/archname if -d .../version/archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir, - (int)PERL_REVISION, (int)PERL_VERSION, - (int)PERL_SUBVERSION, ARCHNAME); - if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && - S_ISDIR(tmpstatbuf.st_mode)) - av_push(GvAVn(PL_incgv), newSVsv(subdir)); - - /* .../version if -d .../version */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir, - (int)PERL_REVISION, (int)PERL_VERSION, - (int)PERL_SUBVERSION); - if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && - S_ISDIR(tmpstatbuf.st_mode)) - av_push(GvAVn(PL_incgv), newSVsv(subdir)); - - /* .../archname if -d .../archname */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME); - if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && - S_ISDIR(tmpstatbuf.st_mode)) - av_push(GvAVn(PL_incgv), newSVsv(subdir)); + if (addsubdirs) { + /* .../version/archname if -d .../version/archname */ + Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", + libdir, + (int)PERL_REVISION, (int)PERL_VERSION, + (int)PERL_SUBVERSION, ARCHNAME); + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + S_ISDIR(tmpstatbuf.st_mode)) + av_push(GvAVn(PL_incgv), newSVsv(subdir)); -#ifdef PERL_INC_VERSION_LIST - for (incver = incverlist; *incver; incver++) { - /* .../xxx if -d .../xxx */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver); + /* .../version if -d .../version */ + Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir, + (int)PERL_REVISION, (int)PERL_VERSION, + (int)PERL_SUBVERSION); + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + S_ISDIR(tmpstatbuf.st_mode)) + av_push(GvAVn(PL_incgv), newSVsv(subdir)); + + /* .../archname if -d .../archname */ + Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVsv(subdir)); } + +#ifdef PERL_INC_VERSION_LIST + if (addoldvers) { + for (incver = incverlist; *incver; incver++) { + /* .../xxx if -d .../xxx */ + Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver); + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + S_ISDIR(tmpstatbuf.st_mode)) + av_push(GvAVn(PL_incgv), newSVsv(subdir)); + } + } #endif } @@ -151,14 +151,6 @@ functions are now member functions of the PERL_OBJECT. */ -#ifndef NEXT30_NO_ATTRIBUTE -# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ -# ifdef __attribute__ /* Avoid possible redefinition errors */ -# undef __attribute__ -# endif -# define __attribute__(attr) -# endif -#endif class CPerlObj; @@ -229,7 +221,7 @@ struct perl_thread; #endif #define NOOP (void)0 -#define dNOOP extern int __attribute__ ((unused)) Perl___notused +#define dNOOP extern int Perl___notused #ifndef pTHX # define pTHX void @@ -1181,7 +1173,7 @@ typedef NVTYPE NV; #endif #if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# if !defined(Perl_atof) && defined(HAS_STRTOLD) +# if !defined(Perl_atof) && defined(HAS_STRTOLD) # define Perl_atof(s) strtold(s, (char**)NULL) # endif # if !defined(Perl_atof) && defined(HAS_ATOLF) @@ -1786,13 +1778,13 @@ typedef pthread_key_t perl_key; #if defined(__CYGWIN__) /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ # define USEMYBINMODE / **/ -# define my_binmode(fp, iotype) \ - (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE) +# define my_binmode(fp, iotype, mode) \ + (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE) #endif #ifdef UNION_ANY_DEFINITION @@ -2672,6 +2664,15 @@ typedef void *Thread; # define PERL_CALLCONV #endif +#ifndef NEXT30_NO_ATTRIBUTE +# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ +# ifdef __attribute__ /* Avoid possible redefinition errors */ +# undef __attribute__ +# endif +# define __attribute__(attr) +# endif +#endif + #ifdef PERL_OBJECT # define PERL_DECL_PROT #endif @@ -3074,36 +3075,46 @@ typedef struct am_table_short AMTS; #endif /* !USE_LOCALE_NUMERIC */ -#if !defined(Atol) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG +#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG # ifdef __hpux # define strtoll __strtoll /* secret handshake */ # endif -# if !defined(Atol) && defined(HAS_STRTOLL) -# define Atol(s) strtoll(s, (char**)NULL, 10) -# endif -# if !defined(Atol) && defined(HAS_ATOLL) -# define Atol atoll +# if !defined(Strtol) && defined(HAS_STRTOLL) +# define Strtol strtoll # endif /* is there atoq() anywhere? */ #endif -#if !defined(Atol) -# define Atol atol /* we assume atol being available anywhere */ +#if !defined(Strtol) && defined(HAS_STRTOL) +# define Strtol strtol +#endif +#ifndef Atol +/* It would be more fashionable to use Strtol() to define atol() + * (as is done for Atoul(), see below) but for backward compatibility + * we just assume atol(). */ +# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL) +# define Atol atoll +# else +# define Atol atol +# endif #endif -#if !defined(Strtoul) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG +#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG # ifdef __hpux # define strtoull __strtoull /* secret handshake */ # endif # if !defined(Strtoul) && defined(HAS_STRTOULL) -# define Strtoul strtoull +# define Strtoul strtoull +# endif +# if !defined(Strtoul) && defined(HAS_STRTOUQ) +# define Strtoul strtouq # endif -#endif /* is there atouq() anywhere? */ -#if !defined(Strtoul) && defined(HAS_STRTOUQ) -# define Strtoul strtouq #endif -#if !defined(Strtoul) -# define Strtoul strtoul /* we assume strtoul being available anywhere */ +#if !defined(Strtoul) && defined(HAS_STRTOUL) +# define Strtoul strtoul +#endif +#ifndef Atoul +# define Atoul(s) Strtoul(s, (char **)NULL, 10) #endif #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) @@ -3203,7 +3214,11 @@ typedef struct am_table_short AMTS; # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) # else # ifdef USE_SEMCTL_SEMID_DS -# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) +# ifdef EXTRA_F_IN_SEMUN_BUF +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff) +# else +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) +# endif # endif # endif #endif @@ -3224,6 +3239,14 @@ typedef struct am_table_short AMTS; # define O_CREAT 0100 #endif +#ifndef O_BINARY +# define O_BINARY 0 +#endif + +#ifndef O_TEXT +# define O_TEXT 0 +#endif + #ifdef IAMSUID #ifdef I_SYS_STATVFS @@ -371,6 +371,17 @@ Perl_form_nocontext(const char* pat, ...) } +#undef Perl_load_module_nocontext +void +Perl_load_module_nocontext(U32 flags, SV* name, SV* ver, ...) +{ + dTHXo; + va_list args; + va_start(args, ver); + ((CPerlObj*)pPerl)->Perl_vload_module(flags, name, ver, &args); + va_end(args); +} + #undef Perl_mess_nocontext SV* Perl_mess_nocontext(const char* pat, ...) @@ -1389,6 +1400,23 @@ Perl_leave_scope(pTHXo_ I32 base) ((CPerlObj*)pPerl)->Perl_leave_scope(base); } +#undef Perl_load_module +void +Perl_load_module(pTHXo_ U32 flags, SV* name, SV* ver, ...) +{ + va_list args; + va_start(args, ver); + ((CPerlObj*)pPerl)->Perl_vload_module(flags, name, ver, &args); + va_end(args); +} + +#undef Perl_vload_module +void +Perl_vload_module(pTHXo_ U32 flags, SV* name, SV* ver, va_list* args) +{ + ((CPerlObj*)pPerl)->Perl_vload_module(flags, name, ver, args); +} + #undef Perl_looks_like_number I32 Perl_looks_like_number(pTHXo_ SV* sv) @@ -878,6 +878,8 @@ START_EXTERN_C #define PL_hexdigit (*Perl_Ghexdigit_ptr(NULL)) #undef PL_malloc_mutex #define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL)) +#undef PL_op_mutex +#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL)) #undef PL_patleave #define PL_patleave (*Perl_Gpatleave_ptr(NULL)) #undef PL_thr_key diff --git a/perlvars.h b/perlvars.h index 4df31bb4a0..bd07adc59f 100644 --- a/perlvars.h +++ b/perlvars.h @@ -34,3 +34,7 @@ PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */ #if defined(MYMALLOC) && (defined(USE_THREADS) || defined(USE_ITHREADS)) PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */ #endif + +#if defined(USE_ITHREADS) +PERLVAR(Gop_mutex, perl_mutex) /* Mutex for op refcounting */ +#endif diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index bac6a92d8f..6fb59663f3 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -54,7 +54,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 4afb855955..fe2418457e 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -286,7 +286,8 @@ Delete all installed breakpoints. =item a [line] command -Set an action to be done before the line is executed. +Set an action to be done before the line is executed. If line is +omitted, sets an action on the line that is about to be executed. The sequence of steps taken by the debugger is 1. check for a breakpoint at this line @@ -300,6 +301,11 @@ For example, this will print out $foo every time line a 53 print "DB FOUND $foo\n" +=item a [line] + +Delete an action at the specified line. If line is omitted, deletes +the action on the line that is about to be executed. + =item A Delete all installed actions. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 052162b49e..bb93b19701 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -4,12 +4,6 @@ perldelta - what's new for perl v5.6.0 =head1 DESCRIPTION -This is an unsupported alpha release, meant for intrepid Perl -developers only. The included sources may not even build correctly on -some platforms. Subscribing to perl5-porters is the best way to -monitor and contribute to the progress of development releases (see -http://www.hut.fi/~jhi/perl5-porters.html for info). - This document describes differences between the 5.005 release and this one. =head1 Incompatible Changes @@ -138,7 +132,7 @@ Perl 5.004 deprecated the interpretation of C<$$1> and similar within interpolated strings to mean C<$$ . "1">, but still allowed it. -In Perl 5.6 and later, C<"$$1"> always means C<"${$1}">. +In Perl 5.6.0 and later, C<"$$1"> always means C<"${$1}">. =item delete(), values() and C<\(%h)> operate on aliases to values, not copies @@ -203,14 +197,14 @@ scalar and a typeglob. See L<perlsub/Prototypes>. =head2 On 64-bit platforms the semantics of bit operators have changed If your platform is either natively 64-bit or your Perl has been -configured to used 64-bit integers (say C<perl -V> and see what is -your ivsize: if it is 8, you are 64-bit) , be warned that the -semantics of all the bitwise numeric operators (& | ^ ~ << >>) have -been changed. They used to be forced to be 32 bits wide, but now in -the aforementioned platforms they are 64 bits wide. Most dramatically -this affects the unary ~: what used to be 32 bits wide, is now 64 bits -wide. If you depend on your integers being 32 bits wide, mask off the -excess bits with C<& 0xffffffff>. +configured to used 64-bit integers, i.e., $Config{ivsize} is 8, +be warned that the semantics of all the bitwise numeric operators +(& | ^ ~ << >>) have been changed. These operators used to strictly +operate on the lower 32 bits of integers, but now operate over the +entire width of native integers. In particular, note that unary C<~> +will produce different results on platforms that have different +$Config{ivsize}. For portability, be sure to mask off the excess bits +in the result of unary C<~>, e.g., C<~$x & 0xffffffff>. =back @@ -221,7 +215,7 @@ excess bits with C<& 0xffffffff>. =item C<PERL_POLLUTE> Release 5.005 grandfathered old global symbol names by providing preprocessor -macros for extension source compatibility. As of release 5.6, these +macros for extension source compatibility. As of release 5.6.0, these preprocessor definitions are not available by default. You need to explicitly compile perl with C<-DPERL_POLLUTE> to get these definitions. For extensions still using the old symbols, this option can be @@ -231,9 +225,9 @@ specified via MakeMaker: =item C<PERL_IMPLICIT_CONTEXT> -PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built -with one of -Dusethreads, -Dusemultiplicity, or both. It is not -intended to be enabled by users at this time. + NOTE: PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built + with one of -Dusethreads, -Dusemultiplicity, or both. It is not + intended to be enabled by users at this time. This new build option provides a set of macros for all API functions such that an implicit interpreter/thread context argument is passed to @@ -252,22 +246,20 @@ Perl, whose interfaces continue to match those of prior versions (but subject to the other options described here). See L<perlguts/"The Perl API"> for detailed information on the -ramifications of building Perl using this option. +ramifications of building Perl with this option. =item C<PERL_POLLUTE_MALLOC> -Enabling Perl's malloc in release 5.005 and earlier caused -the namespace of system versions of the malloc family of functions to -be usurped by the Perl versions, since by default they used the -same names. - -Besides causing problems on platforms that do not allow these functions to -be cleanly replaced, this also meant that the system versions could not -be called in programs that used Perl's malloc. Previous versions of Perl -have allowed this behaviour to be suppressed with the HIDEMYMALLOC and -EMBEDMYMALLOC preprocessor definitions. +Enabling Perl's malloc in release 5.005 and earlier caused the namespace of +the system's malloc family of functions to be usurped by the Perl versions, +since by default they used the same names. Besides causing problems on +platforms that do not allow these functions to be cleanly replaced, this +also meant that the system versions could not be called in programs that +used Perl's malloc. Previous versions of Perl have allowed this behaviour +to be suppressed with the HIDEMYMALLOC and EMBEDMYMALLOC preprocessor +definitions. -As of release 5.6, Perl's malloc family of functions have default names +As of release 5.6.0, Perl's malloc family of functions have default names distinct from the system versions. You need to explicitly compile perl with C<-DPERL_POLLUTE_MALLOC> to get the older behaviour. HIDEMYMALLOC and EMBEDMYMALLOC have no effect, since the behaviour they enabled is now @@ -322,17 +314,17 @@ For the full list of public API functions, see L<perlapi>. =head2 -Dusethreads means something different -WARNING: Support for threads continues to be an experimental feature. -Interfaces and implementation are subject to sudden and drastic changes. + WARNING: Support for threads continues to be an experimental feature. + Interfaces and implementation are subject to sudden and drastic changes. The -Dusethreads flag now enables the experimental interpreter-based thread support by default. To get the flavor of experimental threads that was in 5.005 instead, you need to run Configure with "-Dusethreads -Duse5005threads". -As of v5.5.640, interpreter-threads support is still lacking a way to +As of v5.6.0, interpreter-threads support is still lacking a way to create new threads from Perl (i.e., C<use Thread;> will not work with interpreter threads). C<use Thread;> continues to be available when you -ask for use5005threads, bugs and all. +specify the -Duse5005threads option to Configure, bugs and all. =head2 New Configure flags @@ -360,7 +352,7 @@ capabilities. In other words: if your operating system has the necessary APIs and datatypes, you should be able just to go ahead and use them, for threads by Configure -Dusethreads, and for 64 bits either explicitly by Configure -Duse64bitint or implicitly if your -system has 64 bit wide datatypes. See also L<"64-bit support">. +system has 64-bit wide datatypes. See also L<"64-bit support">. =head2 Long Doubles @@ -370,12 +362,15 @@ Perl's scalars, use -Duselongdouble. =head2 -Dusemorebits -You can enable both -Duse64bitint and -Dlongdouble by -Dusemorebits. +You can enable both -Duse64bitint and -Duselongdouble with -Dusemorebits. See also L<"64-bit support">. =head2 -Duselargefiles -Some platforms support large files, files larger than two gigabytes. +Some platforms support system APIs that are capable of handling large files +(typically, files larger than two gigabytes). Perl will try to use these +APIs if you ask for -Duselargefiles. + See L<"Large file support"> for more information. =head2 installusrbinperl @@ -388,13 +383,15 @@ because many scripts assume to find Perl in /usr/bin/perl. =head2 SOCKS support You can use "Configure -Dusesocks" which causes Perl to probe -for the SOCKS (v5, not v4) proxy protocol library, -http://www.socks.nec.com/ +for the SOCKS proxy protocol library (v5, not v4). For more information +on SOCKS, see: + + http://www.socks.nec.com/ =head2 C<-A> flag You can "post-edit" the Configure variables using the Configure C<-A> -flag. The editing happens immediately after the platform specific +switch. The editing happens immediately after the platform specific hints files have been processed but before the actual configuration process starts. Run C<Configure -h> to find out the full C<-A> syntax. @@ -419,15 +416,18 @@ See INSTALL for complete details. =head2 Unicode and UTF-8 support -Perl can optionally use UTF-8 as its internal representation for character + WARNING: This is an experimental feature. Implementation details are + subject to change. + +Perl now uses UTF-8 as its internal representation for character strings. The C<utf8> and C<bytes> pragmas are used to control this support in the current lexical scope. See L<perlunicode>, L<utf8> and L<bytes> for more information. =head2 Interpreter cloning, threads, and concurrency -WARNING: This is an experimental feature in a pre-alpha state. Use -at your own risk. + WARNING: This is an experimental feature. Implementation details are + subject to change. Perl 5.005_63 introduces the beginnings of support for running multiple interpreters concurrently in different threads. In conjunction with @@ -454,12 +454,12 @@ how to enable it on Windows.) The resulting perl executable will be functionally identical to one that was built with -Dmultiplicity, but the perl_clone() API call will only be available in the former. --Dusethreads enables, the cpp macros USE_ITHREADS by default, which enables -Perl source code changes that provide a clear separation between the op tree -and the data it operates with. The former is considered immutable, and can -therefore be shared between an interpreter and all of its clones, while the -latter is considered local to each interpreter, and is therefore copied for -each clone. +-Dusethreads enables the cpp macro USE_ITHREADS by default, which in turn +enables Perl source code changes that provide a clear separation between +the op tree and the data it operates with. The former is immutable, and +can therefore be shared between an interpreter and all of its clones, +while the latter is considered local to each interpreter, and is therefore +copied for each clone. Note that building Perl with the -Dusemultiplicity Configure option is adequate if you wish to run multiple B<independent> interpreters @@ -475,11 +475,10 @@ for details. =head2 Lvalue subroutines -WARNING: This is an experimental feature. + WARNING: This is an experimental feature. Details are subject to change. -change#4081 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>, -Tuomas Lukka <lukka@iki.fi>)] +Subroutines can now return modifiable lvalues. +See L<perlsub/"Lvalue subroutines">. =head2 "our" declarations @@ -510,7 +509,7 @@ the perl version as a string), such literals can be used as a readable way to check if you're running a particular version of Perl: # this will parse in older versions of Perl also - if ($^V and $^V gt v5.5.640) { + if ($^V and $^V gt v5.6.0) { # new features supported } @@ -536,7 +535,7 @@ See L<perldata/"Scalar value constructors"> for additional information. =head2 Weak references -WARNING: This is an experimental feature. + WARNING: This is an experimental feature. In previous versions of Perl, you couldn't cache objects so as to allow them to be deleted if the last reference from outside @@ -558,13 +557,10 @@ automatically undef-ed. To use this feature, you need the WeakRef package from CPAN, which contains additional documentation. -change#3385, also need perlguts documentation -[TODO - Tuomas Lukka <lukka@iki.fi>] - =head2 File globbing implemented internally -WARNING: This is currently an experimental feature. Interfaces and -implementation are likely to change. + WARNING: This is currently an experimental feature. Interfaces and + implementation are likely to change. Perl now uses the File::Glob implementation of the glob() operator automatically. This avoids using an external csh process and the @@ -641,15 +637,25 @@ filehandles that must be passed around, as in the following example: # $f implicitly closed here } +=head2 open() with more than two arguments + +If open() is passed three arguments instead of two, the second arguments +is used as the mode and the third argument is taken to be the file name. +This is primarily useful for protecting against unintended magic behavior +of the traditional two-argument form. See L<perlfunc/open>. =head2 64-bit support - NOTE: The Configure flags -Duselonglong and -Duse64bits - have been deprecated. Use -Duse64bitint instead. + NOTE: The Configure flags -Duselonglong and -Duse64bits have been + deprecated. Use -Duse64bitint instead. + +Any platform that has 64-bit integers either + + (1) natively as longs or ints + (2) via special compiler flags + (3) using long long or int64_t -Any platform that has 64-bit integers either (a) natively as longs or -ints (b) via special compiler flags (c) using long long are able to -use "quads" (64-integers) as follows: +are able to use "quads" (64-bit integers) as follows: =over 4 @@ -681,7 +687,7 @@ of the integer values may produce surprising results) =item * in bit arithmetics: & | ^ ~ << >> (NOTE: these used to be forced -to be 32 bits wide.) +to be 32 bits wide but now operate on the full native width.) =item * @@ -695,34 +701,46 @@ and compile Perl using the -Duse64bitint Configure flag. There are actually two modes of 64-bitness: the first one is achieved using Configure -Duse64bitint and the second one using Configure -Duse64bitall. The difference is that the first one is minimal and -the second one maximal. The first one does only as much as is -required to get 64-bit integers into Perl (this may mean, for example, -using "long longs") while your memory may still be limited to 2 -gigabytes (because your pointers most likely are 32-bit); the second -one goes all the way by attempting to switch also longs (and pointers) -being 64-bit. This may create an even more binary incompatible Perl -than -Duse64bitint: the resulting executable may not run at all in a -CPU-bit box, or you may have to reboot/reconfigure/rebuild your -operating system to be 64-bit aware. +the second one maximal. + +The C<use64bitint> does only as much as is required to get 64-bit +integers into Perl (this may mean, for example, using "long longs") +while your memory may still be limited to 2 gigabytes (because your +pointers could still be 32-bit). Note that the name C<64bitint> does +not imply that your C compiler will be using 64-bit C<int>s (it might, +but it doesn't have to): the C<use64bitint> means that you will be +able to have 64 bits wide scalar values. + +The C<use64bitall> goes all the way by attempting to switch also +integers (if it can), longs (and pointers) to being 64-bit. This may +create an even more binary incompatible Perl than -Duse64bitint: the +resulting executable may not run at all in a 32-bit box, or you may +have to reboot/reconfigure/rebuild your operating system to be 64-bit +aware. Natively 64-bit systems like Alpha and Cray need neither -Duse64bitint nor -Duse64bitall. Last but not least: note that due to Perl's habit of always using -floating point numbers the quads are still not true integers. +floating point numbers, the quads are still not true integers. When quads overflow their limits (0...18_446_744_073_709_551_615 unsigned, -9_223_372_036_854_775_808...9_223_372_036_854_775_807 signed), they are silently promoted to floating point numbers, after which they will -start losing precision (their lower digits). +start losing precision (in their lower digits). =head2 Large file support If you have filesystems that support "large files" (files larger than 2 gigabytes), you may now also be able to create and access them from -Perl. You have to use Configure -Duselargefiles. Turning on the -large file support turns on also the 64-bit support on many platforms. -Beware that unless your filesystem also supports "sparse files" seeking -to umpteen petabytes may be unadvisable. +Perl. NOTE: the default action is to use the large file support, if +available on the platform. + +If the large file support is on, and you have a Fcntl constant +O_LARGEFILE, the O_LARGEFILE is automatically added to the flags +of sysopen(). + +Beware: unless your filesystem also supports "sparse files" seeking to +umpteen petabytes may be unadvisable. Note that in addition to requiring a proper file system to do large files you may also need to adjust your per-process (or your @@ -756,7 +774,7 @@ and the long double support. =head2 Enhanced support for sort() subroutines -Perl subroutines with a prototype of C<($$)> and XSUBs in general can +Perl subroutines with a prototype of C<($$)>, and XSUBs in general, can now be used as sort subroutines. In either case, the two elements to be compared are passed as normal parameters in @_. See L<perlfunc/sort>. @@ -874,24 +892,11 @@ the C<:> is optional.) F<AutoSplit.pm> and F<SelfLoader.pm> have been updated to keep the attributes with the stubs they provide. See L<attributes>. -=head2 Regular expression improvements - -change#2827,2373,2372,2365,1813,1800,4112,4158,4215,4301 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - -=head2 Overloading improvements - -change#2150 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - -=head2 open() with more than two arguments - -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =head2 Support for interpolating named characters -change#4052 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] +The new C<\N> escape interpolates named characters within strings. +For example, C<"Hi! \N{WHITE SMILING FACE}"> evaluates to a string +with a unicode smiley face at the end. =head2 C<require> and C<do> may be overridden @@ -913,7 +918,7 @@ only during normal running are warranted. See L<perlvar>. =head2 New variable $^V contains Perl version as a string C<$^V> contains the Perl version number as a string composed of -characters whose ordinals match the version numbers, e.g., v5.6.0. +characters whose ordinals match the version numbers, i.e. v5.6.0. This may be used in string comparisons. See C<Support for strings represented as a vector of ordinals> for an @@ -951,7 +956,7 @@ is unchanged (it continues to leave the file empty). =head2 C<eval '...'> improvements Line numbers (as reflected by caller() and most diagnostics) within -C<eval '...'> were often incorrect when here documents were involved. +C<eval '...'> were often incorrect where here documents were involved. This has been corrected. Lexical lookups for variables appearing in C<eval '...'> within @@ -976,15 +981,17 @@ to queue compile-time errors and report them at the end of the compilation as true errors rather than as warnings. This fixes cases where error messages leaked through in the form of warnings when code was compiled at run time using C<eval STRING>, and -also allows such errors to be reliably trapped using __DIE__ hooks. +also allows such errors to be reliably trapped using C<eval "...">. =head2 Automatic flushing of output buffers fork(), exec(), system(), qx//, and pipe open()s now flush buffers -of all files opened for output when the operation -was attempted. This mostly eliminates confusing -buffering mishaps suffered by users unaware of how Perl internally -handles I/O. +of all files opened for output when the operation was attempted. This +mostly eliminates confusing buffering mishaps suffered by users unaware +of how Perl internally handles I/O. + +This is not supported on some platforms like Solaris where a suitably +correct implementation of fflush(NULL) isn't available. =head2 Better diagnostics on meaningless filehandle operations @@ -1027,7 +1034,7 @@ inadvertently set $? or $!. This has been corrected. =head2 C<(\$)> prototype and C<$foo{a}> -An scalar reference prototype now correctly allows a hash or +A scalar reference prototype now correctly allows a hash or array element in that slot. =head2 Pseudo-hashes work better @@ -1085,7 +1092,8 @@ back to the default "C" locale. This has been fixed. Numbers formatted according to the local numeric locale (such as using a decimal comma instead of a decimal dot) caused "isn't numeric" warnings, even while the operations accessing -those numbers produced correct results. The warnings are gone. +those numbers produced correct results. These warnings have been +discontinued. =head2 Memory leaks @@ -1105,11 +1113,6 @@ subroutine was not found in the package. Such cases stopped later method lookups from progressing into base packages. This has been corrected. -=head2 Consistent numeric conversions - -change#3378,3318 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =head2 Taint failures under C<-U> When running in unsafe mode, taint violations could sometimes @@ -1151,7 +1154,7 @@ Embedded null characters in diagnostics now actually show up. They used to truncate the message in prior versions. $foo::a and $foo::b are now exempt from "possible typo" warnings only -if sort() is encountered in package foo. +if sort() is encountered in package C<foo>. Unrecognized alphabetic escapes encountered when parsing quote constructs now generate a warning, since they may take on new @@ -1170,16 +1173,6 @@ Certain operations in the RHS of assignment statements have been optimized to directly set the lexical variable on the LHS, eliminating redundant copying overheads. -=head2 Faster mechanism to invoke XSUBs - -change#4044,4125 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - -=head2 Perl_malloc() improvements - -change#4237 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =head2 Faster subroutine calls Minor changes in how subroutine calls are handled internally @@ -1232,18 +1225,14 @@ Environment variable names are not converted to uppercase any more. =item * -Wrong exit code from backticks now fixed. +Incorrect exit codes from backticks have been fixed. =item * -This port is still using its own builtin globbing. +This port continues to use its own builtin globbing (not File::Glob). =back -=head2 OS/2 - -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =head2 OS390 (OpenEdition MVS) Support for this EBCDIC platform has not been renewed in this release. @@ -1257,41 +1246,43 @@ platform, but the possibility exists. =head2 VMS Numerous revisions and extensions to configuration, build, testing, and -installation process to accomodate core changes and VMS-specific options +installation process to accomodate core changes and VMS-specific options. Expand %ENV-handling code to allow runtime mapping to logical names, -CLI symbols, and CRTL environ array +CLI symbols, and CRTL environ array. -Extension of subprocess invocation code to accept filespecs as command "verbs" +Extension of subprocess invocation code to accept filespecs as command +"verbs". Add to Perl command line processing the ability to use default file types and -to recognize Unix-style C<2E<gt>&1>. +to recognize Unix-style C<2E<gt>&1>. -Expansion of File::Spec::VMS routines, and integration into ExtUtils::MM_VMS +Expansion of File::Spec::VMS routines, and integration into ExtUtils::MM_VMS. -Extension of ExtUtils::MM_VMS to handle complex extensions more flexibly +Extension of ExtUtils::MM_VMS to handle complex extensions more flexibly. Barewords at start of Unix-syntax paths may be treated as text rather than -only as logical names +only as logical names. -Optional secure translation of several logical names used internally by Perl +Optional secure translation of several logical names used internally by Perl. -Miscellaneous bugfixing and porting of new core code to VMS +Miscellaneous bugfixing and porting of new core code to VMS. Thanks are gladly extended to the many people who have contributed VMS patches, testing, and ideas. =head2 Win32 -Site library searches failed to look for ".../site/5.XXX/lib" -if ".../site/5.XXXYY/lib" wasn't found. This has been corrected. +Perl can now emulate fork() internally, using multiple interpreters running +in different concurrent threads. This support must be enabled at build +time. See L<perlfork> for detailed information. -When given a pathname that consists only of a drivename, such -as C<A:>, opendir() and stat() now use the current working -directory for the drive rather than the drive root. +When given a pathname that consists only of a drivename, such as C<A:>, +opendir() and stat() now use the current working directory for the drive +rather than the drive root. -The builtin XSUB functions in the Win32:: namespace are -documented. See L<Win32>. +The builtin XSUB functions in the Win32:: namespace are documented. See +L<Win32>. $^X now contains the full path name of the running executable. @@ -1309,7 +1300,7 @@ test whether a process exists. The C<Shell> module is supported. -Rudimentary support for building under command.com in Windows 95 +Better support for building Perl under command.com in Windows 95 has been added. Scripts are read in binary mode by default to allow ByteLoader (and @@ -1323,11 +1314,9 @@ The glob() operator is implemented via the C<File::Glob> extension, which supports glob syntax of the C shell. This increases the flexibility of the glob() operator, but there may be compatibility issues for programs that relied on the older globbing syntax. If you want to -preserve compatibility with the older syntax, you might want to put -a C<use File::DosGlob;> in your program. For details and compatibility -information, see L<File::Glob>. - -[TODO - GSAR] +preserve compatibility with the older syntax, you might want to run +perl with C<-MFile::DosGlob>. For details and compatibility information, +see L<File::Glob>. =head1 New tests @@ -1397,9 +1386,9 @@ See L<attributes>. =item B -WARNING: The Compiler suite is still highly experimental. The -generated code may not be correct, even it manages to execute -without errors. + WARNING: The Compiler suite remains highly experimental. The + generated code may not be correct, even it manages to execute + without errors. The Perl Compiler suite has been extensively reworked for this release. More of the standard Perl testsuite passes when run @@ -1427,14 +1416,16 @@ See L<constant>. =item charnames -change#4052 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] +This pragma implements the C<\N> string escape. See L<charnames>. =item Data::Dumper A C<Maxdepth> setting can be specified to avoid venturing too deeply into deep data structures. See L<Data::Dumper>. +The XSUB implementation of Dump() is now automatically called if the +C<Useqq> setting is not in use. + Dumping C<qr//> objects works correctly. =item DB @@ -1462,7 +1453,7 @@ Overall, Benchmark results exhibit lower average error and better timing accuracy. You can now run tests for I<n> seconds instead of guessing the right -number of tests to run: e.g. timethese(-5, ...) will run each +number of tests to run: e.g., timethese(-5, ...) will run each code for at least 5 CPU seconds. Zero as the "number of repetitions" means "for at least 3 CPU seconds". The output format has also changed. For example: @@ -1511,23 +1502,17 @@ $PERL_VERSION now stands for C<$^V> (a string value) rather than for C<$]> Env now supports accessing environment variables like PATH as array variables. -=item ExtUtils::MakeMaker - -change#4135, also needs docs in module pod -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =item Fcntl More Fcntl constants added: F_SETLK64, F_SETLKW64, O_LARGEFILE for -large file (more than 4GB) access Note that the O_LARGEFILE is -automatically/transparently added to sysopen() flags if large file -support has been configured), Free/Net/OpenBSD locking behaviour flags -F_FLOCK, F_POSIX, Linux F_SHLCK, and O_ACCMODE: the combined mask of -O_RDONLY, O_WRONLY, and O_RDWR. The seek()/sysseek() constants -SEEK_SET, SEEK_CUR, and SEEK_END are available via the C<:seek> tag. -The chmod()/stat() S_IF* constants and S_IS* functions are available -via the C<:mode> tag. - +large file (more than 4GB) access (NOTE: the O_LARGEFILE is +automatically added to sysopen() flags if large file support has been +configured, as is the default), Free/Net/OpenBSD locking behaviour +flags F_FLOCK, F_POSIX, Linux F_SHLCK, and O_ACCMODE: the combined +mask of O_RDONLY, O_WRONLY, and O_RDWR. The seek()/sysseek() +constants SEEK_SET, SEEK_CUR, and SEEK_END are available via the +C<:seek> tag. The chmod()/stat() S_IF* constants and S_IS* functions +are available via the C<:mode> tag. =item File::Compare @@ -1678,6 +1663,22 @@ and C<~> are now supported on bigints. The accessor methods Re, Im, arg, abs, rho, and theta can now also act as mutators (accessor $z->Re(), mutator $z->Re(3)). +The class method C<display_format> and the corresponding object method +C<display_format>, in addition to accepting just one argument, now can +also accept a parameter hash. Recognized keys of a parameter hash are +C<"style">, which corresponds to the old one parameter case, and two +new parameters: C<"format">, which is a printf()-style format string +(defaults usually to C<"%.15g">, you can revert to the default by +setting the format string to C<undef>) used for both parts of a +complex number, and C<"polar_pretty_print"> (defaults to true), +which controls whether an attempt is made to try to recognize small +multiples and rationals of pi (2pi, pi/2) at the argument (angle) of a +polar complex number. + +The potentially disruptive change is that in list context both methods +now I<return the parameter hash>, instead of only the value of the +C<"style"> parameter. + =item Math::Trig A little bit of radial trigonometry (cylindrical and spherical), @@ -1695,7 +1696,7 @@ Pod::InputObjects defines some input objects needed by Pod::Parser, and for advanced users of Pod::Parser that need more about a command besides its name and text. -As of release 5.6 of Perl, Pod::Parser is now the officially sanctioned +As of release 5.6.0 of Perl, Pod::Parser is now the officially sanctioned "base parser code" recommended for use by all pod2xxx translators. Pod::Text (pod2text) and Pod::Man (pod2man) have already been converted to use Pod::Parser and efforts to convert Pod::HTML (pod2html) are already @@ -1719,7 +1720,7 @@ returns found pod files, along with their canonical names (like C<File::Spec::Unix>). L<Pod::ParseUtils|Pod::ParseUtils> contains B<Pod::List> (useful for storing pod list information), B<Pod::Hyperlink> (for parsing the contents of C<LE<lt>E<gt>> sequences) and B<Pod::Cache> -(for caching information about pod files, e.g. link nodes). +(for caching information about pod files, e.g., link nodes). =item Pod::Select, podselect @@ -1837,8 +1838,6 @@ C<use attrs> is now obsolete, and is only provided for backward-compatibility. It's been replaced by the C<sub : attributes> syntax. See L<perlsub/"Subroutine Attributes"> and L<attributes>. -C<use utf8> to enable UTF-8 and Unicode support. - Lexical warnings pragma, C<use warnings;>, to control optional warnings. See L<perllexwarn>. @@ -1851,10 +1850,6 @@ but access(2) knows better. =head1 Utility Changes -=head2 h2ph - -[TODO - Kurt Starsinic <kstar@chapin.edu>] - =head2 perlcc C<perlcc> now supports the C and Bytecode backends. By default, @@ -1863,11 +1858,6 @@ optimized C backend. Support for non-Unix platforms has been improved. -=head2 h2xs - -change#4232 -[TODO - Ilya Zakharevich <ilya@math.ohio-state.edu>] - =head1 Documentation Changes =over 4 @@ -2115,7 +2105,7 @@ for other types of variables in future. will interfere with proper determination of exit status of child processes, Perl has reset the signal to its default value. This situation typically indicates that the parent program under -which Perl may be running (e.g. cron) is being very careless. +which Perl may be running (e.g., cron) is being very careless. =item Can't modify non-lvalue subroutine call @@ -2177,6 +2167,10 @@ corresponding bit of $^H as well. (F) Compile-time-substitutions (such as overloaded constants and character names) were not correctly set up. +=item CORE::%s is not a keyword + +(F) The CORE:: namespace is reserved for Perl keywords. + =item defined(@array) is deprecated (D) defined() is not usually useful on arrays because it checks for an @@ -2574,7 +2568,7 @@ There may also be information at http://www.perl.com/perl/, the Perl Home Page. If you believe you have an unreported bug, please run the B<perlbug> -program included with your release. Make sure to trim your bug down +program included with your release. Be sure to trim your bug down to a tiny but sufficient test case. Your bug report, along with the output of C<perl -V>, will be sent off to perlbug@perl.com to be analysed by the Perl porting team. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 23c376b0b0..87017145d2 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1269,6 +1269,10 @@ character names) were not correctly set up. (F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>. +=item CORE::%s is not a keyword + +(F) The CORE:: namespace is reserved for Perl keywords. + =item Corrupt malloc ptr 0x%lx at 0x%lx (P) The malloc package that comes with Perl had an internal failure. diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index d6870b71dc..af9178dee1 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -358,10 +358,6 @@ best archives. Just look up "*perl*" as a newsgroup. You'll probably want to trim that down a bit, though. -ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost -complete collection dating back to 12/89 (missing 08/91 through -12/93). They are kept as one large file for each month. - You'll probably want more a sophisticated query and retrieval mechanism than a file listing, preferably one that allows you to retrieve articles using a fast-access indices, keyed on at least author, date, diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 650a00a842..7bae55a802 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -443,21 +443,28 @@ L<perlipc/"Sockets: Client/Server Communication">. =item binmode FILEHANDLE -Arranges for FILEHANDLE to be read or written in "binary" mode on -systems where the run-time libraries distinguish between binary and +Arranges for FILEHANDLE to be read or written in "binary" or "text" mode +on systems where the run-time libraries distinguish between binary and text files. If FILEHANDLE is an expression, the value is taken as the -name of the filehandle. binmode() should be called after open() but -before any I/O is done on the filehandle. The only way to reset -binary mode on a filehandle is to reopen the file. +name of the filehandle. DISCIPLINE can be either of C<":raw"> for +binary mode or C<":crlf"> for "text" mode. If the DISCIPLINE is +omitted, it defaults to C<":raw">. -On many systems binmode() has no effect, and on some systems it is -necessary when you're not working with a text file. For the sake of -portability it is a good idea to always use it when appropriate, and -to never use it when it isn't appropriate. +binmode() should be called after open() but before any I/O is done on +the filehandle. + +On many systems binmode() currently has no effect, but in future, it +will be extended to support user-defined input and output disciplines. +On some systems binmode() is necessary when you're not working with a +text file. For the sake of portability it is a good idea to always use +it when appropriate, and to never use it when it isn't appropriate. In other words: Regardless of platform, use binmode() on binary files, and do not use binmode() on text files. +The C<open> pragma can be used to establish default disciplines. +See L<open>. + The operating system, device drivers, C libraries, and Perl run-time system all work together to let the programmer treat a single character (C<\n>) as the line terminator, irrespective of the external @@ -1944,21 +1951,26 @@ C<File::Glob> extension. See L<File::Glob> for details. =item gmtime EXPR -Converts a time as returned by the time function to a 9-element list +Converts a time as returned by the time function to a 8-element list with the time localized for the standard Greenwich time zone. Typically used as follows: - # 0 1 2 3 4 5 6 7 8 - ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + # 0 1 2 3 4 5 6 7 + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time); -All list elements are numeric, and come straight out of a struct tm. -In particular this means that $mon has the range C<0..11> and $wday -has the range C<0..6> with sunday as day C<0>. Also, $year is the -number of years since 1900, that is, $year is C<123> in year 2023, -I<not> simply the last two digits of the year. If you assume it is, -then you create non-Y2K-compliant programs--and you wouldn't want to do -that, would you? +All list elements are numeric, and come straight out of the C `struct +tm'. $sec, $min, and $hour are the seconds, minutes, and hours of the +specified time. $mday is the day of the month, and $mon is the month +itself, in the range C<0..11> with 0 indicating January and 11 +indicating December. $year is the number of years since 1900. That +is, $year is C<123> in year 2023. $wday is the day of the week, with +0 indicating Sunday and 3 indicating Wednesday. $yday is the day of +the year, in the range C<1..365> (or C<1..366> in leap years.) + +Note that the $year element is I<not> simply the last two digits of +the year. If you assume it is, then you create non-Y2K-compliant +programs--and you wouldn't want to do that, would you? The proper way to get a complete 4-digit year is simply: @@ -1968,9 +1980,9 @@ And to get the last two digits of the year (e.g., '01' in 2001) do: $year = sprintf("%02d", $year % 100); -If EXPR is omitted, does C<gmtime(time())>. +If EXPR is omitted, C<gmtime()> uses the current time (C<gmtime(time)>). -In scalar context, returns the ctime(3) value: +In scalar context, C<gmtime()> returns the ctime(3) value: $now_string = gmtime; # e.g., "Thu Oct 13 04:54:34 1994" @@ -2315,13 +2327,20 @@ follows: ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); -All list elements are numeric, and come straight out of a struct tm. -In particular this means that $mon has the range C<0..11> and $wday -has the range C<0..6> with sunday as day C<0>. Also, $year is the -number of years since 1900, that is, $year is C<123> in year 2023, -and I<not> simply the last two digits of the year. If you assume it is, -then you create non-Y2K-compliant programs--and you wouldn't want to do -that, would you? +All list elements are numeric, and come straight out of the C `struct +tm'. $sec, $min, and $hour are the seconds, minutes, and hours of the +specified time. $mday is the day of the month, and $mon is the month +itself, in the range C<0..11> with 0 indicating January and 11 +indicating December. $year is the number of years since 1900. That +is, $year is C<123> in year 2023. $wday is the day of the week, with +0 indicating Sunday and 3 indicating Wednesday. $yday is the day of +the year, in the range C<1..365> (or C<1..366> in leap years.) $isdst +is true if the specified time occurs during daylight savings time, +false otherwise. + +Note that the $year element is I<not> simply the last two digits of +the year. If you assume it is, then you create non-Y2K-compliant +programs--and you wouldn't want to do that, would you? The proper way to get a complete 4-digit year is simply: @@ -2331,9 +2350,9 @@ And to get the last two digits of the year (e.g., '01' in 2001) do: $year = sprintf("%02d", $year % 100); -If EXPR is omitted, uses the current time (C<localtime(time)>). +If EXPR is omitted, C<localtime()> uses the current time (C<localtime(time)>). -In scalar context, returns the ctime(3) value: +In scalar context, C<localtime()> returns the ctime(3) value: $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 4d9858e5ee..17a13a2fd3 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -336,6 +336,7 @@ the strings?). 5.5.650 2000-Feb-08 5.6 beta1 5.5.660 2000-Feb-22 5.6 beta2 5.5.670 2000-Feb-29 5.6 beta3 + 5.6.0-RC1 2000-Mar-09 5.6 release candidate 1 =head2 SELECTED RELEASE SIZES diff --git a/pod/perlop.pod b/pod/perlop.pod index 9c8fa23f1d..5e4ce937fa 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -172,8 +172,11 @@ search or modify the string $_ by default. This operator makes that kind of operation work on some other string. The right argument is a search pattern, substitution, or transliteration. The left argument is what is supposed to be searched, substituted, or transliterated instead of the default -$_. The return value indicates the success of the operation. If the -right argument is an expression rather than a search pattern, +$_. When used in scalar context, the return value generally indicates the +success of the operation. Behavior in list context depends on the particular +operator. See L</"Regexp Quote-Like Operators"> for details. + +If the right argument is an expression rather than a search pattern, substitution, or transliteration, it is interpreted as a search pattern at run time. This can be less efficient than an explicit search, because the pattern must be compiled every time the expression is evaluated. diff --git a/pod/perlpod.pod b/pod/perlpod.pod index f4725ba790..fd0a1de873 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -294,10 +294,10 @@ use the form LE<lt>show this text|fooE<gt> instead. =item * -The script F<pod/checkpods.PL> in the Perl source distribution -provides skeletal checking for lines that look empty but aren't -B<only>, but is there as a placeholder until someone writes -Pod::Checker. The best way to check your pod is to pass it through +The B<podchecker> command is provided to check pod syntax +for errors and warnings. For example, it checks for completely +blank lines in pod segments and for unknown escape sequences. +It is still advised to pass it through one or more translators and proofread the result, or print out the result and proofread that. Some of the problems found may be bugs in the translators, which you may or may not wish to work around. @@ -306,7 +306,8 @@ the translators, which you may or may not wish to work around. =head1 SEE ALSO -L<pod2man> and L<perlsyn/"PODs: Embedded Documentation"> +L<pod2man>, L<perlsyn/"PODs: Embedded Documentation">, +L<podchecker> =head1 AUTHOR diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index c5ffbaf0e4..c8e31bf66c 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -4,14 +4,48 @@ perlunicode - Unicode support in Perl =head1 DESCRIPTION +=head2 Important Caveat + WARNING: The implementation of Unicode support in Perl is incomplete. -Expect sudden and unannounced changes! + +The following areas need further work. + +=over + +=item Input and Output Disciplines + +There is currently no easy way to mark data read from a file or other +external source as being utf8. This will be one of the major areas of +focus in the near future. + +=item Regular Expressions + +The existing regular expression compiler does not produce polymorphic +opcodes. This means that the determination on whether to match Unicode +characters is made when the pattern is compiled, based on whether the +pattern contains Unicode characters, and not when the matching happens +at run time. This needs to be changed to adaptively match Unicode if +the string to be matched is Unicode. + +=item C<use utf8> still needed to enable a few features + +The C<utf8> pragma implements the tables used for Unicode support. These +tables are automatically loaded on demand, so the C<utf8> pragma need not +normally be used. + +However, as a compatibility measure, this pragma must be explicitly used +to enable recognition of UTF-8 encoded literals and identifiers in the +source text. + +=back + +=head2 Byte and Character semantics Beginning with version 5.6, Perl uses logically wide characters to represent strings internally. This internal representation of strings uses the UTF-8 encoding. -In future, Perl-level operations will expect to work with characters +In future, Perl-level operations can be expected to work with characters rather than bytes, in general. However, as strictly an interim compatibility measure, Perl v5.6 aims to @@ -27,9 +61,7 @@ which allowed byte semantics in Perl operations, but only as long as none of the program's inputs are marked as being as source of Unicode character data. Such data may come from filehandles, from calls to external programs, from information provided by the system (such as %ENV), -or from literals and constants in the source text. Later, in -L</Character encodings for input and output>, we'll see how such -inputs may be marked as being Unicode character data sources. +or from literals and constants in the source text. If the C<-C> command line switch is used, (or the ${^WIDE_SYSTEM_CALLS} global flag is set to C<1>), all system calls will use the @@ -40,8 +72,8 @@ Regardless of the above, the C<bytes> pragma can always be used to force byte semantics in a particular lexical scope. See L<bytes>. The C<utf8> pragma is primarily a compatibility device that enables -recognition of UTF-8 in literals encountered by the parser. It is also -used for enabling some of the more experimental Unicode support features. +recognition of UTF-8 in literals encountered by the parser. It may also +be used for enabling some of the more experimental Unicode support features. Note that this pragma is only required until a future version of Perl in which character semantics will become the default. This pragma may then become a no-op. See L<utf8>. @@ -58,7 +90,7 @@ on Unicode data, the C<bytes> pragma should be used. Under character semantics, many operations that formerly operated on bytes change to operating on characters. For ASCII data this makes no difference, because UTF-8 stores ASCII in single bytes, but for -any character greater than C<chr(127)>, the character is stored in +any character greater than C<chr(127)>, the character may be stored in a sequence of two or more bytes, all of which have the high bit set. But by and large, the user need not worry about this, because Perl hides it from the user. A character in Perl is logically just a number @@ -75,9 +107,7 @@ Character semantics have the following effects: =item * Strings and patterns may contain characters that have an ordinal value -larger than 255. In Perl v5.6, this is only enabled if the lexical -scope has a C<use utf8> declaration (due to compatibility needs) but -future versions may enable this by default. +larger than 255. Presuming you use a Unicode editor to edit your program, such characters will typically occur directly within the literal strings as UTF-8 @@ -98,10 +128,6 @@ characters, including ideographs. (You are currently on your own when it comes to using the canonical forms of characters--Perl doesn't (yet) attempt to canonicalize variable names for you.) -This also needs C<use utf8> currently. [XXX: Why?!? High-bit chars were -syntax errors when they occurred within identifiers in previous versions, -so this should probably be enabled by default.] - =item * Regular expressions match characters instead of bytes. For instance, @@ -109,11 +135,6 @@ Regular expressions match characters instead of bytes. For instance, is provided to force a match a single byte ("C<char>" in C, hence C<\C>).) -Unicode support in regular expressions needs C<use utf8> currently. -[XXX: Because the SWASH routines need to be loaded. And the RE engine -appears to need an overhaul to dynamically match Unicode anyway--the -current RE compiler creates different nodes with and without C<use utf8>.] - =item * Character classes in regular expressions match characters instead of @@ -121,8 +142,6 @@ bytes, and match against the character properties specified in the Unicode properties database. So C<\w> can be used to match an ideograph, for instance. -C<use utf8> is needed to enable this. See above. - =item * Named Unicode properties and block ranges make be used as character @@ -133,8 +152,6 @@ any mark character. Single letter properties may omit the brackets, so that can be written C<\pM> also. Many predefined character classes are available, such as C<\p{IsMirrored}> and C<\p{InTibetan}>. -C<use utf8> is needed to enable this. See above. - =item * The special pattern C<\X> match matches any extended Unicode sequence @@ -143,16 +160,12 @@ character is a base character and subsequent characters are mark characters that apply to the base character. It is equivalent to C<(?:\PM\pM*)>. -C<use utf8> is needed to enable this. See above. - =item * The C<tr///> operator translates characters instead of bytes. It can also -be forced to translate between 8-bit codes and UTF-8 regardless of the -surrounding utf8 state. For instance, if you know your input in Latin-1, -you can say: +be forced to translate between 8-bit codes and UTF-8. For instance, if you +know your input in Latin-1, you can say: - use utf8; while (<>) { tr/\0-\xff//CU; # latin1 char to utf8 ... @@ -164,8 +177,6 @@ Similarly you could translate your output with No, C<s///> doesn't take /U or /C (yet?). -C<use utf8> is needed to enable this. See above. - =item * Case translation operators use the Unicode case translation tables diff --git a/pod/pod2latex.PL b/pod/pod2latex.PL index feed98e923..71115f3f21 100644 --- a/pod/pod2latex.PL +++ b/pod/pod2latex.PL @@ -101,7 +101,6 @@ print OUT <<'!NO!SUBS!'; # Translation of HTML escapes of various European accents might be wrong. -$/ = ""; # record separator is blank lines # TeX special characters. ##$tt_ables = "!@*()-=+|;:'\"`,./?<>"; $backslash_escapables = "#\$%&{}_"; @@ -119,13 +118,16 @@ $indent = 0; # parse the pods, produce LaTeX. -open(POD,"<$ARGV[0]") || die "cant open $ARGV[0]"; +use Pod::Plainer; +open(POD,"-|") or Pod::Plainer -> new() -> parse_from_file($ARGV[0]), exit; + ($pod=$ARGV[0]) =~ s/\.pod$//; open(LATEX,">$pod.tex"); &do_hdr(); $cutting = 1; $begun = ""; +$/ = ""; # record separator is blank lines while (<POD>) { if ($cutting) { next unless /^=/; @@ -314,6 +316,8 @@ while (<POD>) { } }gex; + s/X<([^<>]*)>/\\index{$1}/g; + s/Z<>/\\&/g; # the "don't format me" thing # comes last because not subject to reprocessing @@ -416,7 +420,7 @@ while (<POD>) { } print LATEX "\n\\begin{$listingcmd}\n"; push(@listingcmd,$listingcmd); - } elsif ($lastcmd ne 'item') { + } elsif ( !@listingcmd ) { warn "Illegal '=item' command without preceding 'over':"; warn "=item $bareitem"; } @@ -1398,7 +1398,7 @@ PP(pp_negate) RETURN; } else if (SvUVX(sv) <= IV_MAX) { - SETi(-SvUVX(sv)); + SETi(-SvIVX(sv)); RETURN; } } @@ -26,6 +26,7 @@ Perl_ck_listiob Perl_ck_match Perl_ck_method Perl_ck_null +Perl_ck_open Perl_ck_repeat Perl_ck_require Perl_ck_rfun @@ -1784,6 +1784,7 @@ PP(pp_return) I32 cxix; register PERL_CONTEXT *cx; bool popsub2 = FALSE; + bool clear_errsv = FALSE; I32 gimme; SV **newsp; PMOP *newpm; @@ -1814,7 +1815,11 @@ PP(pp_return) popsub2 = TRUE; break; case CXt_EVAL: + if (!(PL_in_eval & EVAL_KEEPERR)) + clear_errsv = TRUE; POPEVAL(cx); + if (CxTRYBLOCK(cx)) + break; if (AvFILLp(PL_comppad_name) >= 0) free_closures(); lex_end(); @@ -1873,6 +1878,8 @@ PP(pp_return) LEAVE; LEAVESUB(sv); + if (clear_errsv) + sv_setpv(ERRSV,""); return pop_return(); } @@ -2385,10 +2392,12 @@ PP(pp_goto) gotoprobe = PL_main_root; break; } - retop = dofindlabel(gotoprobe, label, - enterops, enterops + GOTO_DEPTH); - if (retop) - break; + if (gotoprobe) { + retop = dofindlabel(gotoprobe, label, + enterops, enterops + GOTO_DEPTH); + if (retop) + break; + } PL_lastgotoprobe = gotoprobe; } if (!retop) @@ -2725,8 +2734,11 @@ S_doeval(pTHX_ int gimme, OP** startop) av_store(comppadlist, 1, (SV*)PL_comppad); CvPADLIST(PL_compcv) = comppadlist; - if (!saveop || saveop->op_type != OP_REQUIRE) + if (!saveop || + (saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE)) + { CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller); + } SAVEFREESV(PL_compcv); @@ -3343,7 +3355,7 @@ PP(pp_entertry) SAVETMPS; push_return(cLOGOP->op_other->op_next); - PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP); PUSHEVAL(cx, 0, 0); PL_eval_root = PL_op; /* Only needed so that goto works right. */ diff --git a/pp_proto.h b/pp_proto.h index 3fa494ed1f..7f2d80b0b1 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -25,6 +25,7 @@ PERL_CKDEF(Perl_ck_listiob) PERL_CKDEF(Perl_ck_match) PERL_CKDEF(Perl_ck_method) PERL_CKDEF(Perl_ck_null) +PERL_CKDEF(Perl_ck_open) PERL_CKDEF(Perl_ck_repeat) PERL_CKDEF(Perl_ck_require) PERL_CKDEF(Perl_ck_rfun) @@ -304,9 +304,14 @@ PP(pp_backtick) STRLEN n_a; char *tmps = POPpx; I32 gimme = GIMME_V; + char *mode = "r"; TAINT_PROPER("``"); - fp = PerlProc_popen(tmps, "r"); + if (PL_op->op_private & OPpOPEN_IN_RAW) + mode = "rb"; + else if (PL_op->op_private & OPpOPEN_IN_CRLF) + mode = "rt"; + fp = PerlProc_popen(tmps, mode); if (fp) { if (gimme == G_VOID) { char tmpbuf[256]; @@ -687,15 +692,20 @@ PP(pp_binmode) IO *io; PerlIO *fp; MAGIC *mg; + SV *discp = Nullsv; if (MAXARG < 1) RETPUSHUNDEF; + if (MAXARG > 1) + discp = POPs; gv = (GV*)POPs; if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); + if (discp) + XPUSHs(discp); PUTBACK; ENTER; call_method("BINMODE", G_SCALAR); @@ -708,13 +718,12 @@ PP(pp_binmode) if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; - if (do_binmode(fp,IoTYPE(io),TRUE)) + if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp))) RETPUSHYES; else RETPUSHUNDEF; } - PP(pp_tie) { djSP; @@ -3078,9 +3087,26 @@ PP(pp_fttext) #else else if (*s & 128) { #ifdef USE_LOCALE - if (!(PL_op->op_private & OPpLOCALE) || !isALPHA_LC(*s)) -#endif - odd++; + if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s)) + continue; +#endif + /* utf8 characters don't count as odd */ + if (*s & 0x40) { + int ulen = UTF8SKIP(s); + if (ulen < len - i) { + int j; + for (j = 1; j < ulen; j++) { + if ((s[j] & 0xc0) != 0x80) + goto not_utf8; + } + --ulen; /* loop does extra increment */ + s += ulen; + i += ulen; + continue; + } + } + not_utf8: + odd++; } else if (*s < 32 && *s != '\n' && *s != '\r' && *s != '\b' && @@ -129,6 +129,11 @@ PERL_CALLCONV char* Perl_form_nocontext(const char* pat, ...) __attribute__((format(printf,1,2))) #endif ; +PERL_CALLCONV void Perl_load_module_nocontext(U32 flags, SV* name, SV* ver, ...) +#ifdef CHECK_FORMAT + __attribute__((format(printf,3,4))) +#endif +; PERL_CALLCONV SV* Perl_mess_nocontext(const char* pat, ...) #ifdef CHECK_FORMAT __attribute__((format(printf,1,2))) @@ -383,6 +388,12 @@ PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line); PERL_CALLCONV OP* Perl_linklist(pTHX_ OP* o); PERL_CALLCONV OP* Perl_list(pTHX_ OP* o); PERL_CALLCONV OP* Perl_listkids(pTHX_ OP* o); +PERL_CALLCONV void Perl_load_module(pTHX_ U32 flags, SV* name, SV* ver, ...) +#ifdef CHECK_FORMAT + __attribute__((format(printf,pTHX_3,pTHX_4))) +#endif +; +PERL_CALLCONV void Perl_vload_module(pTHX_ U32 flags, SV* name, SV* ver, va_list* args); PERL_CALLCONV OP* Perl_localize(pTHX_ OP* arg, I32 lexical); PERL_CALLCONV I32 Perl_looks_like_number(pTHX_ SV* sv); PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg); @@ -457,6 +468,7 @@ PERL_CALLCONV void Perl_mg_magical(pTHX_ SV* sv); PERL_CALLCONV int Perl_mg_set(pTHX_ SV* sv); PERL_CALLCONV I32 Perl_mg_size(pTHX_ SV* sv); PERL_CALLCONV OP* Perl_mod(pTHX_ OP* o, I32 type); +PERL_CALLCONV int Perl_mode_from_discipline(pTHX_ SV* discp); PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s); PERL_CALLCONV OP* Perl_my(pTHX_ OP* o); PERL_CALLCONV NV Perl_my_atof(pTHX_ const char *s); @@ -1002,7 +1014,7 @@ STATIC void* S_Slab_Alloc(pTHX_ int m, size_t sz); #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) STATIC void S_find_beginning(pTHX); STATIC void S_forbid_setid(pTHX_ char *); -STATIC void S_incpush(pTHX_ char *, int); +STATIC void S_incpush(pTHX_ char *, int, int); STATIC void S_init_interp(pTHX); STATIC void S_init_ids(pTHX); STATIC void S_init_lexer(pTHX); @@ -1222,7 +1222,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da if (data) data->flags |= SF_HAS_EVAL; } - else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded */ + else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */ if (flags & SCF_DO_SUBSTR) { scan_commit(data); data->longest = &(data->longest_float); @@ -1230,6 +1230,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da is_inf = is_inf_internal = 1; if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ cl_anything(data->start_class); + flags &= ~SCF_DO_STCLASS; } /* Else: zero-length, ignore. */ scan = regnext(scan); @@ -1359,7 +1360,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) PL_regsize = 0L; PL_regcode = &PL_regdummy; PL_reg_whilem_seen = 0; +#if 0 /* REGC() is (currently) a NOP at the first pass. + * Clever compilers notice this and complain. --jhi */ REGC((U8)REG_MAGIC, (char*)PL_regcode); +#endif if (reg(0, &flags) == NULL) { Safefree(PL_regprecomp); PL_regprecomp = Nullch; @@ -5809,6 +5809,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV vecsv = va_arg(*args, SV*); else if (svix < svmax) vecsv = svargs[svix++]; + else + continue; dotstr = SvPVx(vecsv,dotstrlen); if (DO_UTF8(vecsv)) is_utf = TRUE; @@ -5821,6 +5823,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV vecsv = va_arg(*args, SV*); else if (svix < svmax) vecsv = svargs[svix++]; + else { + vecstr = (U8*)""; + veclen = 0; + continue; + } vecstr = (U8*)SvPVx(vecsv,veclen); utf = DO_UTF8(vecsv); continue; @@ -6375,10 +6382,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV # include "error: USE_THREADS and USE_ITHREADS are incompatible" #endif -#ifndef OpREFCNT_inc -# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop) -#endif - #ifndef GpREFCNT_inc # define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL) #endif diff --git a/t/comp/require.t b/t/comp/require.t index efce899edc..1d92687355 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -7,7 +7,7 @@ BEGIN { # don't make this lexical $i = 1; -print "1..19\n"; +print "1..20\n"; sub do_require { %INC = (); @@ -113,7 +113,18 @@ do_require "1"; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; -END { 1 while unlink 'bleah.pm'; } +# do FILE shouldn't see any outside lexicals +my $x = "ok $i\n"; +write_file("bleah.do", <<EOT); +\$x = "not ok $i\\n"; +EOT +do "bleah.do"; +dofile(); +sub dofile { do "bleah.do"; }; +print $x; +$i++; + +END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; } # ***interaction with pod (don't put any thing after here)*** diff --git a/t/lib/complex.t b/t/lib/complex.t index 6fbdf8dd67..bd30e7e44f 100755 --- a/t/lib/complex.t +++ b/t/lib/complex.t @@ -73,6 +73,7 @@ push(@script, <<'EOT'); my $z = cplx( 1, 1); $z->Re(2); $z->Im(3); + print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n"; print 'not ' unless Re($z) == 2 and Im($z) == 3; EOT push(@script, qq(print "ok $test\\n"}\n)); @@ -82,6 +83,7 @@ push(@script, <<'EOT'); { my $z = cplx( 1, 1); $z->abs(3 * sqrt(2)); + print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n"; print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and (arg($z) - pi / 4 ) < $eps and (Re($z) - 3 ) < $eps and @@ -94,6 +96,7 @@ push(@script, <<'EOT'); { my $z = cplx( 1, 1); $z->arg(-3 / 4 * pi); + print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n"; print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and (abs($z) - sqrt(2) ) < $eps and (Re($z) + 1 ) < $eps and @@ -120,10 +123,11 @@ push(@script, $constants); sub test_dbz { for my $op (@_) { $test++; - push(@script, <<EOT); -eval '$op'; -print 'not ' unless (\$@ =~ /Division by zero/); + eval '$op'; + (\$bad) = (\$@ =~ /(.+)/); + print "# $test op = $op divbyzero? \$bad...\n"; + print 'not ' unless (\$@ =~ /Division by zero/); EOT push(@script, qq(print "ok $test\\n";\n)); } @@ -134,10 +138,11 @@ EOT sub test_loz { for my $op (@_) { $test++; - push(@script, <<EOT); -eval '$op'; -print 'not ' unless (\$@ =~ /Logarithm of zero/); + eval '$op'; + (\$bad) = (\$@ =~ /(.+)/); + print "# $test op = $op logofzero? \$bad...\n"; + print 'not ' unless (\$@ =~ /Logarithm of zero/); EOT push(@script, qq(print "ok $test\\n";\n)); } @@ -178,10 +183,11 @@ test_loz( sub test_broot { for my $op (@_) { $test++; - push(@script, <<EOT); -eval 'root(2, $op)'; -print 'not ' unless (\$@ =~ /root must be/); + eval 'root(2, $op)'; + (\$bad) = (\$@ =~ /(.+)/); + print "# $test op = $op badroot? \$bad...\n"; + print 'not ' unless (\$@ =~ /root must be/); EOT push(@script, qq(print "ok $test\\n";\n)); } @@ -189,6 +195,99 @@ EOT test_broot(qw(-3 -2.1 0 0.99)); +sub test_display_format { + push @script, <<EOS; + my \$j = (root(1,3))[1]; + + \$j->display_format('polar'); +EOS + + $test++; + push @script, <<EOS; + print "# display_format polar?\n"; + print "not " unless \$j->display_format eq 'polar'; + print "ok $test\n"; +EOS + + $test++; + push @script, <<EOS; + print "# j = \$j\n"; + print "not " unless "\$j" eq "[1,2pi/3]"; + print "ok $test\n"; + + my %display_format; + + %display_format = \$j->display_format; +EOS + + $test++; + push @script, <<EOS; + print "# display_format{style} polar?\n"; + print "not " unless \$display_format{style} eq 'polar'; + print "ok $test\n"; +EOS + + $test++; + push @script, <<EOS; + print "# keys %display_format == 2?\n"; + print "not " unless keys %display_format == 2; + print "ok $test\n"; + + \$j->display_format('style' => 'cartesian', 'format' => '%.5f'); +EOS + + $test++; + push @script, <<EOS; + print "# j = \$j\n"; + print "not " unless "\$j" eq "-0.50000+0.86603i"; + print "ok $test\n"; + + %display_format = \$j->display_format; +EOS + + $test++; + push @script, <<EOS; + print "# display_format{format} %.5f?\n"; + print "not " unless \$display_format{format} eq '%.5f'; + print "ok $test\n"; +EOS + + $test++; + push @script, <<EOS; + print "# keys %display_format == 3?\n"; + print "not " unless keys %display_format == 3; + print "ok $test\n"; + + \$j->display_format('format' => undef); +EOS + + $test++; + push @script, <<EOS; + print "# j = \$j\n"; + print "not " unless "\$j" eq "-0.5+0.866025403784439i"; + print "ok $test\n"; + + \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0); +EOS + + $test++; + push @script, <<EOS; + print "# j = \$j\n"; + print "not " unless "\$j" eq "[1,2.0943951023932]"; + print "ok $test\n"; + + \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)'); +EOS + $test++; + push @script, <<EOS; + print "# j = \$j\n"; + print "not " unless "\$j" eq "(-0.5)+(0.86603)i"; + print "ok $test\n"; +EOS +} + +test_display_format(); + print "1..$test\n"; eval join '', @script; die $@ if $@; @@ -294,7 +393,7 @@ sub value { sub check { my ($test, $try, $got, $expected, @z) = @_; -# print "# @_\n"; + print "# @_\n"; if ("$got" eq "$expected" || diff --git a/t/lib/fatal.t b/t/lib/fatal.t index 019265899a..4013fbd371 100755 --- a/t/lib/fatal.t +++ b/t/lib/fatal.t @@ -3,11 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; - print "1..13\n"; + print "1..15\n"; } use strict; -use Fatal qw(open close); +use Fatal qw(open close :void opendir); my $i = 1; eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' }; @@ -26,3 +26,11 @@ for ('$foo', "'$foo'", "*$foo", "\\*$foo") { print "not " if $@; print "ok $i\n"; ++$i; } + +eval { opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' }; +print "not " unless $@ =~ /^Can't open/; +print "ok $i\n"; ++$i; + +eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' }; +print "not " if $@ =~ /^Can't open/; +print "ok $i\n"; ++$i; diff --git a/t/lib/filespec.t b/t/lib/filespec.t index 3d2952cfb5..da52ec5fb5 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -208,7 +208,6 @@ BEGIN { [ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], [ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d2.d3]' ], [ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", 'volume:[d1]d2.dir;1' ], -[ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], [ "VMS->splitdir('')", '' ], [ "VMS->splitdir('[]')", '' ], @@ -305,14 +304,17 @@ eval { require VMS::Filespec ; } ; +my $skip_exception = "Install VMS::Filespec (from vms/ext)" ; + if ( $@ ) { # Not pretty, but it allows testing of things not implemented soley # on VMS. It might be better to change File::Spec::VMS to do this, # making it more usable when running on (say) Unix but working with # VMS paths. eval qq- - sub File::Spec::VMS::unixify { die "Install VMS::Filespec (from vms/ext)" } ; - sub File::Spec::VMS::vmspath { die "Install VMS::Filespec (from vms/ext)" } ; + sub File::Spec::VMS::vmsify { die "$skip_exception" } + sub File::Spec::VMS::unixify { die "$skip_exception" } + sub File::Spec::VMS::vmspath { die "$skip_exception" } - ; $INC{"VMS/Filespec.pm"} = 1 ; } @@ -339,6 +341,13 @@ for ( @tests ) { sub tryfunc { my $function = shift ; my $expected = shift ; + my $platform = shift ; + + if ($platform && $^O ne $platform) { + print "ok $current_test # skipped: $function\n" ; + ++$current_test ; + return; + } $function =~ s#\\#\\\\#g ; @@ -351,8 +360,9 @@ sub tryfunc { } if ( $@ ) { - if ( $@ =~ /only provided on VMS/ ) { - print "ok $current_test # skip $function \n" ; + if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) { + chomp $@ ; + print "ok $current_test # skip $function: $@\n" ; } else { chomp $@ ; diff --git a/t/op/64bit.t b/t/op/64bit.t index da9cedd22e..60f72c3536 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -11,9 +11,6 @@ BEGIN { } # This could use a lot of more tests. -# -# Nota bene: bit operations (&, |, ^, ~, <<, >>) are not 64-bit clean. -# See the beginning of pp.c and the explanation next to IBW/UBW. # so that using > 0xfffffff constants and # 32+ bit integers don't cause noise diff --git a/t/op/eval.t b/t/op/eval.t index ea6caf43bd..183892389f 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -1,6 +1,6 @@ #!./perl -print "1..38\n"; +print "1..40\n"; eval 'print "ok 1\n";'; @@ -182,3 +182,27 @@ print $@; print $c eq '2222222222' ? "ok $x\n" : "# $c\nnot ok $x\n"; $x++; } + +# return from eval {} should clear $@ correctly +{ + my $status = eval { + eval { die }; + print "# eval { return } test\n"; + return; # removing this changes behavior + }; + print "not " if $@; + print "ok $x\n"; + $x++; +} + +# ditto for eval "" +{ + my $status = eval q{ + eval q{ die }; + print "# eval q{ return } test\n"; + return; # removing this changes behavior + }; + print "not " if $@; + print "ok $x\n"; + $x++; +} diff --git a/t/op/misc.t b/t/op/misc.t index a595694e9b..ac1a44fadb 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -508,3 +508,40 @@ else { } EXPECT Use of uninitialized value in numeric eq (==) at - line 4. +######## +$x = sub {}; +foo(); +sub foo { eval { return }; } +print "ok\n"; +EXPECT +ok +######## +my @l = qw(hello.* world); +my $x; + +foreach $x (@l) { + print "before - $x\n"; + $x = "\Q$x\E"; + print "quotemeta - $x\n"; + $x = "\u$x"; + print "ucfirst - $x\n"; + $x = "\l$x"; + print "lcfirst - $x\n"; + $x = "\U$x\E"; + print "uc - $x\n"; + $x = "\L$x\E"; + print "lc - $x\n"; +} +EXPECT +before - hello.* +quotemeta - hello\.\* +ucfirst - Hello\.\* +lcfirst - hello\.\* +uc - HELLO\.\* +lc - hello\.\* +before - world +quotemeta - world +ucfirst - World +lcfirst - world +uc - WORLD +lc - world diff --git a/t/op/pat.t b/t/op/pat.t index 103e6132b5..1434af1f06 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..210\n"; +print "1..211\n"; BEGIN { chdir 't' if -d 't'; @@ -369,6 +369,10 @@ print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne $expect; print "ok $test\n"; $test++; +print "not " unless "abc" =~ /^(??{"a"})b/; +print "ok $test\n"; +$test++; + my $matched; $matched = qr/\((?:(?>[^()]+)|(??{$matched}))*\)/; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 0cbbc439ad..baa9f1f3e2 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -63,10 +63,9 @@ open(FOO, ">&STDOUT") and print <FOO>; print getc(STDERR); print getc(FOO); #################################################################### -# The next test is known to fail on some systems (Linux/BSD+glibc, # -# NeXT among others. glibc should be fixed in the next version, # -# but it appears other platforms have little hope. We skip it for # -# now (on the grounds that it is "just" a warning). # +# The next test is known to fail on some systems (Linux+old glibc, # +# old *BSDs, and NeXT, among others. # +# We skip it for now (on the grounds that it is "just" a warning). # #################################################################### #read(FOO,$_,1); no warnings 'io' ; @@ -8,7 +8,7 @@ STMT_START { \ if (pthread_detach(&(t)->self)) { \ MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak(aTHX_ "panic: DETACH"); \ + Perl_croak_nocontext("panic: DETACH"); \ } \ } STMT_END @@ -70,14 +70,12 @@ if (*m) { \ mutex_init(*m); \ } else { \ - Perl_croak(aTHX_ "panic: MUTEX_INIT"); \ + Perl_croak_nocontext("panic: MUTEX_INIT"); \ } \ } STMT_END #define MUTEX_LOCK(m) mutex_lock(*m) -#define MUTEX_LOCK_NOCONTEXT(m) mutex_lock(*m) #define MUTEX_UNLOCK(m) mutex_unlock(*m) -#define MUTEX_UNLOCK_NOCONTEXT(m) mutex_unlock(*m) #define MUTEX_DESTROY(m) \ STMT_START { \ mutex_free(*m); \ @@ -91,7 +89,7 @@ condition_init(*c); \ } \ else { \ - Perl_croak(aTHX_ "panic: COND_INIT"); \ + Perl_croak_nocontext("panic: COND_INIT"); \ } \ } STMT_END @@ -151,35 +149,23 @@ STMT_START { \ Zero((m), 1, perl_mutex); \ if (pthread_mutex_init((m), pthread_mutexattr_default)) \ - Perl_croak(aTHX_ "panic: MUTEX_INIT"); \ + Perl_croak_nocontext("panic: MUTEX_INIT"); \ } STMT_END # else # define MUTEX_INIT(m) \ STMT_START { \ if (pthread_mutex_init((m), pthread_mutexattr_default)) \ - Perl_croak(aTHX_ "panic: MUTEX_INIT"); \ + Perl_croak_nocontext("panic: MUTEX_INIT"); \ } STMT_END # endif # define MUTEX_LOCK(m) \ STMT_START { \ if (pthread_mutex_lock((m))) \ - Perl_croak(aTHX_ "panic: MUTEX_LOCK"); \ - } STMT_END - -# define MUTEX_UNLOCK(m) \ - STMT_START { \ - if (pthread_mutex_unlock((m))) \ - Perl_croak(aTHX_ "panic: MUTEX_UNLOCK"); \ - } STMT_END - -# define MUTEX_LOCK_NOCONTEXT(m) \ - STMT_START { \ - if (pthread_mutex_lock((m))) \ Perl_croak_nocontext("panic: MUTEX_LOCK"); \ } STMT_END -# define MUTEX_UNLOCK_NOCONTEXT(m) \ +# define MUTEX_UNLOCK(m) \ STMT_START { \ if (pthread_mutex_unlock((m))) \ Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \ @@ -188,7 +174,7 @@ # define MUTEX_DESTROY(m) \ STMT_START { \ if (pthread_mutex_destroy((m))) \ - Perl_croak(aTHX_ "panic: MUTEX_DESTROY"); \ + Perl_croak_nocontext("panic: MUTEX_DESTROY"); \ } STMT_END #endif /* MUTEX_INIT */ @@ -196,31 +182,31 @@ # define COND_INIT(c) \ STMT_START { \ if (pthread_cond_init((c), pthread_condattr_default)) \ - Perl_croak(aTHX_ "panic: COND_INIT"); \ + Perl_croak_nocontext("panic: COND_INIT"); \ } STMT_END # define COND_SIGNAL(c) \ STMT_START { \ if (pthread_cond_signal((c))) \ - Perl_croak(aTHX_ "panic: COND_SIGNAL"); \ + Perl_croak_nocontext("panic: COND_SIGNAL"); \ } STMT_END # define COND_BROADCAST(c) \ STMT_START { \ if (pthread_cond_broadcast((c))) \ - Perl_croak(aTHX_ "panic: COND_BROADCAST"); \ + Perl_croak_nocontext("panic: COND_BROADCAST"); \ } STMT_END # define COND_WAIT(c, m) \ STMT_START { \ if (pthread_cond_wait((c), (m))) \ - Perl_croak(aTHX_ "panic: COND_WAIT"); \ + Perl_croak_nocontext("panic: COND_WAIT"); \ } STMT_END # define COND_DESTROY(c) \ STMT_START { \ if (pthread_cond_destroy((c))) \ - Perl_croak(aTHX_ "panic: COND_DESTROY"); \ + Perl_croak_nocontext("panic: COND_DESTROY"); \ } STMT_END #endif /* COND_INIT */ @@ -230,7 +216,7 @@ STMT_START { \ if (pthread_detach((t)->self)) { \ MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak(aTHX_ "panic: DETACH"); \ + Perl_croak_nocontext("panic: DETACH"); \ } \ } STMT_END #endif /* DETACH */ @@ -239,7 +225,7 @@ # define JOIN(t, avp) \ STMT_START { \ if (pthread_join((t)->self, (void**)(avp))) \ - Perl_croak(aTHX_ "panic: pthread_join"); \ + Perl_croak_nocontext("panic: pthread_join"); \ } STMT_END #endif /* JOIN */ @@ -251,7 +237,7 @@ # define PERL_SET_CONTEXT(t) \ STMT_START { \ if (pthread_setspecific(PL_thr_key, (void *)(t))) \ - Perl_croak(aTHX_ "panic: pthread_setspecific"); \ + Perl_croak_nocontext("panic: pthread_setspecific"); \ } STMT_END #endif /* PERL_SET_CONTEXT */ @@ -334,18 +320,10 @@ typedef struct condpair { # define MUTEX_LOCK(m) #endif -#ifndef MUTEX_LOCK_NOCONTEXT -# define MUTEX_LOCK_NOCONTEXT(m) -#endif - #ifndef MUTEX_UNLOCK # define MUTEX_UNLOCK(m) #endif -#ifndef MUTEX_UNLOCK_NOCONTEXT -# define MUTEX_UNLOCK_NOCONTEXT(m) -#endif - #ifndef MUTEX_INIT # define MUTEX_INIT(m) #endif @@ -3958,7 +3958,8 @@ Perl_yylex(pTHX) s += 2; d = s; s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); - tmp = keyword(PL_tokenbuf, len); + if (!(tmp = keyword(PL_tokenbuf, len))) + Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf); if (tmp < 0) tmp = -tmp; goto reserved_word; @@ -6938,10 +6939,9 @@ Perl_scan_num(pTHX_ char *start) /* make an sv from the string */ sv = NEWSV(92,0); -#if ( defined(USE_64_BIT_INT) && \ - (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || \ - (!defined(USE_64_BIT_INT) && \ - (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL))) + /* unfortunately this monster needs to be on one line or + makedepend will be confused. */ +#if (defined(USE_64_BIT_INT) && (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || (!defined(USE_64_BIT_INT) && (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL))) /* No working strto[u]l[l]. Since atoi() doesn't do range checks, @@ -6979,22 +6979,14 @@ Perl_scan_num(pTHX_ char *start) */ if (!floatit) { - char *tp; IV iv; UV uv; errno = 0; -#ifdef USE_64_BIT_INT - if (*PL_tokenbuf == '-') - iv = strtoll(PL_tokenbuf,&tp,10); - else - uv = strtoull(PL_tokenbuf,&tp,10); -#else if (*PL_tokenbuf == '-') - iv = strtol(PL_tokenbuf,&tp,10); + iv = Atol(PL_tokenbuf); else - uv = strtoul(PL_tokenbuf,&tp,10); -#endif - if (*tp || errno) + uv = Atoul(PL_tokenbuf); + if (errno) floatit = TRUE; /* probably just too large */ else if (*PL_tokenbuf == '-') sv_setiv(sv, iv); @@ -7004,12 +6996,8 @@ Perl_scan_num(pTHX_ char *start) if (floatit) { char *tp; errno = 0; -#ifdef USE_LONG_DOUBLE - value = strtold(PL_tokenbuf,&tp); -#else - value = strtod(PL_tokenbuf,&tp); -#endif - if (*tp || errno) + value = Atof(PL_tokenbuf); + if (errno) Perl_die(aTHX_ "unparseable float"); else sv_setnv(sv, value); diff --git a/universal.c b/universal.c index f6b25a4d33..28e08969b4 100644 --- a/universal.c +++ b/universal.c @@ -139,6 +139,9 @@ XS(XS_UNIVERSAL_isa) sv = ST(0); + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) XSRETURN_UNDEF; @@ -162,6 +165,9 @@ XS(XS_UNIVERSAL_can) sv = ST(0); + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) XSRETURN_UNDEF; @@ -135,7 +135,7 @@ #endif #ifndef PERL_SYS_TERM -#define PERL_SYS_TERM() MALLOC_TERM +#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM #endif #define BIT_BUCKET "/dev/null" @@ -670,6 +670,13 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none) SV* retval; char tmpbuf[256]; dSP; + + if (!gv_stashpv(pkg, 0)) { /* demand load utf8 */ + ENTER; + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpv(pkg,0), Nullsv); + LEAVE; + } + SPAGAIN; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP,5); diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 7147607f60..6430589ec1 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -30,22 +30,35 @@ $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' if 0; +use warnings; use strict; + +# make sure creat()s are neither too much nor too little +INIT { eval { umask(0077) } } # doubtless someone has no mask + my \@pagers = (); push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}"; + !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; +use Fcntl; # for sysopen +use Getopt::Std; +use Config '%Config'; + # # Perldoc revision #1 -- look up a piece of documentation in .pod format that # is embedded in the perl installation tree. # -# This is not to be confused with Tom Christianson's perlman, which is a +# This is not to be confused with Tom Christiansen's perlman, which is a # man replacement, written in perl. This perldoc is strictly for reading # the perl manuals, though it too is written in perl. +# +# Massive security and correctness patches applied to this +# noisome program by Tom Christiansen Sat Mar 11 15:22:33 MST 2000 if (@ARGV<1) { my $me = $0; # Editing $0 is unportable @@ -60,9 +73,6 @@ acquainted with the system. EOF } -use Getopt::Std; -use Config '%Config'; - my @global_found = (); my $global_target = ""; @@ -70,6 +80,14 @@ my $Is_VMS = $^O eq 'VMS'; my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_Dos = $^O eq 'dos'; +# refuse to run if we should be tainting and aren't +# (but regular users deserve protection too, though!) +if (!($Is_VMS || $Is_MSWin32 || $Is_Dos) && ($> == 0 || $< == 0) + && !am_taint_checking()) +{ + die "Superuser must not run $0 without security audit and taint checks.\n"; +} + sub usage{ warn "@_\n" if @_; # Erase evidence of previous errors (if any), so exit status is simple. @@ -141,14 +159,14 @@ if ($opt_X) { $podidx = "" unless -f $podidx && -r _ && -M _ <= 7; } -if ((my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) { +if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) { usage("only one of -t, -u, -m or -l") } elsif ($Is_MSWin32 || $Is_Dos - || !(exists $ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i)) + || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i)) { - $opt_t = 1 unless $opts + $opt_t = 1 unless $opts; } if ($opt_t) { require Pod::Text; import Pod::Text; } @@ -166,30 +184,34 @@ else { # Does this look like a module or extension directory? if (-f "Makefile.PL") { - # Add ., lib and blib/* libs to @INC (if they exist) - unshift(@INC, '.'); - unshift(@INC, 'lib') if -d 'lib'; - require ExtUtils::testlib; + + # Add ., lib to @INC (if they exist) + eval q{ use lib qw(. lib); 1; } or die; + + # don't add if superuser + if ($< && $>) { # don't be looking too hard now! + eval q{ use blib; 1 } or die; + } } sub containspod { my($file, $readit) = @_; - return 1 if !$readit && $file =~ /\.pod$/i; + return 1 if !$readit && $file =~ /\.pod\z/i; local($_); - open(TEST,"<$file"); + open(TEST,"<", $file) or die "Can't open $file: $!"; while (<TEST>) { if (/^=head/) { - close(TEST); + close(TEST) or die "Can't close $file: $!"; return 1; } } - close(TEST); + close(TEST) or die "Can't close $file: $!"; return 0; } sub minus_f_nocase { my($dir,$file) = @_; - my $path = join('/',$dir,$file); + my $path = join('/',$dir,$file); # XXX: dirseps return $path if -f $path and -r _; if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') { # on a case-forgiving file system or if case is important @@ -198,16 +220,18 @@ sub minus_f_nocase { return ''; } local *DIR; + # this is completely wicked. don't mess with $", and if + # you do, don't assume / is the dirsep! local($")="/"; my @p = ($dir); my($p,$cip); - foreach $p (split(/\//, $file)){ + foreach $p (split(m!/!, $file)){ # XXX: dirseps my $try = "@p/$p"; stat $try; if (-d _) { push @p, $p; if ( $p eq $global_target) { - my $tmp_path = join ('/', @p); + my $tmp_path = join ('/', @p); # XXX: dirseps my $path_f = 0; for (@global_found) { $path_f = 1 if $_ eq $tmp_path; @@ -222,17 +246,17 @@ sub minus_f_nocase { elsif (-f _) { warn "Ignored $try: unreadable\n"; } - else { + elsif (-d "@p") { my $found=0; my $lcp = lc $p; - opendir DIR, "@p"; + opendir DIR, "@p" or die "opendir @p: $!"; while ($cip=readdir(DIR)) { if (lc $cip eq $lcp){ $found++; last; } } - closedir DIR; + closedir DIR or die "closedir @p: $!"; return "" unless $found; push @p, $cip; return "@p" if -f "@p" and -r _; @@ -266,10 +290,10 @@ sub searchfor { my $ret; my $i; my $dir; - $global_target = (split('/', $s))[-1]; + $global_target = (split(m!/!, $s))[-1]; # XXX: dirseps for ($i=0; $i<@dirs; $i++) { $dir = $dirs[$i]; - ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS; + ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS; if ( ( $ret = check_file $dir,"$s.pod") or ( $ret = check_file $dir,"$s.pm") or ( $ret = check_file $dir,$s) @@ -288,15 +312,16 @@ sub searchfor { } if ($recurse) { - opendir(D,$dir); - my @newdirs = map "$dir/$_", grep { - not /^\.\.?$/ and - not /^auto$/ and # save time! don't search auto dirs - -d "$dir/$_" + opendir(D,$dir) or die "Can't opendir $dir: $!"; + my @newdirs = map "$dir/$_", grep { # XXX: dirseps + not /^\.\.?\z/s and + not /^auto\z/s and # save time! don't search auto dirs + -d "$dir/$_" # XXX: dirseps } readdir D; - closedir(D); + closedir(D) or die "Can't closedir $dir: $!"; next unless @newdirs; - @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS; + # what a wicked map! + @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS; print STDERR "Also looking in @newdirs\n" if $opt_v; push(@dirs,@newdirs); } @@ -318,45 +343,58 @@ sub printout { my $err; if ($opt_t) { - open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return; + # why was this append? + sysopen(OUT, $tmp, O_WRONLY | O_EXCL | O_CREAT, 0600) + or die ("Can't open $tmp: $!"); Pod::Text->new()->parse_from_file($file,\*OUT); - close OUT; + close OUT or die "can't close $tmp: $!"; } elsif (not $opt_u) { - my $cmd = "pod2man --lax $_ | $opt_n -man"; + my $cmd = "pod2man --lax $file | $opt_n -man"; $cmd .= " | col -x" if $^O =~ /hpux/; my $rslt = `$cmd`; $rslt = filter_nroff($rslt) if $filter; unless (($err = $?)) { - open(TMP,">>$tmp") or warn("Can't open $tmp: $!"), return; - print TMP $rslt; - close TMP; + # why was this append? + sysopen(TMP, $tmp, O_WRONLY | O_EXCL | O_CREAT, 0600) + or die "Can't open $tmp: $!"; + print TMP $rslt + or die "Can't print $tmp: $!"; + close TMP + or die "Can't close $tmp: $!"; } } - if ($opt_u or $err or -z $tmp) { - open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return; - open(IN,"<$file") or warn("Can't open $file: $!"), return; + if ($opt_u or $err or -z $tmp) { # XXX: race with -z + # why was this append? + sysopen(OUT, $tmp, O_WRONLY | O_EXCL | O_CREAT, 0600) + or die "Can't open $tmp: $!"; + open(IN,"<", $file) or die("Can't open $file: $!"); my $cut = 1; + local $_; while (<IN>) { $cut = $1 eq 'cut' if /^=(\w+)/; next if $cut; - print OUT; + print OUT + or die "Can't print $tmp: $!"; } - close IN; - close OUT; + close IN or die "Can't close $file: $!"; + close OUT or die "Can't close $tmp: $!"; } } sub page { my ($tmp, $no_tty, @pagers) = @_; if ($no_tty) { - open(TMP,"<$tmp") or warn("Can't open $tmp: $!"), return; - print while <TMP>; - close TMP; + open(TMP,"<", $tmp) or die "Can't open $tmp: $!"; + local $_; + while (<TMP>) { + print or die "Can't print to stdout: $!"; + } + close TMP or die "Can't close while $tmp: $!"; } else { foreach my $pager (@pagers) { - system("$pager $tmp") or last; + last if system("$pager $tmp") == 0; } } } @@ -364,34 +402,26 @@ sub page { sub cleanup { my @files = @_; for (@files) { - 1 while unlink($_); #Possibly pointless VMSism + if ($Is_VMS) { + 1 while unlink($_); # XXX: expect failure + } else { + unlink($_); # or die "Can't unlink $_: $!"; + } } } -sub safe_exit { - my ($val, @files) = @_; - cleanup(@files); - exit $val; -} - -sub safe_die { - my ($msg, @files) = @_; - cleanup(@files); - die $msg; -} - my @found; foreach (@pages) { if ($podidx && open(PODIDX, $podidx)) { my $searchfor = $_; - local($_); - $searchfor =~ s,::,/,g; + $searchfor =~ s,::,/,g; # XXX: dirseps print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v; + local $_; while (<PODIDX>) { chomp; - push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i; + push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i; } - close(PODIDX); + close(PODIDX) or die "Can't close $podidx: $!"; next; } print STDERR "Searching for $_\n" if $opt_v; @@ -422,7 +452,7 @@ foreach (@pages) { } else { # no match, try recursive search - @searchdirs = grep(!/^\.$/,@INC); + @searchdirs = grep(!/^\.\z/s,@INC); @files= searchfor(1,$_,@searchdirs) if $opt_r; if (@files) { print STDERR "Loosely found as @files\n" if $opt_v; @@ -432,13 +462,13 @@ foreach (@pages) { if (@global_found) { print STDERR "However, try\n"; for my $dir (@global_found) { - opendir(DIR, $dir) or die "$!"; + opendir(DIR, $dir) or die "opendir $dir: $!"; while (my $file = readdir(DIR)) { - next if ($file =~ /^\./); - $file =~ s/\.(pm|pod)$//; + next if ($file =~ /^\./s); + $file =~ s/\.(pm|pod)\z//; # XXX: badfs print STDERR "\tperldoc $_\::$file\n"; } - closedir DIR; + closedir DIR or die "closedir $dir: $!"; } } } @@ -459,10 +489,12 @@ my $lines = $ENV{LINES} || 24; my $no_tty; if (! -t STDOUT) { $no_tty = 1 } +END { close(STDOUT) || die "Can't close STDOUT: $!" } # until here we could simply exit or die # now we create temporary files that we have to clean up # namely $tmp, $buffer +# that's because you did it wrong, should be descriptor based --tchrist my $tmp; my $buffer; @@ -494,38 +526,51 @@ else { unshift @pagers, 'less', 'cmd /c more <'; } else { - $tmp = "/tmp/perldoc1.$$"; - $buffer = "/tmp/perldoc1.b$$"; + # XXX: this is not secure, because it doesn't open it + ($tmp, $buffer) = eval { require POSIX } + ? (POSIX::tmpnam(), POSIX::tmpnam() ) + : ("/tmp/perldoc1.$$", "/tmp/perldoc1.b$$" ); } push @pagers, qw( more less pg view cat ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER}; -# all exit calls from here on have to be safe_exit calls (see above) -# and all die calls safe_die calls to guarantee removal of files and -# dir as needed +# make sure cleanup called +eval q{ + sub END { cleanup($tmp, $buffer) } + 1; +} || die; +eval q{ use sigtrap qw(die INT TERM HUP QUIT) }; if ($opt_m) { foreach my $pager (@pagers) { - system("$pager @found") or safe_exit(0, $tmp, $buffer); + if (system($pager, @found) == 0) { + exit; + } } - if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' } - # I don't get the line above. Please patch yourself as needed. - safe_exit(1, $tmp, $buffer); + if ($Is_VMS) { + eval q{ + use vmsish qw(status exit); + exit $?; + 1; + } or die; + } + exit(1); } my @pod; if ($opt_f) { my $perlfunc = shift @found; - open(PFUNC, $perlfunc) - or safe_die("Can't open $perlfunc: $!", $tmp, $buffer); + open(PFUNC, "<", $perlfunc) + or die("Can't open $perlfunc: $!"); # Functions like -r, -e, etc. are listed under `-X'. my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) ? 'I<-X' : $opt_f ; # Skip introduction + local $_; while (<PFUNC>) { last if /^=head2 Alphabetical Listing of Perl Functions/; } @@ -553,20 +598,22 @@ if ($opt_f) { if (!@pod) { die "No documentation for perl function `$opt_f' found\n"; } + close PFUNC or die "Can't open $perlfunc: $!"; } if ($opt_q) { local @ARGV = @found; # I'm lazy, sue me. my $found = 0; my %found_in; - my $rx = eval { qr/$opt_q/ }; - die <<EOD unless $rx; + my $rx = eval { qr/$opt_q/ } or die <<EOD; Invalid regular expression '$opt_q' given as -q pattern: $@ Did you mean \\Q$opt_q ? EOD + for (@found) { die "invalid file spec: $!" if /[<>|]/ } + local $_; while (<>) { if (/^=head2\s+.*(?:$opt_q)/oi) { $found = 1; @@ -579,19 +626,19 @@ EOD push @pod, $_; } if (!@pod) { - safe_die("No documentation for perl FAQ keyword `$opt_q' found\n", - $tmp, $buffer); + die("No documentation for perl FAQ keyword `$opt_q' found\n"); } } my $filter; if (@pod) { - open(TMP,">$buffer") or safe_die("Can't open '$buffer': $!", $tmp, $buffer); + sysopen(TMP, $buffer, O_WRONLY | O_EXCL | O_CREAT) + or die("Can't open $buffer: $!"); print TMP "=over 8\n\n"; - print TMP @pod; + print TMP @pod or die "Can't print $buffer: $!"; print TMP "=back\n"; - close TMP; + close TMP or die "Can't close $buffer: $!"; @found = $buffer; $filter = 1; } @@ -601,7 +648,21 @@ foreach (@found) { } page($tmp, $no_tty, @pagers); -safe_exit(0, $tmp, $buffer); +exit; + +sub is_tainted { + my $arg = shift; + my $nada = substr($arg, 0, 0); # zero-length + local $@; # preserve caller's version + eval { eval "# $nada" }; + return length($@) != 0; +} + +sub am_taint_checking { + my($k,$v) = each %ENV; + return is_tainted($v); +} + __END__ @@ -708,7 +769,7 @@ One useful value for C<PERLDOC_PAGER> is C<less -+C -E>. =head1 VERSION -This is perldoc v2.0. +This is perldoc v2.01. =head1 AUTHOR @@ -720,6 +781,11 @@ and others. =cut # +# Version 2.01: Sat Mar 11 15:22:33 MST 2000 +# Tom Christiansen <tchrist@perl.com>, querulously. +# Security and correctness patches. +# What a twisted bit of distasteful spaghetti code. +# Version 2.0: ???? # Version 1.15: Tue Aug 24 01:50:20 EST 1999 # Charles Wilson <cwilson@ece.gatech.edu> # changed /pod/ directory to /pods/ for cygwin diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index c96c145752..77772c95ef 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -799,10 +799,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] Copy/Log $(MMS$SOURCE) $(MMS$TARGET) -install.html : []perl_setup.com installhtml. install $(perlpods) - @ @perl_setup - @ If F$Search("[.lib]html.dir").eqs."" Then Create/Directory [.lib.html] - $(MINIPERL) installhtml. "--podroot=/perl_root --recurse --htmldir=lib/html --htmlroot=lib/html --splithead=pod/perlipc --splititem=pod/perlfunc --libpods=perlfunc:perlguts:perlvar:perlrun:perlop --verbose" +install.html : $(perlpods) + @ @perl_setup.com + @ If F$Search("perl_root:[lib]html.dir").eqs."" Then Create/Directory perl_root:[lib.html] + $(MINIPERL) installhtml. "--podroot=. --recurse --htmldir=/perl_root/lib/html --htmlroot=.. --verbose" printconfig : @ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) @@ -882,6 +882,7 @@ test : all [.t.lib]vmsfspec.t [.t.lib]vmsish.t # install ought not need a source, but it doesn't work if one's not # there. Go figure... install : $(MINIPERL_EXE) + @ @perl_setup.com If F$TrnLnm("Sys") .nes. "" Then Deass SYS $(MINIPERL) installperl diff --git a/vms/subconfigure.com b/vms/subconfigure.com index 2df50cd414..d9231e7ffd 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -91,10 +91,10 @@ $ perl_i_ustat = "undef" $ perl_d_llseek="undef" $ perl_d_iconv="undef" $ perl_d_madvise="undef" -$ perl_selectminbits=32 -$ perl_d_msync="undef" -$ perl_d_vendorarch="define" +$ perl_selectminbits="32" +$ perl_d_vendorarch="undef" $ perl_vendorarchexp="" +$ perl_d_msync="undef" $ perl_d_mprotect="undef" $ perl_d_munmap="undef" $ perl_crosscompile="undef" @@ -1053,6 +1053,53 @@ $ ENDIF $ ENDIF $ WRITE_RESULT "i_inttypes is ''perl_i_inttypes'" $! +$! Check for h_errno +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "#include <unistd.h> +$ WS "#include <netdb.h> +$ WS "int main() +$ WS "{" +$ WS "h_errno = 3; +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ if (teststatus.nes."1") +$ THEN +$ perl_d_herrno="undef" +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ ELSE +$ If (Needs_Opt) +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_d_herrno="undef" +$ ELSE +$ perl_d_herrno="define" +$ ENDIF +$ ENDIF +$ WRITE_RESULT "d_herrno is ''perl_d_herrno'" +$! $! Check to see if int64_t exists $! $ OS @@ -3561,11 +3608,14 @@ $ type = "''perl_i64type'" $ size_name = "i64size" $ gosub type_size_check $ perl_i64size="''line'" +$ perl_ivtype="''perl_i64type'" $ $ type = "''perl_u64type'" $ size_name = "u64size" $ gosub type_size_check $ perl_u64size="''line'" +$ perl_uvtype="''perl_u64type'" +$ perl_nvtype="long double" $ Else $ perl_i64size="undef" $ perl_u64size="undef" @@ -4138,6 +4188,7 @@ $ WC "sPRIx64='" + perl_sPRIx64 + "'" $ WC "d_llseek='" + perl_d_llseek + "'" $ WC "d_iconv='" + perl_d_iconv +"'" $ WC "i_iconv='" + perl_i_iconv +"'" +$ WC "inc_version_list='0'" $ WC "inc_version_list_init='0'" $ WC "uselargefiles='" + perl_uselargefiles + "'" $ WC "uselongdouble='" + perl_uselongdouble + "'" @@ -4276,6 +4327,10 @@ $ if be_case_sensitive $ then $ write config "#define VMS_WE_ARE_CASE_SENSITIVE" $ endif +$ if perl_d_herrno .eqs. "undef" +$ THEN +$ write config "#define NEED_AN_H_ERRNO" +$ ENDIF $ WRITE CONFIG "#define HAS_ENVGETENV" $ WRITE CONFIG "#define PERL_EXTERNAL_GLOB" $ CLOSE CONFIG @@ -68,6 +68,9 @@ # define prv$v_sysprv prv$r_prvdef_bits0.prv$v_sysprv #endif +#if defined(NEED_AN_H_ERRNO) +dEXT int h_errno; +#endif struct itmlst_3 { unsigned short int buflen; diff --git a/vms/vmsish.h b/vms/vmsish.h index a09d2be438..12b13696ce 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -257,7 +257,7 @@ #define BIT_BUCKET "_NLA0:" #define PERL_SYS_INIT(c,v) vms_image_init((c),(v)); MALLOC_INIT -#define PERL_SYS_TERM() MALLOC_TERM +#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM #define dXSUB_SYS #define HAS_KILL #define HAS_WAIT @@ -307,7 +307,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -717,4 +717,9 @@ typedef char __VMS_SEPYTOTORP__; #undef HAS_NTOHL #endif +/* The C RTL manual says to undef the macro for DEC C 5.2 and lower. */ +#if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000 +# undef fileno +#endif + #endif /* __vmsish_h_included */ diff --git a/vos/config.def b/vos/config.def index 7ef644dfe9..34f57709e4 100644 --- a/vos/config.def +++ b/vos/config.def @@ -112,7 +112,7 @@ $d_htonl='define' $d_iconv='undef' $d_index='undef' $d_inetaton='undef' -$d_int64t='undef' +$d_int64_t='undef' $d_isascii='define' $d_killpg='undef' $d_lchown='undef' @@ -134,6 +134,9 @@ $d_memcpy='define' $d_memmove='define' $d_memset='define' $d_mkdir='define' +$d_mkdtemp='undef' +$d_mkstemp='undef' +$d_mkstemps='undef' $d_mkfifo='define' $d_mktime='define' $d_mmap='undef' @@ -257,6 +260,7 @@ $d_umask='define' $d_uname='define' $d_union_semun='undef' $d_ustat='undef' +$d_vendorarch='define' $d_vendorlib='define' $d_vfork='undef' $d_void_closedir='undef' @@ -330,6 +334,8 @@ $i_sysaccess='undef' $i_sysdir='undef' $i_sysfile='undef' $i_sysioctl='define' +$i_syslog='undef' +$i_sysmode='undef' $i_sysmount='undef' $i_sysndir='undef' $i_sysparam='undef' @@ -345,6 +351,7 @@ $i_systimes='define' $i_systypes='define' $i_sysuio='undef' $i_sysun='undef' +$i_sysutsname='define' $i_sysvfs='undef' $i_syswait='define' $i_termio='undef' @@ -357,7 +364,7 @@ $i_values='define' $i_varargs='undef' $i_vfork='undef' $Id='$Id' -$inc_version_list_init='' +$inc_version_list_init='0' $installusrbinperl='undef' $intsize='4' $ivdformat='"d"' @@ -406,6 +413,7 @@ $sitearch='' $sitearchexp='' $sitelib='/system/ported/perl/lib/site/5.005' $sitelibexp='/system/ported/perl/lib/site/5.005' +$sitelib_stem='/system/ported/perl/lib/site' $sizetype='size_t' $socksizetype='int' $sPRIfldbl='"Lf"' @@ -436,6 +444,7 @@ $use5005threads='undef' $use64bitall='undef' $use64bitint='undef' $usedl='undef' +$useithreads='undef' $uselargefiles='undef' $uselongdouble='define' $usemorebits='undef' @@ -448,6 +457,9 @@ $uvsize='4' $uvtype='unsigned int' $uvuformat='"u"' $uvxformat='"x"' +$vendorarch='' +$vendorarchexp='' +$vendorlib_stem='' $vendorlibexp='' $voidflags='15' $xs_apiversion='5.00563' diff --git a/vos/config.h b/vos/config.h index d163593ed0..78e5c693fe 100644 --- a/vos/config.h +++ b/vos/config.h @@ -1186,14 +1186,18 @@ * This macro surrounds its token with double quotes. */ #if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" +# define CAT2(a,b) a/**/b +# define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) +# define PeRl_CaTiFy(a, b) a ## b +# define PeRl_StGiFy(a) #a +/* the additional level of indirection enables these macros to be + * used as arguments to other macros. See K&R 2nd ed., page 231. */ +# define CAT2(a,b) PeRl_CaTiFy(a,b) +# define StGiFy(a) PeRl_StGiFy(a) +# define STRINGIFY(a) PeRl_StGiFy(a) #endif #if 42 != 1 && 42 != 42 #include "Bletch: How does this C preprocessor catenate tokens?" @@ -1608,7 +1612,7 @@ * Usually the <inttypes.h> needs to be included, but sometimes * <sys/types.h> is enough. */ -# HAS_INT64_T /**/ +/*#define HAS_INT64_T /**/ /* HAS_ISASCII: * This manifest constant lets the C program know that isascii @@ -1674,21 +1678,21 @@ * This symbol, if defined, indicates that the mkdtemp routine is * available to exclusively create a uniquely named temporary directory. */ -# HAS_MKDTEMP /**/ +/*#define HAS_MKDTEMP /**/ /* HAS_MKSTEMP: * This symbol, if defined, indicates that the mkstemp routine is * available to exclusively create and open a uniquely named * temporary file. */ -# HAS_MKSTEMP /**/ +/*#define HAS_MKSTEMP /**/ /* HAS_MKSTEMPS: * This symbol, if defined, indicates that the mkstemps routine is * available to excluslvely create and open a uniquely named * (with a suffix) temporary file. */ -# HAS_MKSTEMPS /**/ +/*#define HAS_MKSTEMPS /**/ /* HAS_MMAP: * This symbol, if defined, indicates that the mmap system call is @@ -2362,13 +2366,13 @@ * This symbol, if defined, indicates that <syslog.h> exists and * should be included. */ -# I_SYSLOG /**/ +/*#define I_SYSLOG /**/ /* I_SYSMODE: * This symbol, if defined, indicates that <sys/mode.h> exists and * should be included. */ -# I_SYSMODE /**/ +/*#define I_SYSMODE /**/ /* I_SYS_MOUNT: * This symbol, if defined, indicates that <sys/mount.h> exists and @@ -2397,7 +2401,7 @@ * This symbol, if defined, indicates that <sys/utsname.h> exists and * should be included. */ -# I_SYSUTSNAME /**/ +#define I_SYSUTSNAME /**/ /* I_SYS_VFS: * This symbol, if defined, indicates that <sys/vfs.h> exists and @@ -2434,7 +2438,7 @@ * for a C initialization string. See the inc_version_list entry * in Porting/Glossary for more details. */ -#define PERL_INC_VERSION_LIST /**/ +#define PERL_INC_VERSION_LIST 0 /**/ /* INSTALL_USR_BIN_PERL: * This symbol, if defined, indicates that Perl is to be installed @@ -2770,8 +2774,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "" /**/ -#define SITEARCH_EXP "" /**/ +/*#define SITEARCH "" /**/ +/*#define SITEARCH_EXP "" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2788,8 +2792,14 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "/system/ported/perl/lib/site/5.005" /**/ #define SITELIB_EXP "/system/ported/perl/lib/site/5.005" /**/ +#define SITELIB_STEM "/system/ported/perl/lib/site" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2932,17 +2942,29 @@ * be built to use the old draft POSIX threads API. */ /*#define USE_5005THREADS /**/ -# USE_ITHREADS /**/ +/*#define USE_ITHREADS /**/ #if defined(USE_5005THREADS) && !defined(USE_ITHREADS) #define USE_THREADS /* until src is revised*/ #endif /*#define OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PERL_VENDORARCH_EXP "" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define PERL_VENDORLIB_EXP "" /**/ +#define PERL_VENDORLIB_STEM "" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/vos/config_h.SH_orig b/vos/config_h.SH_orig index d452aa9fa1..299c931298 100755 --- a/vos/config_h.SH_orig +++ b/vos/config_h.SH_orig @@ -1204,14 +1204,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This macro surrounds its token with double quotes. */ #if $cpp_stuff == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" +# define CAT2(a,b) a/**/b +# define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if $cpp_stuff == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) +# define PeRl_CaTiFy(a, b) a ## b +# define PeRl_StGiFy(a) #a +/* the additional level of indirection enables these macros to be + * used as arguments to other macros. See K&R 2nd ed., page 231. */ +# define CAT2(a,b) PeRl_CaTiFy(a,b) +# define StGiFy(a) PeRl_StGiFy(a) +# define STRINGIFY(a) PeRl_StGiFy(a) #endif #if $cpp_stuff != 1 && $cpp_stuff != 42 #include "Bletch: How does this C preprocessor catenate tokens?" @@ -2788,8 +2792,8 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "$sitearch" /**/ -#define SITEARCH_EXP "$sitearchexp" /**/ +#$d_sitearch SITEARCH "$sitearch" /**/ +#$d_sitearch SITEARCH_EXP "$sitearchexp" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2806,8 +2810,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "$sitelib" /**/ #define SITELIB_EXP "$sitelibexp" /**/ +#define SITELIB_STEM "$sitelib_stem" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2956,11 +2966,23 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #endif #$d_oldpthreads OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#$d_vendorarch PERL_VENDORARCH_EXP "$vendorarchexp" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ +#$d_vendorlib PERL_VENDORLIB_STEM "$vendorlib_stem" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/vos/vosish.h b/vos/vosish.h index c5c819a57b..5a6b0796f8 100644 --- a/vos/vosish.h +++ b/vos/vosish.h @@ -36,7 +36,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/win32/config.bc b/win32/config.bc index fdd26dea8e..32fb9d82b7 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -349,6 +349,7 @@ d_umask='define' d_uname='define' d_union_semun='define' d_ustat='undef' +d_vendorarch='undef' d_vendorbin='undef' d_vendorlib='undef' d_vfork='undef' @@ -512,6 +513,7 @@ installsitebin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' installstyle='lib' installusrbinperl='undef' +installvendorarch='' installvendorbin='' installvendorlib='' intsize='4' @@ -667,6 +669,7 @@ sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' +sitelib_stem='' sitelibexp='~INST_TOP~\site~INST_VER~\lib' siteprefix='~INST_TOP~\site~INST_VER~' siteprefixexp='~INST_TOP~\site~INST_VER~' @@ -751,9 +754,12 @@ uvsize='4' uvtype='unsigned long' uvuformat='"lu"' uvxformat='"lx"' +vendorarch='' +vendorarchexp='' vendorbin='' vendorbinexp='' vendorlib='' +vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' diff --git a/win32/config.gc b/win32/config.gc index 9df20c2761..950a3d7df8 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -349,6 +349,7 @@ d_umask='define' d_uname='define' d_union_semun='define' d_ustat='undef' +d_vendorarch='undef' d_vendorbin='undef' d_vendorlib='undef' d_vfork='undef' @@ -512,6 +513,7 @@ installsitebin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' installstyle='lib' installusrbinperl='undef' +installvendorarch='' installvendorbin='' installvendorlib='' intsize='4' @@ -667,6 +669,7 @@ sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' +sitelib_stem='' sitelibexp='~INST_TOP~\site~INST_VER~\lib' siteprefix='~INST_TOP~\site~INST_VER~' siteprefixexp='~INST_TOP~\site~INST_VER~' @@ -751,9 +754,12 @@ uvsize='4' uvtype='unsigned long' uvuformat='"lu"' uvxformat='"lx"' +vendorarch='' +vendorarchexp='' vendorbin='' vendorbinexp='' vendorlib='' +vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' diff --git a/win32/config.vc b/win32/config.vc index c3e1f7d6cf..007834e838 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -349,6 +349,7 @@ d_umask='define' d_uname='define' d_union_semun='define' d_ustat='undef' +d_vendorarch='undef' d_vendorbin='undef' d_vendorlib='undef' d_vfork='undef' @@ -512,6 +513,7 @@ installsitebin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' installstyle='lib' installusrbinperl='undef' +installvendorarch='' installvendorbin='' installvendorlib='' intsize='4' @@ -667,6 +669,7 @@ sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' +sitelib_stem='' sitelibexp='~INST_TOP~\site~INST_VER~\lib' siteprefix='~INST_TOP~\site~INST_VER~' siteprefixexp='~INST_TOP~\site~INST_VER~' @@ -751,9 +754,12 @@ uvsize='4' uvtype='unsigned long' uvuformat='"lu"' uvxformat='"lx"' +vendorarch='' +vendorarchexp='' vendorbin='' vendorbinexp='' vendorlib='' +vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' diff --git a/win32/config_H.bc b/win32/config_H.bc index 1ec6d557a9..48fa1bac46 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: Sun Mar 5 04:30:07 2000 + * Configuration time: Sun Mar 5 22:28:23 2000 * Configured by : gsar * Target system : */ @@ -2792,8 +2792,14 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "c:\\perl\\site\\5.6.0\\lib" /**/ #define SITELIB_EXP (win32_get_sitelib("5.6.0")) /**/ +#define SITELIB_STEM "" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2942,11 +2948,23 @@ #endif /*#define OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH_EXP "" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ /*#define PERL_VENDORLIB_EXP "" /**/ +/*#define PERL_VENDORLIB_STEM "" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/win32/config_H.gc b/win32/config_H.gc index 5081c37789..cb2984deb8 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: Sun Mar 5 04:30:17 2000 + * Configuration time: Sun Mar 5 22:28:31 2000 * Configured by : gsar * Target system : */ @@ -2792,8 +2792,14 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "c:\\perl\\site\\5.6.0\\lib" /**/ #define SITELIB_EXP (win32_get_sitelib("5.6.0")) /**/ +#define SITELIB_STEM "" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2942,11 +2948,23 @@ #endif /*#define OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH_EXP "" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ /*#define PERL_VENDORLIB_EXP "" /**/ +/*#define PERL_VENDORLIB_STEM "" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/win32/config_H.vc b/win32/config_H.vc index 0706969f4f..0bb27e9be3 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: Sun Mar 5 04:30:31 2000 + * Configuration time: Sun Mar 5 22:28:36 2000 * Configured by : gsar * Target system : */ @@ -2792,8 +2792,14 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ #define SITELIB "c:\\perl\\site\\5.6.0\\lib" /**/ #define SITELIB_EXP (win32_get_sitelib("5.6.0")) /**/ +#define SITELIB_STEM "" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2942,11 +2948,23 @@ #endif /*#define OLD_PTHREADS_API /**/ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH_EXP "" /**/ + /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ /*#define PERL_VENDORLIB_EXP "" /**/ +/*#define PERL_VENDORLIB_STEM "" /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/win32/config_h.PL b/win32/config_h.PL index 17f3fc2163..5b0450609f 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -49,12 +49,12 @@ while (<SH>) munge(); s/\\\$/\$/g; s#/[ *\*]*\*/#/**/#; - if (/^\s*#define\s+(PRIVLIB|SITELIB)_EXP/) + if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/) { $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n"; } # incpush() handles archlibs, so disable them - elsif (/^\s*#define\s+(ARCHLIB|SITEARCH)_EXP/) + elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/) { $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n"; } diff --git a/win32/perlhost.h b/win32/perlhost.h index a3f4c28350..02b9cb4bc4 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -17,8 +17,9 @@ #if !defined(PERL_OBJECT) START_EXTERN_C #endif -extern char * g_win32_get_privlib(char *pl); -extern char * g_win32_get_sitelib(char *pl); +extern char * g_win32_get_privlib(const char *pl); +extern char * g_win32_get_sitelib(const char *pl); +extern char * g_win32_get_vendorlib(const char *pl); extern char * g_getlogin(void); extern int do_spawn2(char *cmd, int exectype); #if !defined(PERL_OBJECT) @@ -475,17 +476,23 @@ PerlEnvOsId(struct IPerlEnv* piPerl) } char* -PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl) +PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl) { return g_win32_get_privlib(pl); } char* -PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl) +PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl) { return g_win32_get_sitelib(pl); } +char* +PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl) +{ + return g_win32_get_vendorlib(pl); +} + void PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr) { @@ -506,6 +513,7 @@ struct IPerlEnv perlEnv = PerlEnvOsId, PerlEnvLibPath, PerlEnvSiteLibPath, + PerlEnvVendorLibPath, PerlEnvGetChildIO, }; diff --git a/win32/perllib.c b/win32/perllib.c index f240e2f0c0..6211ba7129 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -259,7 +259,6 @@ RunPerl(int argc, char **argv, char **env) { int exitstatus; PerlInterpreter *my_perl, *new_perl = NULL; - struct perl_thread *thr; #ifndef __BORLANDC__ /* XXX this _may_ be a problem on some compilers (e.g. Borland) that @@ -289,7 +288,7 @@ RunPerl(int argc, char **argv, char **env) if (!(my_perl = perl_alloc())) return (1); - perl_construct( my_perl ); + perl_construct(my_perl); PL_perl_destruct_level = 0; exitstatus = perl_parse(my_perl, xs_init, argc, argv, env); @@ -312,15 +311,15 @@ RunPerl(int argc, char **argv, char **env) # else new_perl = perl_clone(my_perl, 1); # endif - exitstatus = perl_run( new_perl ); + exitstatus = perl_run(new_perl); PERL_SET_THX(my_perl); #else - exitstatus = perl_run( my_perl ); + exitstatus = perl_run(my_perl); #endif } - perl_destruct( my_perl ); - perl_free( my_perl ); + perl_destruct(my_perl); + perl_free(my_perl); #ifdef USE_ITHREADS if (new_perl) { PERL_SET_THX(new_perl); diff --git a/win32/win32.c b/win32/win32.c index 4ccae52d84..840274beab 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -84,6 +84,8 @@ int _fcloseall(); # define win32_get_privlib g_win32_get_privlib # undef win32_get_sitelib # define win32_get_sitelib g_win32_get_sitelib +# undef win32_get_vendorlib +# define win32_get_vendorlib g_win32_get_vendorlib # undef do_spawn # define do_spawn g_do_spawn # undef getlogin @@ -107,6 +109,9 @@ static char * get_emd_part(SV **leading, char *trailing, ...); static void remove_dead_process(long deceased); static long find_pid(int pid); static char * qualified_path(const char *cmd); +static char * win32_get_xlib(const char *pl, const char *xlib, + const char *libname); + #ifdef USE_ITHREADS static void remove_dead_pseudo_process(long child); static long find_pseudo_pid(int pid); @@ -265,7 +270,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) } char * -win32_get_privlib(char *pl) +win32_get_privlib(const char *pl) { dTHXo; char *stdlib = "lib"; @@ -281,11 +286,10 @@ win32_get_privlib(char *pl) return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch); } -char * -win32_get_sitelib(char *pl) +static char * +win32_get_xlib(const char *pl, const char *xlib, const char *libname) { dTHXo; - char *sitelib = "sitelib"; char regstr[40]; char pathstr[MAX_PATH+1]; DWORD datalen; @@ -293,21 +297,22 @@ win32_get_sitelib(char *pl) SV *sv1 = Nullsv; SV *sv2 = Nullsv; - /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */ - sprintf(regstr, "%s-%s", sitelib, pl); + /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */ + sprintf(regstr, "%s-%s", xlib, pl); (void)get_regstr(regstr, &sv1); - /* $sitelib .= - * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */ - sprintf(pathstr, "site/%s/lib", pl); + /* $xlib .= + * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */ + sprintf(pathstr, "%s/%s/lib", libname, pl); (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); - /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ - (void)get_regstr(sitelib, &sv2); + /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */ + (void)get_regstr(xlib, &sv2); - /* $sitelib .= - * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */ - (void)get_emd_part(&sv2, "site/lib", ARCHNAME, "bin", pl, Nullch); + /* $xlib .= + * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */ + sprintf(pathstr, "%s/lib", libname); + (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch); if (!sv1 && !sv2) return Nullch; @@ -322,6 +327,21 @@ win32_get_sitelib(char *pl) return SvPVX(sv1); } +char * +win32_get_sitelib(const char *pl) +{ + return win32_get_xlib(pl, "sitelib", "site"); +} + +#ifndef PERL_VENDORLIB_NAME +# define PERL_VENDORLIB_NAME "vendor" +#endif + +char * +win32_get_vendorlib(const char *pl) +{ + return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME); +} static BOOL has_shell_metachars(char *ptr) @@ -3183,10 +3203,20 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) } memset(&StartupInfo,0,sizeof(StartupInfo)); StartupInfo.cb = sizeof(StartupInfo); + memset(&tbl,0,sizeof(tbl)); PerlEnv_get_child_IO(&tbl); - StartupInfo.hStdInput = tbl.childStdIn; - StartupInfo.hStdOutput = tbl.childStdOut; - StartupInfo.hStdError = tbl.childStdErr; + StartupInfo.dwFlags = tbl.dwFlags; + StartupInfo.dwX = tbl.dwX; + StartupInfo.dwY = tbl.dwY; + StartupInfo.dwXSize = tbl.dwXSize; + StartupInfo.dwYSize = tbl.dwYSize; + StartupInfo.dwXCountChars = tbl.dwXCountChars; + StartupInfo.dwYCountChars = tbl.dwYCountChars; + StartupInfo.dwFillAttribute = tbl.dwFillAttribute; + StartupInfo.wShowWindow = tbl.wShowWindow; + StartupInfo.hStdInput = tbl.childStdIn; + StartupInfo.hStdOutput = tbl.childStdOut; + StartupInfo.hStdError = tbl.childStdErr; if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE && StartupInfo.hStdOutput != INVALID_HANDLE_VALUE && StartupInfo.hStdError != INVALID_HANDLE_VALUE) diff --git a/win32/win32.h b/win32/win32.h index a0d076109c..81bf5747a9 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -25,6 +25,7 @@ # endif # define win32_get_privlib PerlEnv_lib_path # define win32_get_sitelib PerlEnv_sitelib_path +# define win32_get_vendorlib PerlEnv_vendorlib_path #endif #ifdef __GNUC__ @@ -301,6 +302,23 @@ typedef struct { HANDLE childStdIn; HANDLE childStdOut; HANDLE childStdErr; + /* + * the following correspond to the fields of the same name + * in the STARTUPINFO structure. Embedders can use these to + * control the spawning process' look. + * Example - to hide the window of the spawned process: + * dwFlags = STARTF_USESHOWWINDOW; + * wShowWindow = SW_HIDE; + */ + DWORD dwFlags; + DWORD dwX; + DWORD dwY; + DWORD dwXSize; + DWORD dwYSize; + DWORD dwXCountChars; + DWORD dwYCountChars; + DWORD dwFillAttribute; + WORD wShowWindow; } child_IO_table; DllExport void win32_get_child_IO(child_IO_table* ptr); @@ -312,8 +330,9 @@ extern int my_fclose(FILE *); extern int do_aspawn(void *really, void **mark, void **sp); extern int do_spawn(char *cmd); extern int do_spawn_nowait(char *cmd); -extern char * win32_get_privlib(char *pl); -extern char * win32_get_sitelib(char *pl); +extern char * win32_get_privlib(const char *pl); +extern char * win32_get_sitelib(const char *pl); +extern char * win32_get_vendorlib(const char *pl); extern int IsWin95(void); extern int IsWinNT(void); extern void win32_argv2utf8(int argc, char** argv); diff --git a/win32/win32thread.h b/win32/win32thread.h index 46c6bf5f84..809e0f7212 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -17,8 +17,6 @@ typedef CRITICAL_SECTION perl_mutex; #define MUTEX_INIT(m) InitializeCriticalSection(m) #define MUTEX_LOCK(m) EnterCriticalSection(m) #define MUTEX_UNLOCK(m) LeaveCriticalSection(m) -#define MUTEX_LOCK_NOCONTEXT(m) EnterCriticalSection(m) -#define MUTEX_UNLOCK_NOCONTEXT(m) LeaveCriticalSection(m) #define MUTEX_DESTROY(m) DeleteCriticalSection(m) #else @@ -27,28 +25,16 @@ typedef HANDLE perl_mutex; # define MUTEX_INIT(m) \ STMT_START { \ if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \ - Perl_croak(aTHX_ "panic: MUTEX_INIT"); \ + Perl_croak_nocontext("panic: MUTEX_INIT"); \ } STMT_END # define MUTEX_LOCK(m) \ STMT_START { \ if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \ - Perl_croak(aTHX_ "panic: MUTEX_LOCK"); \ - } STMT_END - -# define MUTEX_UNLOCK(m) \ - STMT_START { \ - if (ReleaseMutex(*(m)) == 0) \ - Perl_croak(aTHX_ "panic: MUTEX_UNLOCK"); \ - } STMT_END - -# define MUTEX_LOCK_NOCONTEXT(m) \ - STMT_START { \ - if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \ Perl_croak_nocontext("panic: MUTEX_LOCK"); \ } STMT_END -# define MUTEX_UNLOCK_NOCONTEXT(m) \ +# define MUTEX_UNLOCK(m) \ STMT_START { \ if (ReleaseMutex(*(m)) == 0) \ Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \ @@ -57,7 +43,7 @@ typedef HANDLE perl_mutex; # define MUTEX_DESTROY(m) \ STMT_START { \ if (CloseHandle(*(m)) == 0) \ - Perl_croak(aTHX_ "panic: MUTEX_DESTROY"); \ + Perl_croak_nocontext("panic: MUTEX_DESTROY"); \ } STMT_END #endif @@ -71,21 +57,21 @@ typedef HANDLE perl_mutex; (c)->waiters = 0; \ (c)->sem = CreateSemaphore(NULL,0,LONG_MAX,NULL); \ if ((c)->sem == NULL) \ - Perl_croak(aTHX_ "panic: COND_INIT (%ld)",GetLastError()); \ + Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \ } STMT_END #define COND_SIGNAL(c) \ STMT_START { \ if ((c)->waiters > 0 && \ ReleaseSemaphore((c)->sem,1,NULL) == 0) \ - Perl_croak(aTHX_ "panic: COND_SIGNAL (%ld)",GetLastError()); \ + Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \ } STMT_END #define COND_BROADCAST(c) \ STMT_START { \ if ((c)->waiters > 0 && \ ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \ - Perl_croak(aTHX_ "panic: COND_BROADCAST (%ld)",GetLastError());\ + Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\ } STMT_END #define COND_WAIT(c, m) \ @@ -96,7 +82,7 @@ typedef HANDLE perl_mutex; * COND_BROADCAST() on another thread will have seen the\ * right number of waiters (i.e. including this one) */ \ if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\ - Perl_croak(aTHX_ "panic: COND_WAIT (%ld)",GetLastError()); \ + Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \ /* XXX there may be an inconsequential race here */ \ MUTEX_LOCK(m); \ (c)->waiters--; \ @@ -106,14 +92,14 @@ typedef HANDLE perl_mutex; STMT_START { \ (c)->waiters = 0; \ if (CloseHandle((c)->sem) == 0) \ - Perl_croak(aTHX_ "panic: COND_DESTROY (%ld)",GetLastError()); \ + Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError()); \ } STMT_END #define DETACH(t) \ STMT_START { \ if (CloseHandle((t)->self) == 0) { \ MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak(aTHX_ "panic: DETACH"); \ + Perl_croak_nocontext("panic: DETACH"); \ } \ } STMT_END @@ -195,7 +181,7 @@ END_EXTERN_C if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ || (CloseHandle((t)->self) == 0)) \ - Perl_croak(aTHX_ "panic: JOIN"); \ + Perl_croak_nocontext("panic: JOIN"); \ *avp = (AV *)((t)->i.retv); \ } STMT_END #else /* !USE_RTL_THREAD_API || _MSC_VER */ @@ -204,7 +190,7 @@ END_EXTERN_C if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ || (CloseHandle((t)->self) == 0)) \ - Perl_croak(aTHX_ "panic: JOIN"); \ + Perl_croak_nocontext("panic: JOIN"); \ } STMT_END #endif /* !USE_RTL_THREAD_API || _MSC_VER */ |