diff options
| author | Malcolm Beattie <mbeattie@sable.ox.ac.uk> | 1998-05-14 16:15:09 +0000 |
|---|---|---|
| committer | Malcolm Beattie <mbeattie@sable.ox.ac.uk> | 1998-05-14 16:15:09 +0000 |
| commit | a5871d1a83cd3d5c7292135cbb30a336a8552ab0 (patch) | |
| tree | e056f664b56c544259b77891801390c472109ed0 | |
| parent | 841a92052a6767bd088da257cef4b0db4ccd123d (diff) | |
| parent | 20408e3ccf502b6ce4033d8203710405ec9ef8f6 (diff) | |
| download | perl-a5871d1a83cd3d5c7292135cbb30a336a8552ab0.tar.gz | |
Integrate win32 branch into mainline
p4raw-id: //depot/perl@969
119 files changed, 4148 insertions, 1753 deletions
diff --git a/Changes5.004 b/Changes5.004 index 90a8b53374..da2166d013 100644 --- a/Changes5.004 +++ b/Changes5.004 @@ -51,6 +51,853 @@ And, of course, the Author of Perl: Larry Wall <larry@wall.org> ---------------- +Version 5.004_05 Maintenance release 5 for 5.004 +---------------- + +"I said to my soul, be still, and wait without hope + For hope would hope for the wrong thing; wait without love + For love would be love of the wrong thing; there is yet faith + But the faith and the love and the hope are all in the waiting. + Wait without thought, for you are not ready for thought: + So the darkness shall be light, and the stillness the dancing." + -- T.S.Eliot, East Coker + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + TBA + + +Change 764 on 1998/03/05 by TimBunce@ig.co.uk + + APPLLIB_EXP now has arch and version dirs added to @INC + +Change 761 on 1998/03/05 by TimBunce@ig.co.uk + + Title: "properly refcount localization, fix C<local $tied{foo}>" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802191207.MAA10742@toad.ig.co.uk> + Files: av.c hv.c scope.c t/op/local.t + +Change 758 on 1998/03/04 by TimBunce@ig.co.uk + + perldoc -f now uses pager if text is too long for screen + +Change 757 on 1998/03/04 by TimBunce@ig.co.uk + + Added OpenBSD hint file from <Todd.Miller@courtesan.com> + Document 'warn with no args' behaviour, from <johnpc@xs4all.net> + +Change 756 on 1998/03/04 by TimBunce@ig.co.uk + + Fix for new gnulibc stdio.h when using sfio+perlio + +Change 755 on 1998/03/04 by TimBunce@ig.co.uk + + Fixed typo in vms/ext/Stdio/Stdio.pm AUTOLOAD + Added details of split in scalar context to perlfunc.pod + +Change 754 on 1998/03/04 by TimBunce@ig.co.uk + + Updated perl -v info to include reference to docs and home page. + +Change 753 on 1998/03/04 by TimBunce@ig.co.uk + + Updated hints/bsdos.sh for BSD/OS 3.1 + Fixed typo in pod/perlsyn.pod + Added workaround for old gmake in ext/SDBM_File/sdbm/Makefile.PL + Fixed typo in ext/GDBM_File/GDBM_File.pm + +Change 752 on 1998/03/04 by TimBunce@ig.co.uk + + Changed bug address in README to perlbug@perl.com + Changed Copyright in perl.c to 1998 + Added op/pos.t test from Robin Houston <robin@oneworld.org> + +Change 751 on 1998/03/04 by TimBunce@ig.co.uk + + Make t/comp/require.t and t/lib/ph.t executable in repository + +Change 750 on 1998/03/04 by TimBunce@ig.co.uk + + Added dTHR definition to ease backwards compatibility for XS + source code from 5.005. + +Change 749 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "rename local 'op' variables to 'o'", #F114 + From: Gurusamy Sarathy + Files: op.h opcode.h proto.h dump.c op.c opcode.pl pp_ctl.c run.c scope.c + toke.c + +Change 748 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "consolidated win32 patch", #F112 + From: Gurusamy Sarathy + Files: MANIFEST pod/perlfaq2.pod pod/perlrun.pod win32/include/sys/socket.h + EXTERN.h INTERN.h dosish.h lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm t/TEST + t/harness win32/win32.h win32/win32iop.h README.win32 + doio.c installhtml installperl pp_sys.c win32/Makefile + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/config_h.PL win32/config_sh.PL + win32/dl_win32.xs win32/makedef.pl win32/makefile.mk + win32/perllib.c win32/runperl.c win32/win32.c + win32/win32sck.c win32/bin/perlglob.pl x2p/a2p.h x2p/a2p.c + x2p/a2py.c + +Change 747 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "initialize @INC in ph.t, and fix up MANIFEST", #F111 + From: Gurusamy Sarathy + Files: MANIFEST t/lib/ph.t + +Change 746 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "properly save STDOUT during system() in debugger", #F110 + From: Jason Smith <smithj4@rpi.edu> + Files: lib/perl5db.pl + +Change 745 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "generate DynaLoader.pm at build time", #F109 + From: Achim Bohnet <ach@mpe.mpg.de> + Msg-ID: <9802111938.AA26224@o09.xray.mpe.mpg.de> + Files: MANIFEST ext/DynaLoader/DynaLoader.pm.PL ext/DynaLoader/Makefile.PL + +Change 744 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Install extensions with bootstrap in $archlib", #F108 + From: koenig@anna.mind.de (Andreas J. Koenig), koenig@kulturbox.de (Andreas + J. Koenig) + Msg-ID: <sfcra9fqx0n.fsf@anna.in-berlin.de> + Files: lib/ExtUtils/Install.pm + +Change 743 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Pod::Html trips over "C<0>"", #F107 + From: Chip Salzenberg + Files: lib/Pod/Html.pm + +Change 742 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_58 | _04: pod2*,perlpod: L<show this|man/section>", #F106 + From: Achim Bohnet <ach@mpe.mpg.de> + Msg-ID: <9802111629.AA00595@o09.xray.mpe.mpg.de> + Files: pod/perlpod.pod lib/Pod/Html.pm lib/Pod/Text.pm pod/pod2man.PL + +Change 741 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "New patch for $^E==GetLastError() under Win32", #F105 + From: Gurusamy Sarathy <gsar@engin.umich.edu>, Tye McQueen + <tye@metronet.com>, ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <199801040630.AA29298@metronet.com>, + <199801041826.NAA11568@aatma.engin.umich.edu>, + <1998Jan4.130412.2719461@cor.newman> + Files: pod/perlfunc.pod pod/perlvar.pod doio.c lib/dumpvar.pl lib/perl5db.pl + win32/win32.h mg.c util.c win32/makedef.pl win32/win32.c + +Change 740 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_56: Patch to Tie::Hash and docs", #F104 + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199801120134.UAA05437@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod lib/Tie/Hash.pm + +Change 739 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "more doc for perldoc", #F103 + From: Gurusamy Sarathy + Files: utils/perldoc.PL + +Change 738 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make perldoc look for an index file ", #F102 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <199801221220.NAA22902@furu.g.aas.no> + Files: utils/perldoc.PL + +Change 737 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "perldoc -F filename", #F101 + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199712120037.TAA00176@math.mps.ohio-state.edu> + Files: utils/perldoc.PL + +Change 736 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "sv_grow can fail for HAS_64K_LIMIT systems", #F100 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <m3iuqsl3oq.fsf@furu.g.aas.no> + Files: sv.c + +Change 735 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Benchmark.pm: timethese corrupts $_", #F099 + From: abigail@fnx.com + Msg-ID: <19980201114609.7779.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Benchmark.pm + +Change 734 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "STRANGE_MALLOC should test failed alloc", #F098 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <199802021406.PAA03285@furu.g.aas.no> + Files: hv.c + +Change 733 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "support caseless %ENV", #F097 + From: Gurusamy Sarathy + Files: hv.c t/op/magic.t win32/win32.h + +Change 732 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "newer cperl-mode.el (from 5.004_60)", #F096 + From: Ilya Zakharevich + Files: emacs/cperl-mode.el + +Change 731 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Handle set magic on xsub OUTPUT args, add API functions that handle + magic", #F095 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199801190409.XAA26710@aatma.engin.umich.edu> + Files: pod/perlguts.pod pod/perlxs.pod embed.h proto.h sv.h global.sym + lib/ExtUtils/xsubpp sv.c + +Change 730 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Fix flawed cleanup when signal handlers are not defined", #F094 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199710290106.UAA11485@aatma.engin.umich.edu> + Files: mg.c + +Change 729 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Tests for C<sort 'foo','bar'>", #F093 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199711021247.MAA01743@crypt.compulink.co.uk> + Files: t/op/sort.t + +Change 728 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make search.pl work on win32", #F092 + From: Gurusamy Sarathy + Files: win32/bin/search.pl + +Change 721 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix spurious perldoc warnings on DOSISH platforms", #F091 + From: Molnar Laszlo <molnarl@cdata.tvnet.hu> + Msg-ID: <34475659.1AA69855@cdata.tvnet.hu> + Files: utils/perldoc.PL + +Change 720 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make ExtUtils::MM_Unix::fixin() do something meaningful on win32", + #F090 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199801070016.TAA17766@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + +Change 719 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix inconsistent case $ENV{Path} (vs $ENV{PATH})", #F089 + From: Gurusamy Sarathy + Files: lib/FindBin.pm + +Change 718 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix File::Find's longstanding confusion about win32 being like VMS", + #F088 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802020459.XAA04964@aatma.engin.umich.edu> + Files: lib/File/Find.pm + +Change 717 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "do_postponed breaks with multiple interpreters", #F087 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199710290316.WAA15888@aatma.engin.umich.edu> + Files: op.c + +Change 716 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make warning on C<Nosuch::> optional, add to perl{diag,delta}.pod", + #F086 + From: Gurusamy Sarathy + Files: pod/perldelta.pod pod/perldiag.pod toke.c + +Change 715 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Pod::Html bug and fix: missing </UL> in index", #F085 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802192314.SAA23326@aatma.engin.umich.edu> + Files: lib/Pod/Html.pm + +Change 714 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New pod: perlhist", #F084 + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199802191556.RAA09578@alpha.hut.fi> + Files: MANIFEST pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + +Change 713 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix restoration of locals on scope unwinding", #F083 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802110515.AAA23700@aatma.engin.umich.edu> + Files: pp_ctl.c t/op/local.t + +Change 712 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "after an eval-ed bad require, requiring a string ref SEGVs", #F082 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802102349.SAA16001@aatma.engin.umich.edu> + Files: pp_ctl.c + +Change 711 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix seg fault on eval/require and syntax errors", #F081 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199802102321.SAA15346@aatma.engin.umich.edu> + Files: MANIFEST scope.h op.c pp_ctl.c scope.c t/comp/require.t toke.c + +Change 710 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_58: the locale.t problem in IRIX", #F080 + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199802091747.TAA01735@alpha.hut.fi> + Files: t/pragma/locale.t + +Change 709 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "sv_setnv will upgrade SVt_NV to SVt_PVNV", #F079 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <m3g1lwl3bq.fsf@furu.g.aas.no> + Files: sv.c + +Change 708 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate double warnings under C<package;>", #F077 + From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + Msg-ID: <E0y0paq-0000Ov-00@ursa.cus.cam.ac.uk> + Files: gv.c op.c toke.c + +Change 707 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix infinite loop on unlink() failure in File::Path::rmtree()", + #F076 + From: Murray Nesbitt <mjn@pathcom.com>, Tim Bunce <Tim.Bunce@ig.co.uk> + Msg-ID: <199802061100.LAA16423@toad.ig.co.uk> + Files: lib/File/Path.pm + +Change 706 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update of h2ph", #F075 + From: kstar@www.chapin.edu (Kurt D. Starsinic) + Msg-ID: <199802051354.FAA11452@www.chapin.edu> + Files: t/lib/ph.t utils/h2ph.PL + +Change 705 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix AutoLoader for deep packages", #F074 + From: Zachary Miller <zcmiller@zappy.er.usgs.gov> + Msg-ID: <199710092348.SAA02108@zappy.er.usgs.gov> + Files: lib/AutoLoader.pm + +Change 704 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix order of warnings for misplaced subscripts", #F073 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk> + Files: op.c + +Change 703 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make recursive lexical analysis more robust", #F072 + From: Ilya Zakharevich and Chip Salzenberg + Msg-ID: <199710160102.VAA28817@monk.mps.ohio-state.edu> + Files: toke.c + +Change 702 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix random whitespace errors in docs", #F070 + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <12726.877706444@eeyore.ibcinc.com> + Files: pod/perlfunc.pod pod/checkpods.PL + +Change 701 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix line numbers after here documents in eval STRING", #F069 + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199710241745.NAA08166@monk.mps.ohio-state.edu> + Files: toke.c + +Change 700 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV from combining caller and C<package;>", #F068 + From: James Duncan <jduncan@epitome.hawk.igs.net>, Nicholas Clark + <nick@flirble.org> + Msg-ID: <199710241248.NAA00163@flirble.org>, + <Pine.LNX.3.96.971024135912.12197A-100000@epitome.hawk.igs. + net> + Files: pp_ctl.c sv.c + +Change 699 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't fold string comparison under C<use locale>", #F067 + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199711151506.RAA26287@alpha.hut.fi> + Files: op.c + +Change 698 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on constant at end of sort block", #F066 + From: Administration <fadmin@informatics.muni.cz> + Msg-ID: <199711170838.JAA26073@thetis.fi.muni.cz> + Files: op.c + +Change 697 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow C<last()> to mean C<last>", #F065 + From: Chip Salzenberg + Files: op.c + +Change 696 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix extension version mismatch message", #F064 + From: Chip Salzenberg + Files: XSUB.h + +Change 695 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Better handle and test struct tm of Linux and SunOS", #F063 + From: Andy Dougherty <doughera@newton.phys.lafayette.edu> + Msg-ID: <Pine.SUN.3.96.980205134340.15567B-100000@newton.phys> + Files: MANIFEST ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t + +Change 694 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix doc bug in getservbyname() examples", #F062 + From: Tom Christiansen + Files: ext/Socket/Socket.pm + +Change 693 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Kill warning about parameter type", #F061 + From: Chip Salzenberg + Files: op.c + +Change 692 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Socket occasional SEGV", #F060 + From: Trevor Blackwell <tlb@viaweb.com> + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + +Change 691 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid SEGV from local($@)", #F059 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199710290251.VAA14362@aatma.engin.umich.edu> + Files: pp_ctl.c + +Change 690 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )", #F058 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199710300036.TAA01004@aatma.engin.umich.edu> + Files: op.c + +Change 689 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Use STMT_{START,END} in XSRETURN", #F057 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199710300245.VAA04244@aatma.engin.umich.edu> + Files: XSUB.h + +Change 688 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: Sort grammar bug", #F056 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199711011946.OAA18882@aatma.engin.umich.edu> + Files: toke.c + +Change 687 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Document indirect object cases for exec(), system()", #F055 + From: Dominic Dunlop <domo@slipper.ip.lu> + Msg-ID: <v03110700b084e89234a7@[194.51.248.90]> + Files: pod/perlfunc.pod + +Change 686 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update docs on tr///", #F054 + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.96.971103071602.10568C-100000@usertest.teleport.com> + Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + pod/perllocale.pod pod/perlmod.pod pod/perlop.pod + pod/perlstyle.pod toke.c + +Change 685 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: perlop bitwise & | ^ documentation", #F053 + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.96.971106073858.29771O-100000@usertest.teleport.com> + Files: pod/perlop.pod + +Change 684 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on C<*glob{'SCALAR','ARRAY'}>", #F052 + From: "Joseph N. Hall" <joseph@cscaper.com> + Msg-ID: <199711110552.WAA12613@gadget.cscaper.com> + Files: perly.c perly.c.diff perly.y vms/perly_c.vms + +Change 683 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "for perlguts.pod: document sv_derived_from, sv_vcatpfn and + sv_vsetpfn", #F051 + From: jan.dubois@ibm.net (Jan Dubois) and Chip Salzenberg + Msg-ID: <346ae970.7444534@smtp1.ibm.net> + Files: pod/perlguts.pod + +Change 682 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_04: locale startup failure (at last) documented", #F050 + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199711172054.WAA08261@alpha.hut.fi> + Files: INSTALL pod/perldiag.pod pod/perllocale.pod + +Change 681 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Cope with lack of args in Fcntl::AUTOLOAD", #F049 + From: Jerome Abela <abela@hsc.fr> + Msg-ID: <19971120183248.23588@coredump.hsc.fr> + Files: ext/Fcntl/Fcntl.pm + +Change 680 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Commenting toke.c", #F048 + From: gnat@frii.com + Msg-ID: <199801082138.OAA14186@prometheus.frii.com> + Files: toke.c + +Change 679 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: 5.004_04 vec() fails with 32-bit values", #F047 + From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + Msg-ID: <E0xsnr8-0007SS-00@taurus.cus.cam.ac.uk> + Files: pod/perlguts.pod pp.c t/op/vec.t + +Change 678 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "A few perl5.004_03 bugs", #F046 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199801221211.MAA05315@crypt.compulink.co.uk> + Files: mg.c t/op/magic.t + +Change 677 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Faster, cleaner av_unshift() ", #F045 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <199801221850.TAA23111@furu.g.aas.no> + Files: av.c + +Change 676 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New hints/solaris2.sh", #F044 + From: Stephen Zander <srz@mckesson.com> + Msg-ID: <87oh12y458.fsf@wsuse5.mckesson.com> + Files: hints/solaris_2.sh + +Change 675 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Refresh Complex.pm and test", #F043 + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199802051608.SAA20262@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + +Change 674 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (\@@) proto", #F042 + From: "Joseph N. Hall" <joseph@cscaper.com> + Msg-ID: <199801240132.SAA25111@gadget.cscaper.com> + Files: op.c t/comp/proto.t + +Change 673 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow empty BLOCK in code", #F041 + From: Vladimir Alexiev <vladimir@cs.ualberta.ca> + Msg-ID: <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + +Change 672 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix name of $Foo::{'Bar::'}: '*Foo::Bar::'", #F040 + From: Chip Salzenberg + Files: gv.c t/op/gv.t + +Change 671 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Keep accurate reference count on globs' stashes", #F038 + From: Gisle Aas <gisle@aas.no> + Msg-ID: <m3zpk7sd3n.fsf@furu.g.aas.no> + Files: gv.c sv.c + +Change 670 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid memory allocation in gv_fetchpv(), for speed", #F037 + From: Chip Salzenberg + Files: gv.c + +Change 669 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Configure less negative about PerlIO", #F036 + From: chip@atlantic.net + Msg-ID: <199801312323.SAA15237@cyprus.atlantic.net> + Files: Configure + +Change 668 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (mostly) pseudo-same-REs due to embedded NULs", #F035 + From: Martin Plechsmid <plechsmi@karlin.mff.cuni.cz> + Msg-ID: <199802021217.NAA05230@albert.karlin.mff.cuni.cz> + Files: pp_ctl.c + +Change 667 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Getopt::Long avoid $&, $`, $'", #F034 + From: Irving Reid <irving@tor.securecomputing.com> + Msg-ID: <98Feb3.005102est.11655@janus.tor.securecomputing.com> + Files: lib/Getopt/Long.pm + +Change 666 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "adding the newSVpvn API function", #F033 + From: Matthias Ulrich Neeracher <neeri@iis.ee.ethz.ch> + Msg-ID: <199801310532.GAA23798@solar.ethz.ch> + Files: pod/perlguts.pod pod/perltoc.pod proto.h global.sym sv.c + +Change 665 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Support C<Package::> as function-blind bearword", #F032 + From: Chip Salzenberg + Files: toke.c + +Change 664 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re-optimize character classes", #F031 + From: Chip Salzenberg + Files: regcomp.h regcomp.c regexec.c + +Change 663 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C<if (1) { local $x }> which needed ENTER/LEAVE", #F030 + From: dfh@dwroll.lucent.com (D461-David_F_Haertig(Dave)83040) + Msg-ID: <EnKC0q.6qI@drnews.dr.lucent.com> + Files: op.c t/op/local.t + +Change 662 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Dramatically improve performance of // with parens or $&", #F029 + From: Chip Salzenberg + Files: cop.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c pp_ctl.c + pp_hot.c regexec.c scope.c + +Change 661 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't warn on $x{shift}, ne => 1, or -f => 1", #F028 + From: Chip Salzenberg + Files: toke.c + +Change 660 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Protect against weirdness with unreal @_ in C<local @_>", #F027 + From: Chip Salzenberg + Files: scope.c + +Change 659 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C<printf "%.0d", 0>", #F026 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199711021331.NAA01826@crypt.compulink.co.uk> + Files: sv.c t/op/sprintf.t + +Change 658 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Tiny core patch for source filters", #F025 + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9711202312.AA02937@claudius.bfsec.bt.co.uk> + Files: toke.c + +Change 657 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Here-doc in s///e (was: Bug)", #F024 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199711221445.OAA14153@crypt.compulink.co.uk> + Files: t/base/lex.t toke.c + +Change 656 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix duplicate warnings on C<-e undef>", #F023 + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Msg-ID: <199711221252.MAA14000@crypt.compulink.co.uk> + Files: doio.c t/pragma/warn-1global + +Change 655 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix '*' prototype", #F022 + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199711212225.RAA00755@monk.mps.ohio-state.edu> + Files: toke.c + +Change 654 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "File::Find bugs (and patches)", "File::Find bugs & patches", #F021 + From: "Conrad E. Kimball" <cek@tblv021.ca.boeing.com> + Msg-ID: <199711260703.XAA21257@mailgate2.boeing.com> + Files: lib/File/Find.pm + +Change 653 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix typo: FORM{,AT}LINE", #F020 + From: Chip Salzenberg + Files: sv.c + +Change 652 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix use of unref mem when blessed object goes out of scope", #F019 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199711282326.SAA15090@aatma.engin.umich.edu> + Files: scope.c + +Change 651 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C<my ($a, undef, $b) = @x>", #F018 + From: Stephane Payrard <stef@francenet.fr> + Msg-ID: <199712040054.BAA04612@www.zweig.com> + Files: op.c t/op/my.t + +Change 650 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "enhanced "use strict" warning", #F017 + From: Tkil <tkil@reptile.scrye.com> + Msg-ID: <199712040938.CAA07628@reptile.scrye.com> + Files: gv.c t/pragma/strict-subs t/pragma/strict-vars + +Change 649 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "eval of sub gives spurious "uninitialised" warning", #F016 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199712061025.FAA14396@aatma.engin.umich.edu> + Files: pod/perldelta.pod pod/perlfunc.pod op.c t/op/eval.t + +Change 648 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Assigning result of pop scrambles unrelated reference", #F015 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199712061100.GAA14864@aatma.engin.umich.edu> + Files: sv.c + +Change 647 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Filedescriptor leak in 5.004_55 (and earlier)", #F014 + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199712151922.OAA06410@monk.mps.ohio-state.edu> + Files: os2/os2.c util.c + +Change 646 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix fdopen() on STD{IN,OUT,ERR}", #F013 + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <pzg1npp6e3.fsf@eeyore.ibcinc.com> + Files: doio.c t/op/misc.t + +Change 645 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix local $a[0] and local $h{a}", #F012 + From: Stephen McCamant <alias@mcs.com> + Msg-ID: <m0xjWFq-000EZeC@alias-2.pr.mcs.net> + Files: embed.h scope.h global.sym pp.c pp_hot.c scope.c t/op/local.t + +Change 644 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate redundant mg_get() in SvTRUE()", #F011 + From: Spider Boardman <spider@orb.nashua.nh.us> + Msg-ID: <199712251839.NAA14800@Orb.Nashua.NH.US> + Files: sv.c + +Change 643 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't force scalar context on C<my @x> or C<my %x>", #F010 + From: Chip Salzenberg + Files: op.c t/op/my.t + +Change 642 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix assignment to $_[0] in DESTROY", #F009 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199801010030.TAA14274@aatma.engin.umich.edu> + Files: pod/perlobj.pod sv.c t/op/ref.t + +Change 627 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix inefficient checks for TIEHANDLE", #F008 + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199801080106.UAA05048@aatma.engin.umich.edu> + Files: pp_hot.c pp_sys.c + +Change 626 on 1998/03/02 by TimBunce@ig.co.uk + + This is the change description for change 625 + Title: "Fix tr///s option", #F007 + From: Inaba Hiroto <inaba@st.rim.or.jp> + Msg-ID: <19980110155333D.inaba@st.rim.or.jp> + Files: doop.c + +Change 625 on 1998/03/02 by TimBunce@ig.co.uk + + +Change 624 on 1998/03/02 by TimBunce@ig.co.uk *pending* + + +Change 623 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix lexical lookup in eval-sub-eval", #F006 + From: Chip Salzenberg + Files: pp_ctl.c + +Change 622 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Don't upgrade target of assignment from LVALUE", #F005 + From: Chip Salzenberg + Files: sv.c + +Change 621 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix compile-time warning line in while ()", #F004 + From: Chip Salzenberg + Files: op.c + +Change 620 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "STMT foreach LIST;", #F002 + From: Chip Salzenberg + Files: pod/perlsyn.pod perly.c perly.c.diff perly.y t/cmd/mod.t toke.c + vms/perly_c.vms + +Change 619 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix SIGSEGV on C<42 until forever>", #F001 + From: Chip Salzenberg + Files: op.c + +---------------- Version 5.004_04 Maintenance release 4 for 5.004 ---------------- @@ -27,7 +27,7 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if defined(WIN32) && !defined(__GNUC__) +# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT @@ -125,7 +125,7 @@ L<"Site-wide Policy settings"> below. Configure will figure out various things about your system. Some things Configure will figure out for itself, other things it will ask you about. To accept the default, just press RETURN. The default -is almost always ok. At any Configure prompt, you can type &-d +is almost always okay. At any Configure prompt, you can type &-d and Configure will use the defaults from then on. After it runs, Configure will perform variable substitution on all the @@ -162,6 +162,14 @@ NOTE: You must not specify an installation directory that is below your perl source directory. If you do, installperl will attempt infinite recursion. +It may seem obvious to say, but Perl is useful only when users can +easily find it. When possible, it's good for both /usr/bin/perl and +/usr/local/bin/perl to be symlinks to the actual binary. If that can't +be done, system administrators are strongly encouraged to put +(symlinks to) perl and its accompanying utilities, such as perldoc, +into a directory typically found along a user's PATH, or in another +obvious and convenient place. + By default, Configure will compile perl to use dynamic loading if your system supports it. If you want to force perl to be compiled statically, you can either choose this when Configure prompts you or @@ -759,7 +767,7 @@ you probably want to do This will do two independent things: First, it will force compilation to use cc -g so that you can use your system's debugger on the executable. (Note: Your system may actually require something like -cc -g2. Check you man pages for cc(1) and also any hint file for your +cc -g2. Check your man pages for cc(1) and also any hint file for your system.) Second, it will add -DDEBUGGING to your ccflags variable in config.sh so that you can use B<perl -D> to access perl's internal state. (Note: Configure will only add -DDEBUGGING by @@ -172,7 +172,7 @@ ext/DB_File/DB_File.xs Berkeley DB extension external subroutines ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/typemap Berkeley DB extension interface types -ext/DynaLoader/DynaLoader.pm Dynamic Loader perl module +ext/DynaLoader/DynaLoader.pm.PL Dynamic Loader perl module ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer ext/DynaLoader/README Dynamic Loader notes and intro ext/DynaLoader/dl_aix.xs AIX implementation @@ -366,6 +366,7 @@ hints/newsos4.sh Hints for named architecture hints/next_3.sh Hints for named architecture hints/next_3_0.sh Hints for named architecture hints/next_4.sh Hints for named architecture +hints/openbsd.sh Hints for named architecture hints/opus.sh Hints for named architecture hints/os2.sh Hints for named architecture hints/os390.sh Hints for named architecture @@ -825,6 +826,7 @@ t/op/closure.t See if closures work t/op/cmp.t See if the various string and numeric compare work t/op/cond.t See if conditional expressions work t/op/delete.t See if delete works +t/op/die_exit.t See if die and exit status interaction works t/op/do.t See if subroutines work t/op/each.t See if hash iterators work t/op/eval.t See if eval operator works @@ -840,6 +842,8 @@ t/op/hashwarn.t See if warnings for bad hash assignments work t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works +t/op/ipcmsg.t See if msg* ops work +t/op/ipcsem.t See if sem* ops work t/op/join.t See if join works t/op/list.t See if array lists work t/op/local.t See if local works @@ -853,6 +857,7 @@ t/op/oct.t See if oct and hex work t/op/ord.t See if ord works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work +t/op/pos.t See if pos works t/op/push.t See if push and pop work t/op/quotemeta.t See if quotemeta works t/op/rand.t See if rand works @@ -958,7 +963,7 @@ win32/bin/search.pl Win32 port win32/bin/webget.pl Win32 port win32/bin/www.pl Win32 port win32/config.bc Win32 base line config.sh (Borland C++ build) -win32/config.gc Win32 base line config.sh (GNU build)? +win32/config.gc Win32 base line config.sh (mingw32/gcc build) win32/config.vc Win32 base line config.sh (Visual C++ build) win32/config_H.bc Win32 config header (Borland C++ build) win32/config_H.gc Win32 config header (GNU build)? diff --git a/Porting/patchls b/Porting/patchls index 1d4bd5ac40..5b958323d2 100644 --- a/Porting/patchls +++ b/Porting/patchls @@ -17,10 +17,10 @@ use Text::Tabs qw(expand unexpand); use strict; use vars qw($VERSION); -$VERSION = 2.04; +$VERSION = 2.05; sub usage { -die q{ +die qq{ patchls [options] patchfile [ ... ] -h no filename headers (like grep), only the listing. @@ -31,12 +31,17 @@ die q{ -p N strip N levels of directory Prefix (like patch), else automatic. -v more verbose (-d for noisy debugging). -f F only list patches which patch files matching regexp F - (F has $ appended unless it contains a /). + (F has \$ appended unless it contains a /). + -e Expect patched files to Exist (relative to current directory) + Will print warnings for files which don't. Also affects -4 option. other options for special uses: -I just gather and display summary Information about the patches. -4 write to stdout the PerForce commands to prepare for patching. + -5 like -4 but add "|| exit 1" after each command -M T Like -m but only output listed meta tags (eg -M 'Title From') -W N set wrap width to N (defaults to 70, use 0 for no wrap) + + patchls version $VERSION by Tim Bunce } } @@ -49,21 +54,25 @@ $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; $::opt_f = ''; +$::opt_e = 0; # special purpose options $::opt_I = 0; $::opt_4 = 0; # output PerForce commands to prepare for patching +$::opt_5 = 0; $::opt_M = ''; # like -m but only output these meta items (-M Title) $::opt_W = 70; # set wrap width columns (see Text::Wrap module) +$::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented usage unless @ARGV; -getopts("mihlvc4p:f:IM:W:") or usage; +getopts("mihlvecC45p:f:IM:W:") or usage; $columns = $::opt_W || 9999999; $::opt_m = 1 if $::opt_M; -my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); +$::opt_4 = 1 if $::opt_5; +my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); # see get_meta_info() my %cat_title = ( 'BUILD' => 'BUILD PROCESS', @@ -77,7 +86,17 @@ my %cat_title = ( 'OTHER' => 'OTHER CHANGES', ); -my %ls; + +sub get_meta_info { + my $ls = shift; + local($_) = shift; + $ls->{From}{$1}=1 if /^From:\s+(.*\S)/i; + $ls->{Title}{$1}=1 if /^Subject:\s+(?:Re: )?(.*\S)/i; + $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i; + $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i; + $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/; +} + # Style 1: # *** perl-5.004/embed.h Sat May 10 03:39:32 1997 @@ -97,10 +116,14 @@ my %ls; # Variation: # Index: embed.h -my($in, $prevline, $prevtype, $ls); -my(@removed, @added); +my %ls; + +my ($in, $prevline, $ls); +my $prevtype = ''; +my (@removed, @added); my $prologue = 1; # assume prologue till patch or /^exit\b/ seen + foreach my $argv (@ARGV) { $in = $argv; unless (open F, "<$in") { @@ -119,12 +142,7 @@ foreach my $argv (@ARGV) { push @removed, $1 if /^rm\s+(?:-f)?\s*(\S+)/; $prologue = 0 if /^exit\b/; } - next unless $::opt_m; - $ls->{From}{$1}=1,next if /^From:\s+(.*\S)/i; - $ls->{Title}{$1}=1,next if /^Subject:\s+(?:Re: )?(.*\S)/i; - $ls->{'Msg-ID'}{$1}=1,next if /^Message-Id:\s+(.*\S)/i; - $ls->{Date}{$1}=1,next if /^Date:\s+(.*\S)/i; - $ls->{$1}{$2}=1,next if /^([-\w]+):\s+(.*\S)/; + get_meta_info($ls, $_) if $::opt_m; next; } $type = $1; @@ -155,6 +173,25 @@ foreach my $argv (@ARGV) { $prevtype = $type; $type = ''; } + + # special mode for patch sets from Chip + if ($::opt_C && $in =~ m:[\\/]patch$:) { + my $chip; + my $dir; ($dir = $in) =~ s:[\\/]patch$::; + if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) { + get_meta_info($ls, $_) while (<CHIP>); + } + if (open CHIP,"<$dir/from") { + chop($chip = <CHIP>); + $ls->{From} = { $chip => 1 }; + } + if (open CHIP,"<$dir/tag") { + chop($chip = <CHIP>); + $ls->{Title} = { $chip => 1 }; + } + $ls->{From} = { "Chip Salzenberg" => 1 } unless $ls->{From}; + } + # if we don't have a title for -m then use the file name $ls->{Title}{$in}=1 if $::opt_m and !$ls->{Title} and $ls->{out}; @@ -190,14 +227,18 @@ if ($::opt_f) { # filter out patches based on -f <regexp> # --- Handle special modes --- if ($::opt_4) { - print map { "p4 delete $_\n" } @removed if @removed; - print map { "p4 add $_\n" } @added if @added; + my $tail = ($::opt_5) ? "|| exit 1" : ""; + print map { "p4 delete $_$tail\n" } @removed if @removed; + print map { "p4 add $_$tail\n" } @added if @added; my @patches = grep { $_->{is_in} } @ls; my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches; delete @patched{@added}; my @patched = sort keys %patched; - print map { "p4 edit $_\n" } @patched if @patched; - exit 0; + print map { + my $edit = ($::opt_e && !-f $_) ? "add " : "edit"; + "p4 $edit $_$tail\n" + } @patched if @patched; + exit 0 unless $::opt_C; } if ($::opt_I) { @@ -267,6 +308,8 @@ sub add_file { $ls->{out}->{$out} = 1; + warn "$out patched but not present\n" if $::opt_e && !-f $out; + # do the -i inverse as well, even if we're not doing -i my $i = $ls{$out} ||= { is_out => 1, @@ -308,7 +351,8 @@ sub list_files_by_patch { my @list = sort keys %{$ls->{$meta}}; push @meta, sprintf "%7s: ", $meta; if ($meta eq 'Title') { - @list = map { s/\[?PATCH\]?:?\s*//g; "\"$_\""; } @list + @list = map { s/\[?(PATCH|PERL)\]?:?\s*//g; "\"$_\""; } @list; + push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:; } elsif ($meta eq 'From') { # fix-up bizzare addresses from japan and ibm :-) @@ -329,7 +373,7 @@ sub list_files_by_patch { } # don't print the header unless the file contains something interesting return if !@meta and !$ls->{out}; - print("$ls->{in}\n"),return if $::opt_l; # -l = no listing + print("$ls->{in}\n"),return if $::opt_l; # -l = no listing, just names # a twisty maze of little options my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; @@ -76,11 +76,10 @@ or if you have any problems building.) 2) Read the manual entries before running perl. 3) IMPORTANT! Help save the world! Communicate any problems and suggested -patches to me, larry@wall.org (Larry Wall), so we can -keep the world in sync. If you have a problem, there's someone else -out there who either has had or will have the same problem. -It's usually helpful if you send the output of the "myconfig" script -in the main perl directory. +patches to perlbug@perl.com so we can keep the world in sync. +If you have a problem, there's someone else out there who either has had +or will have the same problem. It's usually helpful if you send the +output of the "myconfig" script in the main perl directory. If you've succeeded in compiling perl, the perlbug script in the utils/ subdirectory can be used to help mail in a bug report. diff --git a/README.os2 b/README.os2 index 667423c382..903702aa0d 100644 --- a/README.os2 +++ b/README.os2 @@ -308,7 +308,31 @@ L<"Frequently asked questions">), and perl should be able to find it The only cases when the shell is not used is the multi-argument system() (see L<perlfunc/system>)/exec() (see L<perlfunc/exec>), and one-argument version thereof without redirection and shell -meta-characters. +meta-characters. Perl may also start scripts which start with cookies +C<extproc> or C<#!> directly, without an intervention of shell. + +If starting scripts directly, Perl will use exactly the same algorithm as for +the search of script given by B<-S> command-line option: it will look in +the current directory, then on components of C<$ENV{PATH}> using the +following order of appended extensions: no extension, F<.cmd>, F<.btm>, +F<.bat>, F<.pl>. + +Note that Perl will start to look for scripts only if OS/2 cannot start the +specified application, thus C<system 'blah'> will not look for a script if +there is an executable file F<blah.exe> I<anywhere> on C<PATH>. + +Note also that executable files on OS/2 can have an arbitrary extension, +but F<.exe> will be automatically appended if no dot is present in the name. +The workaround as as simple as that: since F<blah.> and F<blah> denote the +same file, to start an executable residing in file F<n:/bin/blah> (no +extension) give an argument C<n:/bin/blah.> to system(). + +The last note is that currently it is not straightforward to start PM +programs from VIO (=text-mode) Perl process and visa versa. Either ensure +that shell will be used, as in C<system 'cmd /c epm'>, or start it using +optional arguments to system() documented in C<OS2::Process> module. This +is considered a bug and should be fixed soon. + =head1 Frequently asked questions @@ -780,6 +804,10 @@ F<POSIX.c>. =head2 Testing +If you haven't yet moved perl.dll onto LIBPATH, do it now(alternatively, if +you have a previous perl installation you'd rather not disrupt until this one +is installed, copy perl.dll to the t directory). + Now run make test @@ -911,6 +939,8 @@ to 1. =head2 Installing the built perl +If you haven't yet moved perl.dll onto LIBPATH, do it now. + Run make install diff --git a/README.vms b/README.vms index 40de6acac7..21efaa0459 100644 --- a/README.vms +++ b/README.vms @@ -203,6 +203,8 @@ your DCL$PATH (if you're using VMS 6.2 or higher). 6) Optionally define the command PERLDOC as PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T +Note that if you wish to use most as a pager please see +ftp://space.mit.edu/pub/davis/ for both most and slang. 7) Optionally define the command PERLBUG (the Perl bug report generator) as PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM" @@ -214,6 +216,13 @@ module builds) as DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN +8) Optionally define the command POD2MAN (Converts POD files to nroff +source suitable for converting to man pages. Also quiets complaints during +module builds) as + +DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM +POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN + * Installing Perl into DCLTABLES Courtesy of Brad Hughes: @@ -285,6 +285,7 @@ struct context { #define G_EVAL 4 /* Assume eval {} around subroutine call. */ #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ +#define G_NODEBUG 32 /* Disable debugging at toplevel. */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. @@ -297,10 +298,8 @@ struct context { #define SI_SIGNAL 4 #define SI_OVERLOAD 5 #define SI_DESTROY 6 -/* XXX todo #define SI_WARNHOOK 7 #define SI_DIEHOOK 8 -*/ struct stackinfo { AV * si_stack; /* stack for current runlevel */ @@ -357,6 +356,8 @@ typedef struct stackinfo PERL_SI; #define POPSTACK_TO(s) \ STMT_START { \ - while (curstack != s) \ + while (curstack != s) { \ + dounwind(-1); \ POPSTACK(); \ + } \ } STMT_END @@ -583,6 +583,7 @@ do_close(GV *gv, bool not_implicit) if (!io) { /* never opened */ if (dowarn && not_implicit) warn("Close on unopened file <%s>",GvENAME(gv)); + SETERRNO(EBADF,SS$_IVCHAN); return FALSE; } retval = io_close(io); @@ -619,6 +620,9 @@ io_close(IO *io) } IoOFP(io) = IoIFP(io) = Nullfp; } + else { + SETERRNO(EBADF,SS$_IVCHAN); + } return retval; } @@ -1033,9 +1037,14 @@ apply(I32 type, register SV **mark, register SV **sp) register I32 val; register I32 val2; register I32 tot = 0; + char *what; char *s; SV **oldmark = mark; +#define APPLY_TAINT_PROPER() \ + if (!(tainting && tainted)) {} else { goto taint_proper; } + + /* This is a first heuristic; it doesn't catch tainting magic. */ if (tainting) { while (++mark <= sp) { if (SvTAINTED(*mark)) { @@ -1047,25 +1056,33 @@ apply(I32 type, register SV **mark, register SV **sp) } switch (type) { case OP_CHMOD: - TAINT_PROPER("chmod"); + what = "chmod"; + APPLY_TAINT_PROPER(); if (++mark <= sp) { - tot = sp - mark; val = SvIVx(*mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; while (++mark <= sp) { - if (PerlLIO_chmod(SvPVx(*mark, na),val)) + char *name = SvPVx(*mark, na); + APPLY_TAINT_PROPER(); + if (PerlLIO_chmod(name, val)) tot--; } } break; #ifdef HAS_CHOWN case OP_CHOWN: - TAINT_PROPER("chown"); + what = "chown"; + APPLY_TAINT_PROPER(); if (sp - mark > 2) { val = SvIVx(*++mark); val2 = SvIVx(*++mark); + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - if (chown(SvPVx(*mark, na),val,val2)) + char *name = SvPVx(*mark, na); + APPLY_TAINT_PROPER(); + if (chown(name, val, val2)) tot--; } } @@ -1073,11 +1090,11 @@ apply(I32 type, register SV **mark, register SV **sp) #endif #ifdef HAS_KILL case OP_KILL: - TAINT_PROPER("kill"); + what = "kill"; + APPLY_TAINT_PROPER(); if (mark == sp) break; s = SvPVx(*++mark, na); - tot = sp - mark; if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; @@ -1086,6 +1103,8 @@ apply(I32 type, register SV **mark, register SV **sp) } else val = SvIVx(*mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; #ifdef VMS /* kill() doesn't do process groups (job trees?) under VMS */ if (val < 0) val = -val; @@ -1098,6 +1117,7 @@ apply(I32 type, register SV **mark, register SV **sp) while (++mark <= sp) { I32 proc = SvIVx(*mark); register unsigned long int __vmssts; + APPLY_TAINT_PROPER(); if (!((__vmssts = sys$delprc(&proc,0)) & 1)) { tot--; switch (__vmssts) { @@ -1120,6 +1140,7 @@ apply(I32 type, register SV **mark, register SV **sp) val = -val; while (++mark <= sp) { I32 proc = SvIVx(*mark); + APPLY_TAINT_PROPER(); #ifdef HAS_KILLPG if (PerlProc_killpg(proc,val)) /* BSD */ #else @@ -1130,17 +1151,21 @@ apply(I32 type, register SV **mark, register SV **sp) } else { while (++mark <= sp) { - if (PerlProc_kill(SvIVx(*mark),val)) + I32 proc = SvIVx(*mark); + APPLY_TAINT_PROPER(); + if (PerlProc_kill(proc, val)) tot--; } } break; #endif case OP_UNLINK: - TAINT_PROPER("unlink"); + what = "unlink"; + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { s = SvPVx(*mark, na); + APPLY_TAINT_PROPER(); if (euid || unsafe) { if (UNLINK(s)) tot--; @@ -1161,7 +1186,8 @@ apply(I32 type, register SV **mark, register SV **sp) break; #ifdef HAS_UTIME case OP_UTIME: - TAINT_PROPER("utime"); + what = "utime"; + APPLY_TAINT_PROPER(); if (sp - mark > 2) { #if defined(I_UTIME) || defined(VMS) struct utimbuf utbuf; @@ -1180,9 +1206,12 @@ apply(I32 type, register SV **mark, register SV **sp) utbuf.actime = SvIVx(*++mark); /* time accessed */ utbuf.modtime = SvIVx(*++mark); /* time modified */ #endif + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - if (PerlLIO_utime(SvPVx(*mark, na),&utbuf)) + char *name = SvPVx(*mark, na); + APPLY_TAINT_PROPER(); + if (PerlLIO_utime(name, &utbuf)) tot--; } } @@ -1192,6 +1221,12 @@ apply(I32 type, register SV **mark, register SV **sp) #endif } return tot; + + taint_proper: + TAINT_PROPER(what); + return 0; /* this should never happen */ + +#undef APPLY_TAINT_PROPER } /* Do the permissions allow some operation? Assumes statcache already set. */ @@ -1305,6 +1340,18 @@ do_ipcget(I32 optype, SV **mark, SV **sp) return -1; /* should never happen */ } +#if defined(__sun) && defined(__svr4__) /* XXX Need metaconfig test */ +/* Solaris manpage says that it uses (like linux) + int semctl (int semid, int semnum, int cmd, union semun arg) + but the system include files do not define union semun !!!! +*/ +union semun { + int val; + struct semid_ds *buf; + ushort *array; +}; +#endif + I32 do_ipcctl(I32 optype, SV **mark, SV **sp) { @@ -1313,7 +1360,8 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; -#ifdef __linux__ /* XXX Need metaconfig test */ +#if defined(__linux__) || (defined(__sun) && defined(__svr4__)) +/* XXX Need metaconfig test */ union semun unsemds; #endif @@ -1345,8 +1393,9 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) else if (cmd == GETALL || cmd == SETALL) { struct semid_ds semds; -#ifdef __linux__ /* XXX Need metaconfig test */ -/* linux (and Solaris2?) uses : +#if defined(__linux__) || (defined(__sun) && defined(__svr4__)) + /* XXX Need metaconfig test */ +/* linux and Solaris2 uses : int semctl (int semid, int semnum, int cmd, union semun arg) union semun { int val; @@ -1405,7 +1454,8 @@ do_ipcctl(I32 optype, SV **mark, SV **sp) #endif #ifdef HAS_SEM case OP_SEMCTL: -#ifdef __linux__ /* XXX Need metaconfig test */ +#if defined(__linux__) || (defined(__sun) && defined(__svr4__)) + /* XXX Need metaconfig test */ unsemds.buf = (struct semid_ds *)a; ret = semctl(id, n, cmd, unsemds); #else diff --git a/embedvar.h b/embedvar.h index 667edab2fd..11ccca23af 100644 --- a/embedvar.h +++ b/embedvar.h @@ -115,6 +115,8 @@ #define errgv (curinterp->Ierrgv) #define eval_root (curinterp->Ieval_root) #define eval_start (curinterp->Ieval_start) +#define exitlist (curinterp->Iexitlist) +#define exitlistlen (curinterp->Iexitlistlen) #define fdpid (curinterp->Ifdpid) #define filemode (curinterp->Ifilemode) #define firstgv (curinterp->Ifirstgv) @@ -125,6 +127,7 @@ #define incgv (curinterp->Iincgv) #define initav (curinterp->Iinitav) #define inplace (curinterp->Iinplace) +#define sys_intern (curinterp->Isys_intern) #define lastfd (curinterp->Ilastfd) #define lastscream (curinterp->Ilastscream) #define lastsize (curinterp->Ilastsize) @@ -146,6 +149,7 @@ #define minus_l (curinterp->Iminus_l) #define minus_n (curinterp->Iminus_n) #define minus_p (curinterp->Iminus_p) +#define modglobal (curinterp->Imodglobal) #define multiline (curinterp->Imultiline) #define mystrk (curinterp->Imystrk) #define ofmt (curinterp->Iofmt) @@ -231,6 +235,8 @@ #define Ierrgv errgv #define Ieval_root eval_root #define Ieval_start eval_start +#define Iexitlist exitlist +#define Iexitlistlen exitlistlen #define Ifdpid fdpid #define Ifilemode filemode #define Ifirstgv firstgv @@ -241,6 +247,7 @@ #define Iincgv incgv #define Iinitav initav #define Iinplace inplace +#define Isys_intern sys_intern #define Ilastfd lastfd #define Ilastscream lastscream #define Ilastsize lastsize @@ -262,6 +269,7 @@ #define Iminus_l minus_l #define Iminus_n minus_n #define Iminus_p minus_p +#define Imodglobal modglobal #define Imultiline multiline #define Imystrk mystrk #define Iofmt ofmt @@ -408,6 +416,8 @@ #define errgv Perl_errgv #define eval_root Perl_eval_root #define eval_start Perl_eval_start +#define exitlist Perl_exitlist +#define exitlistlen Perl_exitlistlen #define fdpid Perl_fdpid #define filemode Perl_filemode #define firstgv Perl_firstgv @@ -418,6 +428,7 @@ #define incgv Perl_incgv #define initav Perl_initav #define inplace Perl_inplace +#define sys_intern Perl_sys_intern #define lastfd Perl_lastfd #define lastscream Perl_lastscream #define lastsize Perl_lastsize @@ -439,6 +450,7 @@ #define minus_l Perl_minus_l #define minus_n Perl_minus_n #define minus_p Perl_minus_p +#define modglobal Perl_modglobal #define multiline Perl_multiline #define mystrk Perl_mystrk #define ofmt Perl_ofmt diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm.PL index 712d575e38..4c4155985d 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm.PL @@ -1,3 +1,19 @@ + +use Config; + +sub to_string { + my ($value) = @_; + $value =~ s/\\/\\\\'/g; + $value =~ s/'/\\'/g; + return "'$value'"; +} + +unlink "DynaLoader.pm" if -f "DynaLoader.pm"; +open OUT, ">DynaLoader.pm" or die $!; +print OUT <<'EOT'; + +# Generated from DynaLoader.pm.PL (resolved %Config::Config values) + package DynaLoader; # And Gandalf said: 'Many folk like to know beforehand what is to @@ -14,8 +30,6 @@ package DynaLoader; $VERSION = $VERSION = "1.03"; # avoid typo warning -require Config; - require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; @@ -43,10 +57,15 @@ $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; sub dl_load_flags { 0x00 } -# +# ($dl_dlext, $dlsrc) +# = @Config::Config{'dlext', 'dlsrc'}; +EOT + +print OUT " (\$dl_dlext, \$dlsrc) = (", + to_string($Config::Config{'dlext'}), ",", + to_string($Config::Config{'dlsrc'}), ")\n;" ; -($dl_dlext, $dlsrc) - = @Config::Config{'dlext', 'dlsrc'}; +print OUT <<'EOT'; # Some systems need special handling to expand file specifications # (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>) @@ -65,7 +84,14 @@ $do_expand = $Is_VMS = $^O eq 'VMS'; # Initialise @dl_library_path with the 'standard' library path # for this platform as determined by Configure -push(@dl_library_path, split(' ',$Config::Config{'libpth'})); + +# push(@dl_library_path, split(' ', $Config::Config{'libpth'}); +EOT + +print OUT "push(\@dl_library_path, split(' ', ", + to_string($Config::Config{'libpth'}), "));\n"; + +print OUT <<'EOT'; # Add to @dl_library_path any extra directories we can gather from # environment variables. So far LD_LIBRARY_PATH is the only known @@ -205,8 +231,14 @@ sub dl_findfile { my (@args) = @_; my (@dirs, $dir); # which directories to search my (@found); # full paths to real files we have found - my $dl_ext= $Config::Config{'dlext'}; # suffix for perl extensions - my $dl_so = $Config::Config{'so'}; # suffix for shared libraries +EOT + +print OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) . + "; # \$Config::Config{'dlext'} suffix for perl extensions\n"; +print OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) . + "; # \$Config::Config{'so'} suffix for shared libraries\n"; + +print OUT <<'EOT'; print STDERR "dl_findfile(@args)\n" if $dl_debug; @@ -350,7 +382,7 @@ etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime). It must be stressed that the DynaLoader, by itself, is practically useless for accessing non-Perl libraries because it provides almost no Perl-to-C 'glue'. There is, for example, no mechanism for calling a C -library function or supplying arguments. A ExtUtils::DynaLib module +library function or supplying arguments. A C::DynaLib module is available from CPAN sites which performs that function for some common system types. @@ -691,3 +723,7 @@ Solaris global loading added by Nick Ing-Simmons with design/coding assistance from Tim Bunce, January 1996. =cut +EOT + +close OUT or die $!; + diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index 9323935880..2c86abfc41 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -7,11 +7,12 @@ WriteMakefile( MAN3PODS => ' ', # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? - VERSION_FROM => 'DynaLoader.pm', - clean => {FILES => 'DynaLoader.c DynaLoader.xs'}, + VERSION_FROM => 'DynaLoader.pm.PL', + PL_FILES => {'DynaLoader.pm.PL'=>'DynaLoader.pm'}, + PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'}, + clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, ); - sub MY::postamble { ' DynaLoader.xs: $(DLSRC) diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 51d464e6de..a82e0eac11 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -65,6 +65,9 @@ dl_load_file(filename, flags=0) * unresolved references in situations like this. */ /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ } + /* BIND_NOSTART removed from bind_type because it causes the shared library's */ + /* initialisers not to be run. This causes problems with all of the static objects */ + /* in the library. */ #ifdef DEBUGGING if (dl_debug) bind_type |= BIND_VERBOSE; @@ -74,14 +77,14 @@ dl_load_file(filename, flags=0) for (i = 0; i <= max; i++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym)); - obj = shl_load(sym, bind_type | BIND_NOSTART, 0L); + obj = shl_load(sym, bind_type, 0L); if (obj == NULL) { goto end; } } DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename)); - obj = shl_load(filename, bind_type | BIND_NOSTART, 0L); + obj = shl_load(filename, bind_type, 0L); DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj)); end: diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 74de3dfc65..ab19670af7 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -76,9 +76,8 @@ $VERSION = "1.03"; ); sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - my $val = constant($constname, (@_ && (caller(0))[4]) ? $_[0] : 0); + (my $constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; @@ -90,7 +89,7 @@ sub AUTOLOAD { "; } } - eval "sub $AUTOLOAD { $val }"; + *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 9c7ae066b7..09df4373fb 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -7,7 +7,7 @@ GDBM_File - Perl5 access to the gdbm library. =head1 SYNOPSIS use GDBM_File ; - tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640); + tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640; # Use the %hash array. untie %hash ; diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index 3359d1742c..bc1dda9387 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', - LIBS => ["-lm -lposix -lcposix"], + ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 33dc73d8f2..32010d62e0 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -827,7 +827,14 @@ sub fork { sub getcwd { usage "getcwd()" if @_ != 0; - chop($cwd = `pwd`); + if ($^O eq 'MSWin32') { + # this perhaps applies to everyone else also? + require Cwd; + $cwd = &Cwd::cwd; + } + else { + chop($cwd = `pwd`); + } $cwd; } diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 922438dca5..1dba9a61f8 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1,3 +1,6 @@ +#ifdef WIN32 +#define _POSIX_ +#endif #include "EXTERN.h" #define PERLIO_NOT_STDIO 1 #include "perl.h" @@ -40,7 +43,9 @@ #include <sys/stat.h> #include <sys/types.h> #include <time.h> +#ifdef I_UNISTD #include <unistd.h> /* see hints/sunos_4_1.sh */ +#endif #include <fcntl.h> #if defined(__VMS) && !defined(__POSIX_SOURCE) @@ -91,6 +96,28 @@ } # define times(t) vms_times(t) #else +#if defined (WIN32) +# undef mkfifo /* #defined in perl.h */ +# define mkfifo(a,b) not_here("mkfifo") +# define ttyname(a) not_here("ttyname") +# define sigset_t long +# define pid_t long +# ifdef __BORLANDC__ +# define tzname _tzname +# endif +# ifdef _MSC_VER +# define mode_t short +# endif +# define sigaction(a,b,c) not_here("sigaction") +# define sigpending(a) not_here("sigpending") +# define sigprocmask(a,b,c) not_here("sigprocmask") +# define sigsuspend(a) not_here("sigsuspend") +# define sigemptyset(a) not_here("sigemptyset") +# define sigaddset(a,b) not_here("sigaddset") +# define sigdelset(a,b) not_here("sigdelset") +# define sigfillset(a) not_here("sigfillset") +# define sigismember(a,b) not_here("sigismember") +#else # include <grp.h> # include <sys/times.h> # ifdef HAS_UNAME @@ -100,7 +127,8 @@ # ifdef I_UTIME # include <utime.h> # endif -#endif +#endif /* WIN32 */ +#endif /* __VMS */ typedef int SysRet; typedef long SysRetLong; @@ -227,11 +255,13 @@ unsigned long strtoul _((const char *, char **, int)); #define localeconv() not_here("localeconv") #endif +#ifndef WIN32 #ifdef HAS_TZNAME extern char *tzname[]; #else char *tzname[] = { "" , "" }; #endif +#endif /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) * fields for which we don't have Configure support yet: @@ -2259,55 +2289,55 @@ constant(char *name, int arg) case '_': if (strnEQ(name, "_PC_", 4)) { if (strEQ(name, "_PC_CHOWN_RESTRICTED")) -#ifdef _PC_CHOWN_RESTRICTED +#if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST return _PC_CHOWN_RESTRICTED; #else goto not_there; #endif if (strEQ(name, "_PC_LINK_MAX")) -#ifdef _PC_LINK_MAX +#if defined(_PC_LINK_MAX) || HINT_SC_EXIST return _PC_LINK_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_CANON")) -#ifdef _PC_MAX_CANON +#if defined(_PC_MAX_CANON) || HINT_SC_EXIST return _PC_MAX_CANON; #else goto not_there; #endif if (strEQ(name, "_PC_MAX_INPUT")) -#ifdef _PC_MAX_INPUT +#if defined(_PC_MAX_INPUT) || HINT_SC_EXIST return _PC_MAX_INPUT; #else goto not_there; #endif if (strEQ(name, "_PC_NAME_MAX")) -#ifdef _PC_NAME_MAX +#if defined(_PC_NAME_MAX) || HINT_SC_EXIST return _PC_NAME_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_NO_TRUNC")) -#ifdef _PC_NO_TRUNC +#if defined(_PC_NO_TRUNC) || HINT_SC_EXIST return _PC_NO_TRUNC; #else goto not_there; #endif if (strEQ(name, "_PC_PATH_MAX")) -#ifdef _PC_PATH_MAX +#if defined(_PC_PATH_MAX) || HINT_SC_EXIST return _PC_PATH_MAX; #else goto not_there; #endif if (strEQ(name, "_PC_PIPE_BUF")) -#ifdef _PC_PIPE_BUF +#if defined(_PC_PIPE_BUF) || HINT_SC_EXIST return _PC_PIPE_BUF; #else goto not_there; #endif if (strEQ(name, "_PC_VDISABLE")) -#ifdef _PC_VDISABLE +#if defined(_PC_VDISABLE) || HINT_SC_EXIST return _PC_VDISABLE; #else goto not_there; @@ -2433,61 +2463,61 @@ constant(char *name, int arg) } if (strnEQ(name, "_SC_", 4)) { if (strEQ(name, "_SC_ARG_MAX")) -#ifdef _SC_ARG_MAX +#if defined(_SC_ARG_MAX) || HINT_SC_EXIST return _SC_ARG_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CHILD_MAX")) -#ifdef _SC_CHILD_MAX +#if defined(_SC_CHILD_MAX) || HINT_SC_EXIST return _SC_CHILD_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_CLK_TCK")) -#ifdef _SC_CLK_TCK +#if defined(_SC_CLK_TCK) || HINT_SC_EXIST return _SC_CLK_TCK; #else goto not_there; #endif if (strEQ(name, "_SC_JOB_CONTROL")) -#ifdef _SC_JOB_CONTROL +#if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST return _SC_JOB_CONTROL; #else goto not_there; #endif if (strEQ(name, "_SC_NGROUPS_MAX")) -#ifdef _SC_NGROUPS_MAX +#if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST return _SC_NGROUPS_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_OPEN_MAX")) -#ifdef _SC_OPEN_MAX +#if defined(_SC_OPEN_MAX) || HINT_SC_EXIST return _SC_OPEN_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_SAVED_IDS")) -#ifdef _SC_SAVED_IDS +#if defined(_SC_SAVED_IDS) || HINT_SC_EXIST return _SC_SAVED_IDS; #else goto not_there; #endif if (strEQ(name, "_SC_STREAM_MAX")) -#ifdef _SC_STREAM_MAX +#if defined(_SC_STREAM_MAX) || HINT_SC_EXIST return _SC_STREAM_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_TZNAME_MAX")) -#ifdef _SC_TZNAME_MAX +#if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST return _SC_TZNAME_MAX; #else goto not_there; #endif if (strEQ(name, "_SC_VERSION")) -#ifdef _SC_VERSION +#if defined(_SC_VERSION) || HINT_SC_EXIST return _SC_VERSION; #else goto not_there; @@ -3102,7 +3132,9 @@ sigaction(sig, action, oldaction = 0) POSIX::SigAction action POSIX::SigAction oldaction CODE: - +#ifdef WIN32 + RETVAL = not_here("sigaction"); +#else # This code is really grody because we're trying to make the signal # interface look beautiful, which is hard. @@ -3181,6 +3213,7 @@ sigaction(sig, action, oldaction = 0) sv_setiv(*svp, oact.sa_flags); } } +#endif OUTPUT: RETVAL diff --git a/ext/POSIX/hints/linux.pl b/ext/POSIX/hints/linux.pl index 7994f24023..f1d19814ae 100644 --- a/ext/POSIX/hints/linux.pl +++ b/ext/POSIX/hints/linux.pl @@ -2,4 +2,4 @@ # Thanks to Bart Schuller <schuller@Lunatech.com> # See Message-ID: <19971009002636.50729@tanglefoot> # XXX A Configure test is needed. -$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DHINT_SC_EXIST' ; diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL index 96f5b7af91..6003628247 100644 --- a/ext/SDBM_File/sdbm/Makefile.PL +++ b/ext/SDBM_File/sdbm/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; $define = '-DSDBM -DDUFF'; -$define .= ' -DWIN32' if ($^O eq 'MSWin32'); +$define .= ' -DWIN32 -DPERL_STATIC_SYMS' if ($^O eq 'MSWin32'); if ($^O eq 'VMS') { # Old VAXC compiler can't handle Duff's device require Config; @@ -37,5 +37,11 @@ config :: lint: lint -abchx $(LIBSRCS) + +# This is a workaround, the problem is that our old GNU make exports +# variables into the environment so $(MYEXTLIB) is set in here to this +# value which can not be built. +sdbm/libsdbm.a: + true '; } diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 823e704ed8..09b41d3fce 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -757,7 +757,10 @@ pack_sockaddr_un(pathname) STRLEN len; Zero( &sun_ad, sizeof sun_ad, char ); sun_ad.sun_family = AF_UNIX; - strncpy(sun_ad.sun_path, pathname, sizeof sun_ad.sun_path); + len = strlen(pathname); + if (len > sizeof(sun_ad.sun_path)) + len = sizeof(sun_ad.sun_path); + Copy( pathname, sun_ad.sun_path, len, char ); ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad)); #else ST(0) = (SV *) not_here("pack_sockaddr_un"); diff --git a/global.sym b/global.sym index 43a223ebd7..31a452b76b 100644 --- a/global.sym +++ b/global.sym @@ -24,6 +24,7 @@ dec_amg di div_amg div_ass_amg +do_binmode ds eq_amg exp_amg @@ -308,6 +309,7 @@ fetch_io filter_add filter_del filter_read +find_script find_threadsv fold_constants force_ident diff --git a/hints/aix.sh b/hints/aix.sh index a29466e4f8..21dc888a83 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -66,7 +66,7 @@ case "$osvers" in lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' ;; *) -lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' +lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' ;; esac diff --git a/hints/bsdos.sh b/hints/bsdos.sh index c89a0a9833..0896e264ba 100644 --- a/hints/bsdos.sh +++ b/hints/bsdos.sh @@ -3,7 +3,7 @@ # hints file for BSD/OS (adapted from bsd386.sh) # Original by Neil Bowers <neilb@khoros.unm.edu>; Tue Oct 4 12:01:34 EDT 1994 # Updated by Tony Sanders <sanders@bsdi.com>; Sat Aug 23 12:47:45 MDT 1997 -# Added 3.1 with ELF dynamic libraries +# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0) # SYSV IPC tested Ok so I re-enabled. # # To override the compiler on the command line: @@ -33,6 +33,9 @@ libswanted="$*" glibpth="$glibpth /usr/X11/lib" ldflags="$ldflags -L/usr/X11/lib" +# Avoid telldir prototype conflict in pp_sys.c +pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' + case "$optimize" in '') optimize='-O2' ;; esac @@ -85,4 +88,22 @@ case "$osvers" in libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" libswanted="rpc curses termcap $libswanted" ;; +4.0*) + # ELF dynamic link libraries starting in 4.0 (???) + useshrplib='true' + so='so' + dlext='so' + + case "$cc" in + '') cc='cc' # cc is gcc2 in 4.0 + cccdlflags="-fPIC" + ccdlflags=" " ;; + esac + + case "$ld" in + '') ld='ld' + lddlflags="-shared -x $lddlflags" ;; + esac + ;; esac + diff --git a/hints/hpux.sh b/hints/hpux.sh index 9b272aef76..3e727d2d6f 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -43,8 +43,10 @@ # "ext.libs" file which is *probably* messing up the order. Often, # you can replace ext.libs with an empty file to fix the problem. # -# If you get a message about "too much defining", you might have to -# add the following to your ccflags: '-Wp,-H256000' +# If you get a message about "too much defining", as may happen +# in HPUX < 10, you might have to append a single entry to your +# ccflags: '-Wp,-H256000' +# NOTE: This is a single entry (-W takes the argument 'p,-H256000'). #-------------------------------------------------------------------- # Turn on the _HPUX_SOURCE flag to get many of the HP add-ons diff --git a/hints/netbsd.sh b/hints/netbsd.sh index 8bc6c1227b..71d508448a 100644 --- a/hints/netbsd.sh +++ b/hints/netbsd.sh @@ -41,6 +41,14 @@ case "$osvers" in esac ;; esac +# netbsd 1.3 linker warns about setr[gu]id being deprecated. +# (setregid, setreuid, preferred?) +case "$osvers" in +1.3|1.3*) + d_setrgid="$undef" + d_setruid="$undef" + ;; +esac # netbsd had these but they don't really work as advertised, in the # versions listed below. if they are defined, then there isn't a diff --git a/hints/openbsd.sh b/hints/openbsd.sh new file mode 100644 index 0000000000..633ac35d54 --- /dev/null +++ b/hints/openbsd.sh @@ -0,0 +1,54 @@ +# hints/openbsd.sh +# +# hints file for OpenBSD; Todd Miller <millert@openbsd.org> +# Edited to allow Configure command-line overrides by +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# + +# OpenBSD has a better malloc than perl... +test "$usemymalloc" || usemymalloc='n' + +# Currently, vfork(2) is not a real win over fork(2) but this will +# change in a future release. +usevfork='true' + +# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions +# in 4.4BSD. Configure will find these but they are just emulated +# and do not have the same semantics as in 4.3BSD. +d_setregid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' + +# +# Not all platforms support shared libs... +# +case `uname -m` in +alpha|mips|powerpc|vax) + d_dlopen=$undef + ;; +*) + d_dlopen=$define + d_dlerror=$define + # we use -fPIC here because -fpic is *NOT* enough for some of the + # extensions like Tk on some OpenBSD platforms (ie: sparc) + cccdlflags="-DPIC -fPIC $cccdlflags" + lddlflags="-Bforcearchive -Bshareable $lddlflags" + ;; +esac + +# OpenBSD doesn't need libcrypt but many folks keep a stub lib +# around for old NetBSD binaries. +libswanted=`echo $libswanted | sed 's/ crypt / /'` + +# Avoid telldir prototype conflict in pp_sys.c (OpenBSD uses const DIR *) +pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' + +# Configure can't figure this out non-interactively +d_suidsafe='define' + +# cc is gcc so we can do better than -O +# Allow a command-line override, such as -Doptimize=-g +test "$optimize" || optimize='-O2' + +# end diff --git a/hints/os2.sh b/hints/os2.sh index 2293adf446..7a980bddce 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -23,6 +23,14 @@ if test -f $sh.exe; then sh=$sh.exe; fi startsh="#!$sh" cc='gcc' +# Make denser object files and DLL +case "X$optimize" in + X) + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" + ld_dll_optimize="-s" + ;; +esac + # Get some standard things (indented to avoid putting in config.sh): oifs="$IFS" IFS=" ;" @@ -104,11 +112,11 @@ aout_obj_ext='.o' aout_lib_ext='.a' aout_ar='ar' aout_plibext='.a' -aout_lddlflags='-Zdll' +aout_lddlflags="-Zdll $ld_dll_optimize" if [ $emxcrtrev -ge 50 ]; then - aout_ldflags='-Zexe -Zsmall-conv' + aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000' else - aout_ldflags='-Zexe' + aout_ldflags='-Zexe -Zstack 32000' fi # To get into config.sh: @@ -152,7 +160,7 @@ else else d_fork='undef' fi - lddlflags='-Zdll -Zomf -Zmt -Zcrtdll' + lddlflags="-Zdll -Zomf -Zmt -Zcrtdll $ld_dll_optimize" # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then @@ -241,13 +249,6 @@ nm_opt='-p' d_getprior='define' d_setprior='define' -# Make denser object files and DLL -case "X$optimize" in - X) - optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" - ;; -esac - if [ "X$usethreads" = "X$define" ]; then ccflags="-Zmt $ccflags" cppflags="-Zmt $cppflags" # Do we really need to set this? diff --git a/hints/svr4.sh b/hints/svr4.sh index 0a387022a2..2939e4ec1f 100644 --- a/hints/svr4.sh +++ b/hints/svr4.sh @@ -68,12 +68,17 @@ fi # UnixWare has a broken csh. The undocumented -X argument to uname is probably # a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in -# FILE* got renamed! -# +# FILE* got renamed! Plus 1.1 can't cast large floats to 32-bit ints. # Leave leading tabs so Configure doesn't propagate these variables -# to config.sh uw_ver=`uname -v` uw_isuw=`uname -X 2>&1 | grep Release` +if [ "$uw_isuw" = "Release = 4.2" ]; then + case $uw_ver in + 1.1) + d_casti32='undef' + ;; + esac +fi if [ "$uw_isuw" = "Release = 4.2MP" ]; then case $uw_ver in 2.1) @@ -841,7 +841,7 @@ hv_free_ent(HV *hv, register HE *entry) if (!entry) return; val = HeVAL(entry); - if (isGV(val) && GvCVu(val) && HvNAME(hv)) + if (val && isGV(val) && GvCVu(val) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { @@ -966,7 +966,7 @@ hv_iterinit(HV *hv) } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); - return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */ + return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */ } HE * diff --git a/interp.sym b/interp.sym index 3e06da36ed..ce9ca778f0 100644 --- a/interp.sym +++ b/interp.sym @@ -44,6 +44,8 @@ envgv errgv eval_root eval_start +exitlist +exitlistlen fdpid filemode firstgv @@ -56,6 +58,7 @@ in_eval incgv initav inplace +sys_intern last_in_gv lastfd lastscream @@ -80,6 +83,7 @@ minus_c minus_l minus_n minus_p +modglobal multiline mystrk nrs diff --git a/intrpvar.h b/intrpvar.h index 59f7e098db..c1a7b36ff3 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -152,6 +152,15 @@ PERLVAR(Iors, char *) /* $\ */ PERLVAR(Iorslen, STRLEN) PERLVAR(Iofmt, char *) /* $# */ +/* interpreter atexit processing */ +PERLVARI(Iexitlist, PerlExitListEntry *, NULL) /* list of exit functions */ +PERLVARI(Iexitlistlen, I32, 0) /* length of same */ +PERLVAR(Imodglobal, HV *) /* per-interp module data */ + +#ifdef HAVE_INTERP_INTERN +PERLVAR(Isys_intern, struct interp_intern) /* platform internals */ +#endif + #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm index 09ab196254..a39d1ac04a 100644 --- a/lib/Class/Struct.pm +++ b/lib/Class/Struct.pm @@ -180,7 +180,7 @@ sub struct { } elsif( defined $classes{$name} ){ if ( $CHECK_CLASS_MEMBERSHIP ) { - $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$type');\n"; + $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n"; } } $out .= " croak 'Too many args to $name' if \@_ > 1;\n"; diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 652ee7e493..64798da00f 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -20,11 +20,21 @@ getcwd - get pathname of current working directory chdir "/tmp"; print $ENV{'PWD'}; + use Cwd 'abs_path'; + print abs_path($ENV{'PWD'}); + + use Cwd 'fast_abs_path'; + print fast_abs_path($ENV{'PWD'}); + =head1 DESCRIPTION The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions in Perl. +The abs_path() function takes a single argument and returns the +absolute pathname for that argument. It uses the same algoritm as +getcwd(). (actually getcwd() is abs_path(".")) + The fastcwd() function looks the same as getcwd(), but runs faster. It's also more dangerous because it might conceivably chdir() you out of a directory that it can't chdir() you back into. If fastcwd @@ -35,6 +45,9 @@ that it leaves you in the same directory that it started in. If it has changed it will C<die> with the message "Unstable directory path, current directory changed unexpectedly". That should never happen. +The fast_abs_path() function looks the same as abs_path(), but runs faster. +And like fastcwd() is more dangerous. + The cwd() function looks the same as getcwd and fastgetcwd but is implemented using the most natural and safe form for the current architecture. For most systems it is identical to `pwd` (but without diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index 5c35dc7307..ccdffb8eea 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -182,6 +182,9 @@ sub _unix_os2_ext { } sub _win32_ext { + + require Text::ParseWords; + my($self, $potential_libs, $verbose) = @_; # If user did not supply a list, we punt. @@ -206,14 +209,14 @@ sub _win32_ext { # compute $extralibs from $potential_libs my(@searchpath); # from "-L/path" entries in $potential_libs - my(@libpath) = split " ", $libpth; + my(@libpath) = Text::ParseWords::quotewords('\s+', 0, $libpth); my(@extralibs); my($fullname, $thislib, $thispth); my($pwd) = cwd(); # from Cwd.pm my($lib) = ''; my($found) = 0; - foreach $thislib (split ' ', $potential_libs){ + foreach $thislib (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ # Handle possible linker path arguments. if ($thislib =~ s/^-L// and not -d $thislib) { @@ -223,7 +226,7 @@ sub _win32_ext { } elsif (-d $thislib) { unless ($self->file_name_is_absolute($thislib)) { - warn "Warning: -L$thislib changed to -L$pwd/$thislib\n"; + warn "Warning: '-L$thislib' changed to '-L$pwd/$thislib'\n"; $thislib = $self->catdir($pwd,$thislib); } push(@searchpath, $thislib); @@ -253,6 +256,9 @@ sub _win32_ext { unless $found_lib>0; } return ('','','','') unless $found; + + # make sure paths with spaces are properly quoted + @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs; $lib = join(' ',@extralibs); warn "Result: $lib\n" if $verbose; wantarray ? ($lib, '', $lib, '') : $lib; @@ -595,6 +601,17 @@ distinguish between them. LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS and LD_RUN_PATH are always empty (this may change in future). +=item * + +You must make sure that any paths and path components are properly +surrounded with double-quotes if they contain spaces. For example, +C<$potential_libs> could be (literally): + + "-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib" + +Note how the first and last entries are protected by quotes in order +to protect the spaces. + =back diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm index 44daa525fd..5a603caa36 100644 --- a/lib/ExtUtils/MM_OS2.pm +++ b/lib/ExtUtils/MM_OS2.pm @@ -8,7 +8,6 @@ require Exporter; Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); -$ENV{EMXSHELL} = 'sh'; # to run `commands` unshift @MM::ISA, 'ExtUtils::MM_OS2'; sub dlsyms { diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index ef33e3851d..4f861dfe2a 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1004,6 +1004,10 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH} if ($^O eq 'solaris'); + # The IRIX linker also doesn't use LD_RUN_PATH + $ldrun = "-rpath $self->{LD_RUN_PATH}" + if ($^O eq 'irix'); + push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)'); push @m, ' diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index f3b843f6f2..ee451c7051 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1538,15 +1538,14 @@ Hashref of .pm files and *.pl files to be installed. e.g. {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'} -By default this will include *.pm and *.pl. If a lib directory -exists and is not listed in DIR (above) then any *.pm and *.pl files -it contains will also be included by default. Defining PM in the +By default this will include *.pm and *.pl and the files found in +the PMLIBDIRS directories. Defining PM in the Makefile.PL will override PMLIBDIRS. =item PMLIBDIRS Ref to array of subdirectories containing library files. Defaults to -[ 'lib', $(BASEEXT) ]. The directories will be scanned and any files +[ 'lib', $(BASEEXT) ]. The directories will be scanned and I<any> files they contain will be installed in the corresponding location in the library. A libscan() method can be used to alter the behaviour. Defining PM in the Makefile.PL will override PMLIBDIRS. diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 8828a52bfc..3333844ca6 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -177,6 +177,10 @@ sub fileparse { } elsif ($fstype !~ /^VMS/i) { # default to Unix ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#); + if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) { + # dev:[000000] is top of VMS tree, similar to Unix '/' + ($basename,$dirpath) = ('',$fullname); + } $dirpath = './' unless $dirpath; } diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm index a39308b6c9..dca7f6aff3 100644 --- a/lib/File/CheckTree.pm +++ b/lib/File/CheckTree.pm @@ -137,13 +137,13 @@ sub valmess { $mess =~ s/ does not / should not / || $mess =~ s/ not / /; } - print STDERR $mess,"\n"; } else { $this =~ s/\$file/'$file'/g; - print STDERR "Can't do $this.\n"; + $mess = "Can't do $this.\n"; } - if ($disposition eq 'die') { exit 1; } + die "$mess\n" if $disposition eq 'die'; + warn "$mess\n"; ++$warnings; } diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 7abebc6544..67abf6088b 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -1,10 +1,7 @@ package File::Find; require 5.000; require Exporter; -use Config; require Cwd; -require File::Basename; - =head1 NAME @@ -24,6 +21,17 @@ finddepth - traverse a directory structure depth-first =head1 DESCRIPTION +The first argument to find() is either a hash reference describing the +operations to be performed for each file, or a code reference. If it +is a hash reference, then the value for the key C<wanted> should be a +code reference. This code reference is called I<the wanted() +function> below. + +Currently the only other supported key for the above hash is +C<bydepth>, in presense of which the walk over directories is +performed depth-first. Entry point finddepth() is a shortcut for +specifying C<{ bydepth => 1}> in the first argument of find(). + The wanted() function does whatever verifications you want. $File::Find::dir contains the current directory name, and $_ the current filename within that directory. $File::Find::name contains @@ -34,7 +42,7 @@ prune the tree. File::Find assumes that you don't alter the $_ variable. If you do then make sure you return it to its original value before exiting your function. -This library is primarily for the C<find2perl> tool, which when fed, +This library is useful for the C<find2perl> tool, which when fed, find2perl / -name .nfs\* -mtime +7 \ -exec rm -f {} \; -o -fstype nfs -prune @@ -75,9 +83,10 @@ There is no way to make find or finddepth follow symlinks. @EXPORT = qw(find finddepth); -sub find { +sub find_opt { my $wanted = shift; - my $cwd = Cwd::cwd(); + my $bydepth = $wanted->{bydepth}; + my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd(); # Localize these rather than lexicalizing them for backwards # compatibility. local($topdir,$topdev,$topino,$topmode,$topnlink); @@ -87,27 +96,35 @@ sub find { || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { - ($dir,$_) = ($topdir,'.'); - $name = $topdir; $prune = 0; - &$wanted; + unless ($bydepth) { + ($dir,$_) = ($topdir,'.'); + $name = $topdir; + $wanted->{wanted}->(); + } next if $prune; my $fixtopdir = $topdir; $fixtopdir =~ s,/$,, ; $fixtopdir =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$fixtopdir,$topnlink); + &finddir($wanted,$fixtopdir,$topnlink, $bydepth); + if ($bydepth) { + ($dir,$_) = ($fixtopdir,'.'); + $name = $fixtopdir; + $wanted->{wanted}->(); + } } else { warn "Can't cd to $topdir: $!\n"; } } else { + require File::Basename; unless (($_,$dir) = File::Basename::fileparse($topdir)) { ($dir,$_) = ('.', $topdir); } if (chdir($dir)) { $name = $topdir; - &$wanted; + $wanted->{wanted}->(); } else { warn "Can't cd to $dir: $!\n"; @@ -118,14 +135,14 @@ sub find { } sub finddir { - my($wanted, $nlink); + my($wanted, $nlink, $bydepth); local($dir, $name); - ($wanted, $dir, $nlink) = @_; + ($wanted, $dir, $nlink, $bydepth) = @_; my($dev, $ino, $mode, $subcount); # Get the list of files in the current directory. - opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); + opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return); my(@filenames) = readdir(DIR); closedir(DIR); @@ -135,7 +152,7 @@ sub finddir { next if $_ eq '..'; $name = "$dir/$_"; $nlink = 0; - &$wanted; + $wanted->{wanted}->(); } } else { # This dir has subdirectories. @@ -143,9 +160,10 @@ sub finddir { for (@filenames) { next if $_ eq '.'; next if $_ eq '..'; - $nlink = $prune = 0; + $nlink = 0; + $prune = 0 unless $bydepth; $name = "$dir/$_"; - &$wanted; + $wanted->{wanted}->() unless $bydepth; if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? # Get link count and check for directoriness. @@ -161,7 +179,7 @@ sub finddir { next if $prune; if (chdir $_) { $name =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$name,$nlink); + &finddir($wanted,$name,$nlink, $bydepth); chdir '..'; } else { @@ -169,109 +187,26 @@ sub finddir { } } } + $wanted->{wanted}->() if $bydepth; } } } - -sub finddepth { - my $wanted = shift; - my $cwd = Cwd::cwd(); - # Localize these rather than lexicalizing them for backwards - # compatibility. - local($topdir,$topdev,$topino,$topmode,$topnlink); - foreach $topdir (@_) { - (($topdev,$topino,$topmode,$topnlink) = - ($Is_VMS ? stat($topdir) : lstat($topdir))) - || (warn("Can't stat $topdir: $!\n"), next); - if (-d _) { - if (chdir($topdir)) { - my $fixtopdir = $topdir; - $fixtopdir =~ s,/$,, ; - $fixtopdir =~ s/\.dir$// if $Is_VMS; - &finddepthdir($wanted,$fixtopdir,$topnlink); - ($dir,$_) = ($topdir,'.'); - $name = $topdir; - &$wanted; - } - else { - warn "Can't cd to $topdir: $!\n"; - } - } - else { - unless (($_,$dir) = File::Basename::fileparse($topdir)) { - ($dir,$_) = ('.', $topdir); - } - if (chdir($dir)) { - $name = $topdir; - &$wanted; - } - else { - warn "Can't cd to $dir: $!\n"; - } - } - chdir $cwd; - } +sub wrap_wanted { + my $wanted = shift; + defined &$wanted ? {wanted => $wanted} : $wanted; } -sub finddepthdir { - my($wanted, $nlink); - local($dir, $name); - ($wanted, $dir, $nlink) = @_; - my($dev, $ino, $mode, $subcount); - - # Get the list of files in the current directory. - opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); - my(@filenames) = readdir(DIR); - closedir(DIR); - - if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $name = "$dir/$_"; - $nlink = 0; - &$wanted; - } - } - else { # This dir has subdirectories. - $subcount = $nlink - 2; - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $nlink = 0; - $name = "$dir/$_"; - if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? - - # Get link count and check for directoriness. - - ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); - - if (-d _) { - - # It really is a directory, so do it recursively. - - --$subcount; - if (chdir $_) { - $name =~ s/\.dir$// if $Is_VMS; - &finddepthdir($wanted,$name,$nlink); - chdir '..'; - } - else { - warn "Can't cd to $_: $!\n"; - } - } - } - &$wanted; - } - } +sub find { + my $wanted = shift; + find_opt(wrap_wanted($wanted), @_); } -# Set dont_use_nlink in your hint file if your system's stat doesn't -# report the number of links in a directory as an indication -# of the number of files. -# See, e.g. hints/machten.sh for MachTen 2.2. -$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); +sub find_depth { + my $wanted = wrap_wanted(shift); + $wanted->{bydepth} = 1; + find_opt($wanted, @_); +} # These are hard-coded for now, but may move to hint files. if ($^O eq 'VMS') { @@ -282,5 +217,14 @@ if ($^O eq 'VMS') { $dont_use_nlink = 1 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; +# Set dont_use_nlink in your hint file if your system's stat doesn't +# report the number of links in a directory as an indication +# of the number of files. +# See, e.g. hints/machten.sh for MachTen 2.2. +unless ($dont_use_nlink) { + require Config; + $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); +} + 1; diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 6b5d5683f1..39f1ba1771 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -124,11 +124,15 @@ sub mkpath { $paths = [$paths] unless ref $paths; my(@created,$path); foreach $path (@$paths) { + $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT next if -d $path; # Logic wants Unix paths, so go with the flow. $path = VMS::Filespec::unixify($path) if $Is_VMS; my $parent = File::Basename::dirname($path); - push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); + # Allow for creation of new logical filesystems under VMS + if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) { + push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); + } print "mkdir $path\n" if $verbose; unless (mkdir($path,$mode)) { # allow for another process to have created it meanwhile diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 455fc63917..72ecdac1b6 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -249,6 +249,10 @@ It will also croak() if accidentally called in a scalar context. =back +There are many other functions available since FileHandle is descended +from IO::File, IO::Seekable, and IO::Handle. Please see those +respective pages for documentation on more functions. + =head1 SEE ALSO The B<IO> extension, diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 7551ad01a3..77fb5dd818 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -37,7 +37,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead sub stringify { my $n = ${$_[0]}; - $n =~ s/^\+//; + my $minus = ($n =~ s/^([+-])// && $1 eq '-'); $n =~ s/E//; $n =~ s/([-+]\d+)$//; @@ -52,6 +52,7 @@ sub stringify { } else { $n = '.' . ("0" x (abs($e) - $ln)) . $n; } + $n = "-$n" if $minus; # 1 while $n =~ s/(.*\d)(\d\d\d)/$1,$2/; diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 422dca42fd..013e55fadb 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -171,7 +171,7 @@ sub add { #(int_num_array, int_num_array) return int_num_array $car = 0; for $x (@x) { last unless @y || $car; - $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0; + $x -= 1e5 if $car = (($x += (@y ? shift(@y) : 0) + $car) >= 1e5) ? 1 : 0; } for $y (@y) { last unless $car; @@ -185,8 +185,8 @@ sub sub { #(int_num_array, int_num_array) return int_num_array local(*sx, *sy) = @_; $bar = 0; for $sx (@sx) { - last unless @y || $bar; - $sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0); + last unless @sy || $bar; + $sx += 1e5 if $bar = (($sx -= (@sy ? shift(@sy) : 0) + $bar) < 0); } @sx; } diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm index 62da1d273f..d3a89f03b8 100644 --- a/lib/Text/ParseWords.pm +++ b/lib/Text/ParseWords.pm @@ -1,140 +1,93 @@ package Text::ParseWords; -require 5.000; -use Carp; +use vars qw($VERSION @ISA @EXPORT); +$VERSION = "3.0"; -require AutoLoader; -*AUTOLOAD = \&AutoLoader::AUTOLOAD; +require 5.000; -require Exporter; +use Exporter; @ISA = qw(Exporter); -@EXPORT = qw(shellwords quotewords); +@EXPORT = qw(shellwords quotewords nested_quotewords parse_line); @EXPORT_OK = qw(old_shellwords); -=head1 NAME - -Text::ParseWords - parse text into an array of tokens - -=head1 SYNOPSIS - - use Text::ParseWords; - @words = "ewords($delim, $keep, @lines); - @words = &shellwords(@lines); - @words = &old_shellwords(@lines); - -=head1 DESCRIPTION -"ewords() accepts a delimiter (which can be a regular expression) -and a list of lines and then breaks those lines up into a list of -words ignoring delimiters that appear inside quotes. - -The $keep argument is a boolean flag. If true, the quotes are kept -with each word, otherwise quotes are stripped in the splitting process. -$keep also defines whether unprotected backslashes are retained. - -A &shellwords() replacement is included to demonstrate the new package. -This version differs from the original in that it will _NOT_ default -to using $_ if no arguments are given. I personally find the old behavior -to be a mis-feature. - -"ewords() works by simply jamming all of @lines into a single -string in $_ and then pulling off words a bit at a time until $_ -is exhausted. +sub shellwords { + local(@lines) = @_; + $lines[$#lines] =~ s/\s+$//; + return(quotewords('\s+', 0, @lines)); +} -=head1 AUTHORS -Hal Pomeranz (pomeranz@netcom.com), 23 March 1994 -Basically an update and generalization of the old shellwords.pl. -Much code shamelessly stolen from the old version (author unknown). +sub quotewords { + my($delim, $keep, @lines) = @_; + my($line, @words, @allwords); + + + foreach $line (@lines) { + @words = parse_line($delim, $keep, $line); + return() unless (@words || !length($line)); + push(@allwords, @words); + } + return(@allwords); +} -=cut -1; -__END__ -sub shellwords { - local(@lines) = @_; - $lines[$#lines] =~ s/\s+$//; - "ewords('\s+', 0, @lines); +sub nested_quotewords { + my($delim, $keep, @lines) = @_; + my($i, @allwords); + + for ($i = 0; $i < @lines; $i++) { + @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]); + return() unless (@{$allwords[$i]} || !length($lines[$i])); + } + return(@allwords); } -sub quotewords { - -# The inner "for" loop builds up each word (or $field) one $snippet -# at a time. A $snippet is a quoted string, a backslashed character, -# or an unquoted string. We fall out of the "for" loop when we reach -# the end of $_ or when we hit a delimiter. Falling out of the "for" -# loop, we push the $field we've been building up onto the list of -# @words we'll be returning, and then loop back and pull another word -# off of $_. -# -# The first two cases inside the "for" loop deal with quoted strings. -# The first case matches a double quoted string, removes it from $_, -# and assigns the double quoted string to $snippet in the body of the -# conditional. The second case handles single quoted strings. In -# the third case we've found a quote at the current beginning of $_, -# but it didn't match the quoted string regexps in the first two cases, -# so it must be an unbalanced quote and we croak with an error (which can -# be caught by eval()). -# -# The next case handles backslashed characters, and the next case is the -# exit case on reaching the end of the string or finding a delimiter. -# -# Otherwise, we've found an unquoted thing and we pull of characters one -# at a time until we reach something that could start another $snippet-- -# a quote of some sort, a backslash, or the delimiter. This one character -# at a time behavior was necessary if the delimiter was going to be a -# regexp (love to hear it if you can figure out a better way). - - my ($delim, $keep, @lines) = @_; - my (@words, $snippet, $field); - - local $_ = join ('', @lines); - - while (length) { - $field = ''; +sub parse_line { + my($delimiter, $keep, $line) = @_; + my($quote, $quoted, $unquoted, $delim, $word, @pieces); - for (;;) { - $snippet = ''; + while (length($line)) { + ($quote, $quoted, $unquoted, $delim) = + $line =~ m/^(["']) # a $quote + ((?:\\.|[^\1\\])*?) # and $quoted text + \1 # followed by the same quote + | # --OR-- + ^((?:\\.|[^\\"'])*?) # an $unquoted text + (\Z(?!\n)|$delimiter|(?!^)(?=["'])) + # plus EOL, delimiter, or quote + /x; # extended layout - if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) { - $snippet = $1; - $snippet = qq|"$snippet"| if $keep; - } - elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) { - $snippet = $1; - $snippet = "'$snippet'" if $keep; - } - elsif (/^["']/) { - croak 'Unmatched quote'; - } - elsif (s/^\\(.)//) { - $snippet = $1; - $snippet = "\\$snippet" if $keep; - } - elsif (!length || s/^$delim//) { - last; - } - else { - while (length && !(/^$delim/ || /^['"\\]/)) { - $snippet .= substr ($_, 0, 1); - substr($_, 0, 1) = ''; - } - } + return() unless(length($&)); + $line = $'; - $field .= $snippet; + if ($keep) { + $quoted = "$quote$quoted$quote"; + } + else { + $unquoted =~ s/\\(.)/$1/g; + $quoted =~ s/\\(.)/$1/g if ($quote eq '"'); + } + $word .= ($quote) ? $quoted : $unquoted; + + if (length($delim)) { + push(@pieces, $word); + push(@pieces, $delim) if ($keep eq 'delimiters'); + undef $word; + } + if (!length($line)) { + push(@pieces, $word); } - - push @words, $field; } - - return @words; + return(@pieces); } + sub old_shellwords { # Usage: @@ -154,13 +107,13 @@ sub old_shellwords { ($snippet = $1) =~ s#\\(.)#$1#g; } elsif (/^"/) { - croak "Unmatched double quote: $_"; + return(); } elsif (s/^'(([^'\\]|\\.)*)'//) { ($snippet = $1) =~ s#\\(.)#$1#g; } elsif (/^'/) { - croak "Unmatched single quote: $_"; + return(); } elsif (s/^\\(.)//) { $snippet = $1; @@ -178,3 +131,117 @@ sub old_shellwords { } @words; } + +1; + +__END__ + +=head1 NAME + +Text::ParseWords - parse text into an array of tokens or array of arrays + +=head1 SYNOPSIS + + use Text::ParseWords; + @lists = &nested_quotewords($delim, $keep, @lines); + @words = "ewords($delim, $keep, @lines); + @words = &shellwords(@lines); + @words = &parse_line($delim, $keep, $line); + @words = &old_shellwords(@lines); # DEPRECATED! + +=head1 DESCRIPTION + +The &nested_quotewords() and "ewords() functions accept a delimiter +(which can be a regular expression) +and a list of lines and then breaks those lines up into a list of +words ignoring delimiters that appear inside quotes. "ewords() +returns all of the tokens in a single long list, while &nested_quotewords() +returns a list of token lists corresponding to the elements of @lines. +&parse_line() does tokenizing on a single string. The &*quotewords() +functions simply call &parse_lines(), so if you're only splitting +one line you can call &parse_lines() directly and save a function +call. + +The $keep argument is a boolean flag. If true, then the tokens are +split on the specified delimiter, but all other characters (quotes, +backslashes, etc.) are kept in the tokens. If $keep is false then the +&*quotewords() functions remove all quotes and backslashes that are +not themselves backslash-escaped or inside of single quotes (i.e., +"ewords() tries to interpret these characters just like the Bourne +shell). NB: these semantics are significantly different from the +original version of this module shipped with Perl 5.000 through 5.004. +As an additional feature, $keep may be the keyword "delimiters" which +causes the functions to preserve the delimiters in each string as +tokens in the token lists, in addition to preserving quote and +backslash characters. + +&shellwords() is written as a special case of "ewords(), and it +does token parsing with whitespace as a delimiter-- similar to most +Unix shells. + +=head1 EXAMPLES + +The sample program: + + use Text::ParseWords; + @words = "ewords('\s+', 0, q{this is "a test" of\ quotewords \"for you}); + $i = 0; + foreach (@words) { + print "$i: <$_>\n"; + $i++; + } + +produces: + + 0: <this> + 1: <is> + 2: <a test> + 3: <of quotewords> + 4: <"for> + 5: <you> + +demonstrating: + +=over 4 + +=item 0 +a simple word + +=item 1 +multiple spaces are skipped because of our $delim + +=item 2 +use of quotes to include a space in a word + +=item 3 +use of a backslash to include a space in a word + +=item 4 +use of a backslash to remove the special meaning of a double-quote + +=item 5 +another simple word (note the lack of effect of the +backslashed double-quote) + +=back + +Replacing C<"ewords('\s+', 0, q{this is...})> +with C<&shellwords(q{this is...})> +is a simpler way to accomplish the same thing. + +=head1 AUTHORS + +Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original +author unknown). Much of the code for &parse_line() (including the +primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>. + +Examples section another documentation provided by John Heidemann +<johnh@ISI.EDU> + +Bug reports, patches, and nagging provided by lots of folks-- thanks +everybody! Special thanks to Michael Schwern <schwern@envirolink.org> +for assuring me that a &nested_quotewords() would be useful, and to +Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about +error-checking (sort of-- you had to be there). + +=cut diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm index 0910a2ab34..0fe7fb93c2 100644 --- a/lib/Text/Wrap.pm +++ b/lib/Text/Wrap.pm @@ -1,71 +1,74 @@ package Text::Wrap; -require Exporter; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $columns $debug); +use strict; +use Exporter; -@ISA = (Exporter); +$VERSION = "97.02"; +@ISA = qw(Exporter); @EXPORT = qw(wrap); -@EXPORT_OK = qw($columns); +@EXPORT_OK = qw($columns $tabstop fill); -$VERSION = 97.011701; +use Text::Tabs qw(expand unexpand $tabstop); -use vars qw($VERSION $columns $debug); -use strict; BEGIN { - $columns = 76; # <= screen width - $debug = 0; + $columns = 76; # <= screen width + $debug = 0; } -use Text::Tabs qw(expand unexpand); - sub wrap { - my ($ip, $xp, @t) = @_; - - my $r = ""; - my $t = expand(join(" ",@t)); - my $lead = $ip; - my $ll = $columns - length(expand($lead)) - 1; - my $nl = ""; - - # remove up to a line length of things that aren't - # new lines and tabs. - - if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) { - - # accept it. - $r .= unexpand($lead . $1); - - # recompute the leader - $lead = $xp; - $ll = $columns - length(expand($lead)) - 1; - $nl = $2; - - # repeat the above until there's none left - while ($t) { - if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) { - print "\$2 is '$2'\n" if $debug; - $nl = $2; - $r .= unexpand("\n" . $lead . $1); - } elsif ($t =~ s/^([^\n]{$ll})//) { - $nl = "\n"; - $r .= unexpand("\n" . $lead . $1); - } - } - $r .= $nl; - } + my ($ip, $xp, @t) = @_; + + my @rv; + my $t = expand(join(" ",@t)); + + my $lead = $ip; + my $ll = $columns - length(expand($lead)) - 1; + my $nl = ""; + + $t =~ s/^\s+//; + while(length($t) > $ll) { + # remove up to a line length of things that + # aren't new lines and tabs. + if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//) { + my ($l,$r) = ($1,$2); + $l =~ s/\s+$//; + print "WRAP $lead$l..($r)\n" if $debug; + push @rv, unexpand($lead . $l), "\n"; + + } elsif ($t =~ s/^([^\n]{$ll})//) { + print "SPLIT $lead$1..\n" if $debug; + push @rv, unexpand($lead . $1),"\n"; + } + # recompute the leader + $lead = $xp; + $ll = $columns - length(expand($lead)) - 1; + $t =~ s/^\s+//; + } + print "TAIL $lead$t\n" if $debug; + push @rv, $lead.$t if $t ne ""; + return join '', @rv; +} - die "couldn't wrap '$t'" - if length($t) > $ll; - print "-----------$r---------\n" if $debug; +sub fill +{ + my ($ip, $xp, @raw) = @_; + my @para; + my $pp; - print "Finish up with '$lead', '$t'\n" if $debug; + for $pp (split(/\n\s+/, join("\n",@raw))) { + $pp =~ s/\s+/ /g; + my $x = wrap($ip, $xp, $pp); + push(@para, $x); + } - $r .= $lead . $t if $t ne ""; + # if paragraph_indent is the same as line_indent, + # separate paragraphs with blank lines - print "-----------$r---------\n" if $debug;; - return $r; + return join ($ip eq $xp ? "\n\n" : "\n", @para); } 1; @@ -81,9 +84,13 @@ Text::Wrap - line wrapping to form simple paragraphs print wrap($initial_tab, $subsequent_tab, @text); - use Text::Wrap qw(wrap $columns); + use Text::Wrap qw(wrap $columns $tabstop fill); $columns = 132; + $tabstop = 4; + + print fill($initial_tab, $subsequent_tab, @text); + print fill("", "", `cat book`); =head1 DESCRIPTION @@ -93,6 +100,12 @@ Indentation is controlled for the first line ($initial_tab) and all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns should be set to the full width of your output device. +Text::Wrap::fill() is a simple multi-paragraph formatter. It formats +each paragraph separately and then joins them together when it's done. It +will destory any whitespace in the original text. It breaks text into +paragraphs by looking for whitespace after a newline. In other respects +it acts like wrap(). + =head1 EXAMPLE print wrap("\t","","This is a bit of text that forms @@ -102,44 +115,11 @@ should be set to the full width of your output device. It's not clear what the correct behavior should be when Wrap() is presented with a word that is longer than a line. The previous -behavior was to die. Now the word is split at line-length. +behavior was to die. Now the word is now split at line-length. =head1 AUTHOR David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and -others. +others. Updated by Jacqui Caren. =cut - -Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97 - - print fill($initial_tab, $subsequent_tab, @text); - - print fill("", "", `cat book`); - -Text::Wrap::fill() is a simple multi-paragraph formatter. It formats -each paragraph separately and then joins them together when it's done. It -will destory any whitespace in the original text. It breaks text into -paragraphs by looking for whitespace after a newline. In other respects -it acts like wrap(). - -# Tim Pierce did a faster version of this: - -sub fill -{ - my ($ip, $xp, @raw) = @_; - my @para; - my $pp; - - for $pp (split(/\n\s+/, join("\n",@raw))) { - $pp =~ s/\s+/ /g; - my $x = wrap($ip, $xp, $pp); - push(@para, $x); - } - - # if paragraph_indent is the same as line_indent, - # separate paragraphs with blank lines - - return join ($ip eq $xp ? "\n\n" : "\n", @para); -} - diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm index 89fd61dd74..7ed18962e9 100644 --- a/lib/Tie/Hash.pm +++ b/lib/Tie/Hash.pm @@ -67,7 +67,7 @@ Return the (key, value) pair for the first key in the hash. =item NEXTKEY this, lastkey -Return the next (key, value) pair for the hash. +Return the next key for the hash. =item EXISTS this, key diff --git a/lib/base.pm b/lib/base.pm index e20a64bc9a..4c4fb8b86b 100644 --- a/lib/base.pm +++ b/lib/base.pm @@ -34,6 +34,9 @@ sub import { foreach my $base (@_) { unless (defined %{"$base\::"}) { eval "require $base"; + # Only ignore "Can't locate" errors from our eval require. + # Other fatal errors (syntax etc) must be reported. + die if $@ && $@ !~ /^Can't locate .*? at \(eval /; unless (defined %{"$base\::"}) { require Carp; Carp::croak("Base class package \"$base\" is empty.\n", diff --git a/lib/constant.pm b/lib/constant.pm index a0d4f9d5cd..464e20cd91 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -106,6 +106,15 @@ name as a constant. This is probably a Good Thing. Unlike constants in some languages, these cannot be overridden on the command line or via environment variables. +You can get into trouble if you use constants in a context which +automatically quotes barewords (as is true for any subroutine call). +For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will +be interpreted as a string. Use C<$hash{CONSTANT()}> or +C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from +kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword +immediately to its left you have to say C<CONSTANT() =E<gt> 'value'> +instead of C<CONSTANT =E<gt> 'value'>. + =head1 AUTHOR Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from diff --git a/lib/integer.pm b/lib/integer.pm index a88ce6a77c..894931896f 100644 --- a/lib/integer.pm +++ b/lib/integer.pm @@ -12,11 +12,22 @@ integer - Perl pragma to compute arithmetic in integer instead of double =head1 DESCRIPTION -This tells the compiler that it's okay to use integer operations +This tells the compiler to use integer operations from here to the end of the enclosing BLOCK. On many machines, this doesn't matter a great deal for most computations, but on those without floating point hardware, it can make a big difference. +Note that this affects the operations, not the numbers. If you run this +code + + use integer; + $x = 1.5; + $y = $x + 1; + $z = -1.5; + +you'll be left with C<$x == 1.5>, C<$y == 2> and C<$z == -1>. The $z +case happens because unary C<-> counts as an operation. + See L<perlmod/Pragmatic Modules>. =cut diff --git a/lib/lib.pm b/lib/lib.pm index 4d32f96355..6e6e15e4ce 100644 --- a/lib/lib.pm +++ b/lib/lib.pm @@ -18,6 +18,10 @@ sub import { Carp::carp("Empty compile time value given to use lib"); # at foo.pl line ... } + if (-e && ! -d _) { + require Carp; + Carp::carp("Parameter to use lib must be directory, not file"); + } unshift(@INC, $_); # Put a corresponding archlib directory infront of $_ if it # looks like $_ has an archlib directory below it. diff --git a/lib/strict.pm b/lib/strict.pm index af95b3d096..2b1d964e65 100644 --- a/lib/strict.pm +++ b/lib/strict.pm @@ -77,14 +77,17 @@ See L<perlmod/Pragmatic Modules>. =cut +$strict::VERSION = "1.01"; + +my %bitmask = ( +refs => 0x00000002, +subs => 0x00000200, +vars => 0x00000400 +); + sub bits { my $bits = 0; - my $sememe; - foreach $sememe (@_) { - $bits |= 0x00000002, next if $sememe eq 'refs'; - $bits |= 0x00000200, next if $sememe eq 'subs'; - $bits |= 0x00000400, next if $sememe eq 'vars'; - } + foreach my $s (@_){ $bits |= $bitmask{$s} || 0; }; $bits; } @@ -1239,6 +1239,7 @@ mod(OP *o, I32 type) else if (!type) { o->op_private |= OPpLVAL_INTRO; o->op_flags &= ~OPf_SPECIAL; + hints |= HINT_BLOCK_SCOPE; } else if (type != OP_GREPSTART && type != OP_ENTERSUB) o->op_flags |= OPf_REF; @@ -3481,7 +3482,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) ENTER; SAVESPTR(compiling.cop_filegv); SAVEI16(compiling.cop_line); - SAVEI32(perldb); save_svref(&rs); sv_setsv(rs, nrs); @@ -4876,6 +4876,8 @@ peep(register OP *o) o->op_seq = op_seqmax++; if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { if (o->op_next->op_sibling && + o->op_next->op_sibling->op_type != OP_EXIT && + o->op_next->op_sibling->op_type != OP_WARN && o->op_next->op_sibling->op_type != OP_DIE) { line_t oldline = curcop->cop_line; diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 4ba7a7fd1f..fd3766e0d6 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -27,7 +27,7 @@ AOUT_CLDFLAGS = $aout_ldflags AOUT_LIBPERL_DLL = libperl_dll$aout_lib_ext AOUT_CCCMD_DLL = \$(CC) -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK -AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll +AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll -Zstack 32000 LD_OPT = $optimize @@ -97,19 +97,19 @@ depend: os2ish.h dlfcn.h os2thread.h os2.c os2$(OBJ_EXT) : os2.c os2.c: os2/os2.c os2ish.h - cp $< $@ + cp -f $< $@ dl_os2.c: os2/dl_os2.c os2ish.h - cp $< $@ + cp -f $< $@ os2ish.h: os2/os2ish.h - cp $< $@ + cp -f $< $@ os2thread.h: os2/os2thread.h - cp $< $@ + cp -f $< $@ dlfcn.h: os2/dlfcn.h - cp $< $@ + cp -f $< $@ # This one is compiled OMF, so cannot fork(): @@ -347,40 +347,37 @@ result(int flag, int pid) #endif } +#define EXECF_SPAWN 0 +#define EXECF_EXEC 1 +#define EXECF_TRUEEXEC 2 +#define EXECF_SPAWN_NOWAIT 3 + +/* Spawn/exec a program, revert to shell if needed. */ +/* global Argv[] contains arguments. */ + int -do_aspawn(really,mark,sp) +do_aspawn(really, flag, execf) SV *really; -register SV **mark; -register SV **sp; +U32 flag; +U32 execf; { dTHR; - register char **a; - char *tmps = NULL; - int rc; - int flag = P_WAIT, trueflag, err, secondtry = 0; - - if (sp > mark) { - New(1301,Argv, sp - mark + 3, char*); - a = Argv; - - if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { - ++mark; - flag = SvIVx(*mark); - } - - while (++mark <= sp) { - if (*mark) - *a++ = SvPVx(*mark, na); - else - *a++ = ""; - } - *a = Nullch; - - trueflag = flag; + int trueflag = flag; + int rc, secondtry = 0, err; + char *tmps; + char buf[256], *s = 0; + char *args[4]; + static char * fargs[4] + = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; + char **argsp = fargs; + char nargs = 4; + if (flag == P_WAIT) flag = P_NOWAIT; - if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path; + retry: + if (strEQ(Argv[0],"/bin/sh")) + Argv[0] = sh_path; if (Argv[0][0] != '/' && Argv[0][0] != '\\' && !(Argv[0][0] && Argv[0][1] == ':' @@ -388,18 +385,29 @@ register SV **sp; ) /* will swawnvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ /* We should check PERL_SH* and PERLLIB_* as well? */ - retry: - if (really && *(tmps = SvPV(really, na))) - rc = result(trueflag, spawnvp(flag,tmps,Argv)); - else - rc = result(trueflag, spawnvp(flag,Argv[0],Argv)); - + if (!really || !*(tmps = SvPV(really, na))) + tmps = Argv[0]; +#if 0 + rc = result(trueflag, spawnvp(flag,tmps,Argv)); +#else + if (execf == EXECF_TRUEEXEC) + rc = execvp(tmps,Argv); + else if (execf == EXECF_EXEC) + rc = spawnvp(trueflag | P_OVERLAY,tmps,Argv); + else if (execf == EXECF_SPAWN_NOWAIT) + rc = spawnvp(trueflag | P_NOWAIT,tmps,Argv); + else /* EXECF_SPAWN */ + rc = result(trueflag, + spawnvp(trueflag | P_NOWAIT,tmps,Argv)); +#endif if (rc < 0 && secondtry == 0 - && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */ + && (tmps == Argv[0])) { /* Cannot transfer `really' via shell. */ err = errno; if (err == ENOENT) { /* No such file. */ /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ + that .exe-less files are automatically shellable. + It might have also been .cmd file without + extension. */ char *no_dir; (no_dir = strrchr(Argv[0], '/')) || (no_dir = strrchr(Argv[0], '\\')) @@ -409,34 +417,139 @@ register SV **sp; if (stat(Argv[0], &buffer) != -1) { /* File exists. */ /* Maybe we need to specify the full name here? */ goto doshell; + } else { + /* Try adding script extensions to the file name */ + char *scr; + if ((scr = find_script(Argv[0], TRUE, NULL, 0))) { + FILE *file = fopen(scr, "r"); + char *s = 0, *s1; + + Argv[0] = scr; + if (!file) + goto panic_file; + if (!fgets(buf, sizeof buf, file)) { + fclose(file); + goto panic_file; + } + if (fclose(file) != 0) { /* Failure */ + panic_file: + warn("Error reading \"%s\": %s", + scr, Strerror(errno)); + goto doshell; + } + if (buf[0] == '#') { + if (buf[1] == '!') + s = buf + 2; + } else if (buf[0] == 'e') { + if (strnEQ(buf, "extproc", 7) + && isSPACE(buf[7])) + s = buf + 8; + } else if (buf[0] == 'E') { + if (strnEQ(buf, "EXTPROC", 7) + && isSPACE(buf[7])) + s = buf + 8; + } + if (!s) + goto doshell; + s1 = s; + nargs = 0; + argsp = args; + while (1) { + while (isSPACE(*s)) + s++; + if (*s == 0) + break; + if (nargs == 4) { + nargs = -1; + break; + } + args[nargs++] = s; + while (*s && !isSPACE(*s)) + s++; + if (*s == 0) + break; + *s++ = 0; + } + if (nargs == -1) { + warn("Too many args on %.*s line of \"%s\"", + s1 - buf, buf, scr); + nargs = 4; + argsp = fargs; + } + goto doshell; + } } } + /* Restore errno */ + errno = err; } else if (err == ENOEXEC) { /* Need to send to shell. */ doshell: + { + char **a = Argv; + + while (a[1]) /* Get to the end */ + a++; while (a >= Argv) { - *(a + 2) = *a; + *(a + nargs) = *a; /* Argv was preallocated to be + long enough. */ a--; } - *Argv = sh_path; - *(Argv + 1) = "-c"; + while (nargs-- >= 0) + Argv[nargs] = argsp[nargs]; secondtry = 1; goto retry; + } } } if (rc < 0 && dowarn) - warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + warn("Can't %s \"%s\": %s\n", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + Argv[0], Strerror(err)); + if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) + && ((trueflag & 0xFF) == P_WAIT)) + rc = 255 << 8; /* Emulate the fork(). */ + + return rc; +} + +int +do_aspawn(really,mark,sp) +SV *really; +register SV **mark; +register SV **sp; +{ + dTHR; + register char **a; + char *tmps = NULL; + int rc; + int flag = P_WAIT, trueflag, err, secondtry = 0; + + if (sp > mark) { + New(1301,Argv, sp - mark + 3, char*); + a = Argv; + + if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { + ++mark; + flag = SvIVx(*mark); + } + + while (++mark <= sp) { + if (*mark) + *a++ = SvPVx(*mark, na); + else + *a++ = ""; + } + *a = Nullch; + + rc = do_spawn_ve(really, flag, EXECF_SPAWN); } else rc = -1; do_execfree(); return rc; } -#define EXECF_SPAWN 0 -#define EXECF_EXEC 1 -#define EXECF_TRUEEXEC 2 -#define EXECF_SPAWN_NOWAIT 3 - +/* Try converting 1-arg form to (usually shell-less) multi-arg form. */ int do_spawn2(cmd, execf) char *cmd; @@ -501,6 +614,8 @@ int execf; } else if (*s == '\\' && !seenspace) { continue; /* Allow backslashes in names */ } + /* We do not convert this to do_spawn_ve since shell + should be smart enough to start itself gloriously. */ doshell: if (execf == EXECF_TRUEEXEC) return execl(shell,shell,copt,cmd,(char*)0); @@ -523,7 +638,8 @@ int execf; } } - New(1303,Argv, (s - cmd) / 2 + 2, char*); + /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */ + New(1303,Argv, (s - cmd + 11) / 2, char*); Cmd = savepvn(cmd, s-cmd); a = Argv; for (s = Cmd; *s;) { @@ -535,44 +651,9 @@ int execf; *s++ = '\0'; } *a = Nullch; - if (Argv[0]) { - int err; - - if (execf == EXECF_TRUEEXEC) - rc = execvp(Argv[0],Argv); - else if (execf == EXECF_EXEC) - rc = spawnvp(P_OVERLAY,Argv[0],Argv); - else if (execf == EXECF_SPAWN_NOWAIT) - rc = spawnvp(P_NOWAIT,Argv[0],Argv); - else - rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv)); - if (rc < 0) { - err = errno; - if (err == ENOENT) { /* No such file. */ - /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ - char *no_dir; - (no_dir = strrchr(Argv[0], '/')) - || (no_dir = strrchr(Argv[0], '\\')) - || (no_dir = Argv[0]); - if (!strchr(no_dir, '.')) { - struct stat buffer; - if (stat(Argv[0], &buffer) != -1) { /* File exists. */ - /* Maybe we need to specify the full name here? */ - goto doshell; - } - } - } else if (err == ENOEXEC) { /* Need to send to shell. */ - goto doshell; - } - } - if (rc < 0 && dowarn) - warn("Can't %s \"%s\": %s", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - Argv[0], Strerror(err)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ - } else + if (Argv[0]) + rc = do_spawn_ve(NULL, 0, execf); + else rc = -1; if (news) Safefree(news); do_execfree(); @@ -643,7 +724,8 @@ char *mode; dup2(newfd, *mode == 'r'); /* Return std* back. */ close(newfd); } - close(p[that]); + if (p[that] == (*mode == 'r')) + close(p[that]); if (pid == -1) { close(p[this]); return NULL; diff --git a/os2/perl2cmd.pl b/os2/perl2cmd.pl index e774f773d0..f9cc03bdac 100644 --- a/os2/perl2cmd.pl +++ b/os2/perl2cmd.pl @@ -23,7 +23,7 @@ foreach $file (<$idir/*>) { $base =~ s|.*/||; $file =~ s|/|\\|g ; print "Processing $file => $dir\\$base.cmd\n"; - system 'cmd.exe', '/c', "echo extproc perl -S >$dir\\$base.cmd"; + system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd"; system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd"; } @@ -208,9 +208,10 @@ perl_construct(register PerlInterpreter *sv_interp) localpatches = local_patches; /* For possible -v */ #endif - PerlIO_init(); /* Hook to IO system */ + PerlIO_init(); /* Hook to IO system */ - fdpid = newAV(); /* for remembering popen pids by fd */ + fdpid = newAV(); /* for remembering popen pids by fd */ + modglobal = newHV(); /* pointers to per-interpreter module globals */ DEBUG( { New(51,debname,128,char); @@ -327,6 +328,7 @@ perl_destruct(register PerlInterpreter *sv_interp) op_free(main_root); main_root = Nullop; } + curcop = &compiling; main_start = Nullop; SvREFCNT_dec(main_cv); main_cv = Nullcv; @@ -350,6 +352,12 @@ perl_destruct(register PerlInterpreter *sv_interp) SvREFCNT_dec(parsehook); parsehook = Nullsv; + /* call exit list functions */ + while (exitlistlen-- > 0) + exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr); + + Safefree(exitlist); + if (destruct_level == 0){ DEBUG_P(debprofdump()); @@ -551,6 +559,15 @@ perl_free(PerlInterpreter *sv_interp) Safefree(sv_interp); } +void +perl_atexit(void (*fn) (void *), void *ptr) +{ + Renew(exitlist, exitlistlen+1, PerlExitListEntry); + exitlist[exitlistlen].fn = fn; + exitlist[exitlistlen].ptr = ptr; + ++exitlistlen; +} + int perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env) { @@ -1193,7 +1210,8 @@ perl_call_sv(SV *sv, I32 flags) && (DBcv || (DBcv = GvCV(DBsub))) /* Try harder, since this may have been a sighandler, thus * curstash may be meaningless. */ - && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash)) + && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash) + && !(flags & G_NODEBUG)) op->op_private |= OPpENTERSUB_DB; if (flags & G_EVAL) { @@ -1451,7 +1469,7 @@ usage(char *name) /* XXX move this out into a module ? */ "-T turn on tainting checks", "-u dump core after parsing script", "-U allow unsafe operations", -"-v print version number and patchlevel of perl", +"-v print version number, patchlevel plus VERY IMPORTANT perl info", "-V[:variable] print perl configuration information", "-w TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT. Recommended.", "-x[directory] strip off text before #!perl line and perhaps cd to directory", @@ -1678,7 +1696,10 @@ moreswitches(char *s) #endif printf("\n\ Perl may be copied only under the terms of either the Artistic License or the\n\ -GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n"); +GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n\ +Complete documentation for Perl, including FAQ lists, should be found on\n\ +this system using `man perl' or `perldoc perl'. If you have access to the\n\ +Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n"); PerlProc_exit(0); case 'w': dowarn = TRUE; @@ -1785,201 +1806,9 @@ static void open_script(char *scriptname, bool dosearch, SV *sv) { dTHR; - char *xfound = Nullch; - char *xfailed = Nullch; register char *s; - I32 len; - int retval; -#if defined(DOSISH) && !defined(OS2) && !defined(atarist) -# define SEARCH_EXTS ".bat", ".cmd", NULL -# define MAX_EXT_LEN 4 -#endif -#ifdef OS2 -# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL -# define MAX_EXT_LEN 4 -#endif -#ifdef VMS -# define SEARCH_EXTS ".pl", ".com", NULL -# define MAX_EXT_LEN 4 -#endif - /* additional extensions to try in each dir if scriptname not found */ -#ifdef SEARCH_EXTS - char *ext[] = { SEARCH_EXTS }; - int extidx = 0, i = 0; - char *curext = Nullch; -#else -# define MAX_EXT_LEN 0 -#endif - - /* - * If dosearch is true and if scriptname does not contain path - * delimiters, search the PATH for scriptname. - * - * If SEARCH_EXTS is also defined, will look for each - * scriptname{SEARCH_EXTS} whenever scriptname is not found - * while searching the PATH. - * - * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search - * proceeds as follows: - * If DOSISH or VMSISH: - * + look for ./scriptname{,.foo,.bar} - * + search the PATH for scriptname{,.foo,.bar} - * - * If !DOSISH: - * + look *only* in the PATH for scriptname{,.foo,.bar} (note - * this will not look in '.' if it's not in the PATH) - */ - -#ifdef VMS -# ifdef ALWAYS_DEFTYPES - len = strlen(scriptname); - if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') { - int hasdir, idx = 0, deftypes = 1; - bool seen_dot = 1; - - hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ; -# else - if (dosearch) { - int hasdir, idx = 0, deftypes = 1; - bool seen_dot = 1; - - hasdir = (strpbrk(scriptname,":[</") != Nullch) ; -# endif - /* The first time through, just add SEARCH_EXTS to whatever we - * already have, so we can check for default file types. */ - while (deftypes || - (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) ) - { - if (deftypes) { - deftypes = 0; - *tokenbuf = '\0'; - } - if ((strlen(tokenbuf) + strlen(scriptname) - + MAX_EXT_LEN) >= sizeof tokenbuf) - continue; /* don't search dir with too-long name */ - strcat(tokenbuf, scriptname); -#else /* !VMS */ - -#ifdef DOSISH - if (strEQ(scriptname, "-")) - dosearch = 0; - if (dosearch) { /* Look in '.' first. */ - char *cur = scriptname; -#ifdef SEARCH_EXTS - if ((curext = strrchr(scriptname,'.'))) /* possible current ext */ - while (ext[i]) - if (strEQ(ext[i++],curext)) { - extidx = -1; /* already has an ext */ - break; - } - do { -#endif - DEBUG_p(PerlIO_printf(Perl_debug_log, - "Looking for %s\n",cur)); - if (PerlLIO_stat(cur,&statbuf) >= 0) { - dosearch = 0; - scriptname = cur; -#ifdef SEARCH_EXTS - break; -#endif - } -#ifdef SEARCH_EXTS - if (cur == scriptname) { - len = strlen(scriptname); - if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf)) - break; - cur = strcpy(tokenbuf, scriptname); - } - } while (extidx >= 0 && ext[extidx] /* try an extension? */ - && strcpy(tokenbuf+len, ext[extidx++])); -#endif - } -#endif - if (dosearch && !strchr(scriptname, '/') -#ifdef DOSISH - && !strchr(scriptname, '\\') -#endif - && (s = PerlEnv_getenv("PATH"))) { - bool seen_dot = 0; - - bufend = s + strlen(s); - while (s < bufend) { -#if defined(atarist) || defined(DOSISH) - for (len = 0; *s -# ifdef atarist - && *s != ',' -# endif - && *s != ';'; len++, s++) { - if (len < sizeof tokenbuf) - tokenbuf[len] = *s; - } - if (len < sizeof tokenbuf) - tokenbuf[len] = '\0'; -#else /* ! (atarist || DOSISH) */ - s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend, - ':', - &len); -#endif /* ! (atarist || DOSISH) */ - if (s < bufend) - s++; - if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf) - continue; /* don't search dir with too-long name */ - if (len -#if defined(atarist) || defined(DOSISH) - && tokenbuf[len - 1] != '/' - && tokenbuf[len - 1] != '\\' -#endif - ) - tokenbuf[len++] = '/'; - if (len == 2 && tokenbuf[0] == '.') - seen_dot = 1; - (void)strcpy(tokenbuf + len, scriptname); -#endif /* !VMS */ - -#ifdef SEARCH_EXTS - len = strlen(tokenbuf); - if (extidx > 0) /* reset after previous loop */ - extidx = 0; - do { -#endif - DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf)); - retval = PerlLIO_stat(tokenbuf,&statbuf); -#ifdef SEARCH_EXTS - } while ( retval < 0 /* not there */ - && extidx>=0 && ext[extidx] /* try an extension? */ - && strcpy(tokenbuf+len, ext[extidx++]) - ); -#endif - if (retval < 0) - continue; - if (S_ISREG(statbuf.st_mode) - && cando(S_IRUSR,TRUE,&statbuf) -#ifndef DOSISH - && cando(S_IXUSR,TRUE,&statbuf) -#endif - ) - { - xfound = tokenbuf; /* bingo! */ - break; - } - if (!xfailed) - xfailed = savepv(tokenbuf); - } -#ifndef DOSISH - if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0)) -#endif - seen_dot = 1; /* Disable message. */ - if (!xfound) - croak("Can't %s %s%s%s", - (xfailed ? "execute" : "find"), - (xfailed ? xfailed : scriptname), - (xfailed ? "" : " on PATH"), - (xfailed || seen_dot) ? "" : ", '.' not in PATH"); - if (xfailed) - Safefree(xfailed); - scriptname = xfound; - } + scriptname = find_script(scriptname, dosearch, NULL, 0); if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) { char *s = scriptname + 8; @@ -2491,7 +2320,7 @@ nuke_stacks(void) curstackinfo = curstackinfo->si_next; while (curstackinfo) { PERL_SI *p = curstackinfo->si_prev; - SvREFCNT_dec(curstackinfo->si_stack); + /* curstackinfo->si_stack got nuked by sv_free_arenas() */ Safefree(curstackinfo->si_cxstack); Safefree(curstackinfo); curstackinfo = p; @@ -2668,7 +2497,7 @@ init_perllib(void) ARCHLIB PRIVLIB SITEARCH and SITELIB */ #ifdef APPLLIB_EXP - incpush(APPLLIB_EXP, FALSE); + incpush(APPLLIB_EXP, TRUE); #endif #ifdef ARCHLIB_EXP @@ -2819,7 +2648,6 @@ init_main_thread() SvLEN_set(thrsv, sizeof(thr)); *SvEND(thrsv) = '\0'; /* in the trailing_nul field */ thr->oursv = thrsv; - curcop = &compiling; chopset = " \n-"; MUTEX_LOCK(&threads_mutex); @@ -2967,10 +2795,16 @@ my_failure_exit(void) STATUS_NATIVE_SET(vaxc$errno); } #else + int exitstatus; if (errno & 255) STATUS_POSIX_SET(errno); - else if (STATUS_POSIX == 0) - STATUS_POSIX_SET(255); + else { + exitstatus = STATUS_POSIX >> 8; + if (exitstatus & 255) + STATUS_POSIX_SET(exitstatus); + else + STATUS_POSIX_SET(255); + } #endif my_exit_jump(); } @@ -2978,7 +2812,7 @@ my_failure_exit(void) static void my_exit_jump(void) { - dTHR; + dSP; register PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -2993,6 +2827,7 @@ my_exit_jump(void) e_tmpname = Nullch; } + POPSTACK_TO(mainstack); if (cxstack_ix >= 0) { if (cxstack_ix > 0) dounwind(0); @@ -1654,6 +1654,12 @@ typedef enum { #define PERLVARI(var,type,init) type var; #define PERLVARIC(var,type,init) type var; +/* Interpreter exitlist entry */ +typedef struct exitlistentry { + void (*fn) _((void*)); + void *ptr; +} PerlExitListEntry; + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { #include "perlvars.h" @@ -2012,7 +2018,7 @@ enum { #endif /* OVERLOAD */ -#define PERLDB_ALL 0xff +#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */ #define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ #define PERLDBf_LINE 0x02 /* Keep line #. */ #define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */ @@ -2020,6 +2026,8 @@ enum { later inspections. */ #define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */ #define PERLDBf_SINGLE 0x20 /* Start with single-step on. */ +#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */ +#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */ #define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB)) #define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE)) @@ -2027,6 +2035,8 @@ enum { #define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) #define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) #define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) +#define PERLDB_SUB_NN (perldb && (perldb & (PERLDBf_NONAME))) +#define PERLDB_GOTO (perldb && (perldb & PERLDBf_GOTO)) #ifdef USE_LOCALE_NUMERIC @@ -2072,6 +2082,9 @@ enum { nice_chunk = (char*)(chunk); \ nice_chunk_size = (chunk_size); \ } \ + else { \ + Safefree(chunk); \ + } \ UNLOCK_SV_MUTEX; \ } while (0) diff --git a/perlsdio.h b/perlsdio.h index a539a0a3d9..efc52e1cd4 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -272,8 +272,14 @@ #define fputc(c,f) PerlIO_putc(f,c) #define fputs(s,f) PerlIO_puts(f,s) #define getc(f) PerlIO_getc(f) +#ifdef getc_unlocked +#undef getc_unlocked +#endif #define getc_unlocked(f) PerlIO_getc(f) #define putc(c,f) PerlIO_putc(f,c) +#ifdef putc_unlocked +#undef putc_unlocked +#endif #define putc_unlocked(c,f) PerlIO_putc(c,f) #define ungetc(c,f) PerlIO_ungetc(f,c) #if 0 diff --git a/pod/perl.pod b/pod/perl.pod index 41481a3bc4..a7e02f600e 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -21,6 +21,7 @@ of sections: perl Perl overview (this section) perldelta Perl changes since previous version perlfaq Perl frequently asked questions + perltoc Perl documentation table of contents perldata Perl data structures perlsyn Perl syntax diff --git a/pod/perlbook.pod b/pod/perlbook.pod index 9a725cb833..f5bf99dbba 100644 --- a/pod/perlbook.pod +++ b/pod/perlbook.pod @@ -12,13 +12,14 @@ an online order form. I<Programming Perl, Second Edition> is a reference work that covers nearly all of Perl, while I<Learning Perl, Second Edition> is a -tutorial that covers the most frequently used subset of the language. -You might also check out the very handy, inexpensive, and compact -I<Perl 5 Desktop Reference>, especially when the thought of lugging -the 676-page Camel around doesn't make much sense. I<Mastering -Regular Expressions>, by Jeffrey Friedl, is a reference work that -covers the art and implementation of regular expressions in various -languages including Perl. +tutorial that covers the most frequently used subset of the language, +and I<Advanced Perl Programming> is an indepth study of complex topics +including the internals of perl. You might also check out the very +handy, inexpensive, and compact I<Perl 5 Desktop Reference>, especially +when the thought of lugging the 676-page Camel around doesn't make much +sense. I<Mastering Regular Expressions>, by Jeffrey Friedl, is a +reference work that covers the art and implementation of regular +expressions in various languages including Perl. Programming Perl, Second Edition (the Camel Book): ISBN 1-56592-149-6 (English) @@ -26,6 +27,9 @@ languages including Perl. Learning Perl, Second Edition (the Llama Book): ISBN 1-56592-284-0 (English) + Advanced Perl Programming: + ISBN 1-56592-220-4 (English) + Perl 5 Desktop Reference (the reference card): ISBN 1-56592-187-9 (brief English) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 96f5c671ea..dedde649a6 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2565,6 +2565,11 @@ have been defined yet. See L<perlfunc/sort>. (F) The format indicated doesn't seem to exist. Perhaps it's really in another package? See L<perlform>. +=item Undefined value assigned to typeglob + +(W) An undefined value was assigned to a typeglob, a la C<*foo = undef>. +This does nothing. It's possible that you really mean C<undef *foo>. + =item unexec of %s into %s failed! (F) The unexec() routine failed for some reason. See your local FSF diff --git a/pod/perldsc.pod b/pod/perldsc.pod index 48750dd5de..cd689e37bc 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -305,7 +305,7 @@ debugger includes several new features, including command line editing as well as the C<x> command to dump out complex data structures. For example, given the assignment to $LoL above, here's the debugger output: - DB<1> X $LoL + DB<1> x $LoL $LoL = ARRAY(0x13b5a0) 0 ARRAY(0x1f0a24) 0 'fred' @@ -324,8 +324,6 @@ example, given the assignment to $LoL above, here's the debugger output: 2 'elroy' 3 'judy' -There's also a lowercase B<x> command which is nearly the same. - =head1 CODE EXAMPLES Presented with little comment (these will get their own manpages someday) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 9f07355743..1a5e0e6846 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -863,7 +863,9 @@ is just like except that it's more efficient, more concise, keeps track of the current filename for error messages, and searches all the B<-I> libraries if the file isn't in the current directory (see also the @INC -array in L<perlvar/Predefined Names>). It's the same, however, in that it does +array in L<perlvar/Predefined Names>). It is also different in how +code evaluated with C<do FILENAME> doesn't see lexicals in the enclosing +scope like C<eval STRING> does. It's the same, however, in that it does reparse the file every time you call it, so you probably don't want to do this inside a loop. @@ -1074,6 +1076,8 @@ in case 6. =item exec LIST +=item exec PROGRAM LIST + The exec() function executes a system command I<AND NEVER RETURNS> - use system() instead of exec() if you want it to return. It fails and returns FALSE only if the command does not exist I<and> it is executed @@ -1182,6 +1186,12 @@ that doesn't implement flock(2), fcntl(2) locking, or lockf(3). flock() is Perl's portable file locking interface, although it locks only entire files, not records. +On many platforms (including most versions or clones of Unix), locks +established by flock() are B<merely advisory>. This means that files +locked with flock() may be modified by programs which do not also use +flock(). Windows NT and OS/2, however, are among the platforms which +supply mandatory locking. See your local documentation for details. + OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but you can use the symbolic names if import them from the Fcntl module, @@ -1827,10 +1837,18 @@ In a scalar context, returns the ctime(3) value: $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" -This scalar value is B<not> locale dependent, see L<perllocale>, -but instead a Perl builtin. -Also see the Time::Local module, and the strftime(3) and mktime(3) -function available via the POSIX module. +This scalar value is B<not> locale dependent, see L<perllocale>, but +instead a Perl builtin. Also see the Time::Local module, and the +strftime(3) and mktime(3) function available via the POSIX module. To +get somewhat similar but locale dependent date strings, set up your +locale environment variables appropriately (please see L<perllocale>) +and try for example + + use POSIX qw(strftime) + $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime; + +Note that the C<%a> and C<%b>, the short forms of the day of the week +and the month of the year, may not necessarily be three characters wide. =item log EXPR @@ -2375,7 +2393,8 @@ you will have to use a block returning its value instead: =item printf FORMAT, LIST -Equivalent to C<print FILEHANDLE sprintf(FORMAT, LIST)>. The first argument +Equivalent to C<print FILEHANDLE sprintf(FORMAT, LIST)>, except that $\ +(the output record separator) is not appended. The first argument of the list will be interpreted as the printf format. If C<use locale> is in effect, the character used for the decimal point in formatted real numbers is affected by the LC_NUMERIC locale. See L<perllocale>. @@ -2506,7 +2525,7 @@ operator is discussed in more detail in L<perlop/"I/O Operators">. Receives a message on a socket. Attempts to receive LENGTH bytes of data into variable SCALAR from the specified SOCKET filehandle. -Actually does a C recvfrom(), so that it can returns the address of the +Actually does a C recvfrom(), so that it can return the address of the sender. Returns the undefined value if there's an error. SCALAR will be grown or shrunk to the length actually read. Takes the same flags as the system call of the same name. @@ -3110,10 +3129,12 @@ sanity checks in the interest of speed. =item splice ARRAY,OFFSET Removes the elements designated by OFFSET and LENGTH from an array, and -replaces them with the elements of LIST, if any. Returns the elements -removed from the array. The array grows or shrinks as necessary. If -LENGTH is omitted, removes everything from OFFSET onward. The -following equivalences hold (assuming C<$[ == 0>): +replaces them with the elements of LIST, if any. In a list context, +returns the elements removed from the array. In a scalar context, +returns the last element removed, or C<undef> if no elements are +removed. The array grows or shrinks as necessary. If LENGTH is +omitted, removes everything from OFFSET onward. The following +equivalences hold (assuming C<$[ == 0>): push(@a,$x,$y) splice(@a,$#a+1,0,$x,$y) pop(@a) splice(@a,-1) @@ -3268,7 +3289,7 @@ and the conversion letter: + prefix positive number with a plus sign - left-justify within the field 0 use zeros, not spaces, to right-justify - # prefix octal with "0", hex with "0x" + # prefix non-zero octal with "0", non-zero hex with "0x" number minimum field width .number "precision": digits after decimal point for floating-point, max length for string, minimum length for integer @@ -3494,13 +3515,17 @@ unimplemented, produces a fatal error. The arguments are interpreted as follows: if a given argument is numeric, the argument is passed as an int. If not, the pointer to the string value is passed. You are responsible to make sure a string is pre-extended long enough to -receive any result that might be written into a string. If your +receive any result that might be written into a string. You can't use a +string literal (or other read-only string) as an argument to syscall() +because Perl has to assume that any string pointer might be written +through. If your integer arguments are not literals and have never been interpreted in a numeric context, you may need to add 0 to them to force them to look like numbers. require 'syscall.ph'; # may need to run h2ph - syscall(&SYS_write, fileno(STDOUT), "hi there\n", 9); + $s = "hi there\n"; + syscall(&SYS_write, fileno(STDOUT), $s, length $s); Note that Perl supports passing of up to only 14 arguments to your system call, which in practice should usually suffice. @@ -3578,6 +3603,8 @@ the new position. =item system LIST +=item system PROGRAM LIST + Does exactly the same thing as "exec LIST" except that a fork is done first, and the parent process waits for the child process to complete. Note that argument processing varies depending on the number of @@ -3587,6 +3614,9 @@ returned by the wait() call. To get the actual exit value divide by the output from a command, for that you should use merely backticks or qx//, as described in L<perlop/"`STRING`">. +Like exec(), system() allows you to lie to a program about its name if +you use the "system PROGRAM LIST" syntax. Again, see L</exec>. + Because system() and backticks block SIGINT and SIGQUIT, killing the program they're running doesn't actually interrupt your program. @@ -3744,7 +3774,8 @@ The transliteration operator. Same as y///. See L<perlop>. Truncates the file opened on FILEHANDLE, or named by EXPR, to the specified length. Produces a fatal error if truncate isn't implemented -on your system. +on your system. Returns TRUE if successful, the undefined value +otherwise. =item uc EXPR @@ -3780,19 +3811,21 @@ digits. See also L</oct>, if all you have is a string. =item undef Undefines the value of EXPR, which must be an lvalue. Use only on a -scalar value, an entire array, an entire hash, or a subroutine name (using -"&"). (Using undef() will probably not do what you expect on most -predefined variables or DBM list values, so don't do that.) Always -returns the undefined value. You can omit the EXPR, in which case -nothing is undefined, but you still get an undefined value that you -could, for instance, return from a subroutine, assign to a variable or -pass as a parameter. Examples: +scalar value, an array (using "@"), a hash (using "%"), a subroutine +(using "&"), or a typeglob (using "*"). (Saying C<undef $hash{$key}> +will probably not do what you expect on most predefined variables or +DBM list values, so don't do that; see L<delete>.) Always returns the +undefined value. You can omit the EXPR, in which case nothing is +undefined, but you still get an undefined value that you could, for +instance, return from a subroutine, assign to a variable or pass as a +parameter. Examples: undef $foo; undef $bar{'blurfl'}; # Compare to: delete $bar{'blurfl'}; undef @ary; undef %hash; undef &mysub; + undef *xyz; # destroys $xyz, @xyz, %xyz, &xyz, etc. return (wantarray ? (undef, $errmsg) : undef) if $they_blew_it; select undef, undef, undef, 0.25; ($a, $b, undef, $c) = &foo; # Ignore third value returned @@ -3941,7 +3974,8 @@ Changes the access and modification times on each file of a list of files. The first two elements of the list must be the NUMERICAL access and modification times, in that order. Returns the number of files successfully changed. The inode modification time of each file is set -to the current time. Example of a "touch" command: +to the current time. This code has the same effect as the "touch" +command if the files already exist: #!/usr/bin/perl $now = time; @@ -4016,6 +4050,13 @@ for no value (void context). Produces a message on STDERR just like die(), but doesn't exit or throw an exception. +If LIST is empty and $@ already contains a value (typically from a +previous eval) that value is used after appending "\t...caught" +to $@. This is useful for staying almost, but not entirely similar to +die(). + +If $@ is empty then the string "Warning: Something's wrong" is used. + No message is printed if there is a C<$SIG{__WARN__}> handler installed. It is the handler's responsibility to deal with the message as it sees fit (like, for instance, converting it into a die()). Most diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 9b7cab627e..6edb8b80e1 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -51,6 +51,7 @@ To change the value of an *already-existing* SV, there are seven routines: void sv_setpv(SV*, char*); void sv_setpvn(SV*, char*, int) void sv_setpvf(SV*, const char*, ...); + void sv_setpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool); void sv_setsv(SV*, SV*); Notice that you can choose to specify the length of the string to be @@ -58,13 +59,25 @@ assigned by using C<sv_setpvn>, C<newSVpvn>, or C<newSVpv>, or you may allow Perl to calculate the length by using C<sv_setpv> or by specifying 0 as the second argument to C<newSVpv>. Be warned, though, that Perl will determine the string's length by using C<strlen>, which depends on the -string terminating with a NUL character. The arguments of C<sv_setpvf> -are processed like C<sprintf>, and the formatted output becomes the value. +string terminating with a NUL character. + +The arguments of C<sv_setpvf> are processed like C<sprintf>, and the +formatted output becomes the value. + +C<sv_setpvfn> is an analogue of C<vsprintf>, but it allows you to specify +either a pointer to a variable argument list or the address and length of +an array of SVs. The last argument points to a boolean; on return, if that +boolean is true, then locale-specific information has been used to format +the string, and the string's contents are therefore untrustworty (see +L<perlsec>). This pointer may be NULL if that information is not +important. Note that this function requires you to specify the length of +the format. + The C<sv_set*()> functions are not generic enough to operate on values that have "magic". See L<Magic Virtual Tables> later in this document. -All SVs that will contain strings should, but need not, be terminated -with a NUL character. If it is not NUL-terminated there is a risk of +All SVs that contain strings should be terminated with a NUL character. +If it is not NUL-terminated there is a risk of core dumps and corruptions from code which passes the string to C functions or system calls which expect a NUL-terminated string. Perl's own functions typically add a trailing NUL for this reason. @@ -127,16 +140,20 @@ you can use the following functions: void sv_catpv(SV*, char*); void sv_catpvn(SV*, char*, int); void sv_catpvf(SV*, const char*, ...); + void sv_catpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool); void sv_catsv(SV*, SV*); The first function calculates the length of the string to be appended by using C<strlen>. In the second, you specify the length of the string yourself. The third function processes its arguments like C<sprintf> and -appends the formatted output. The fourth function extends the string -stored in the first SV with the string stored in the second SV. It also -forces the second SV to be interpreted as a string. The C<sv_cat*()> -functions are not generic enough to operate on values that have "magic". -See L<Magic Virtual Tables> later in this document. +appends the formatted output. The fourth function works like C<vsprintf>. +You can specify the address and length of an array of SVs instead of the +va_list argument. The fifth function extends the string stored in the first +SV with the string stored in the second SV. It also forces the second SV +to be interpreted as a string. + +The C<sv_cat*()> functions are not generic enough to operate on values that +have "magic". See L<Magic Virtual Tables> later in this document. If you know the name of a scalar variable, you can get a pointer to its SV by using the following: @@ -473,8 +490,25 @@ Perl calculate the string length. SV is blessed if C<classname> is non-null. SV* sv_setref_pvn(SV* rv, char* classname, PV iv, int length); - int sv_isa(SV* sv, char* name); - int sv_isobject(SV* sv); +Tests whether the SV is blessed into the specified class. It does not +check inheritance relationships. + + int sv_isa(SV* sv, char* name); + +Tests whether the SV is a reference to a blessed object. + + int sv_isobject(SV* sv); + +Tests whether the SV is derived from the specified class. SV can be either +a reference to a blessed object or a string containing a class name. This +is the function implementing the C<UNIVERSAL::isa> functionality. + + bool sv_derived_from(SV* sv, char* name); + +To check if you've got an object derived from a specific class you have +to write: + + if (sv_isobject(sv) && sv_derived_from(sv, class)) { ... } =head2 Creating New Variables @@ -580,8 +614,7 @@ including (but not limited to) the following: Scalar Value Array Value Hash Value - File Handle - Directory Handle + I/O Handle Format Subroutine @@ -1393,7 +1426,7 @@ created. =head2 Compile pass 2: context propagation When a context for a part of compile tree is known, it is propagated -down through the tree. Aat this time the context can have 5 values +down through the tree. At this time the context can have 5 values (instead of 2 for runtime context): void, boolean, scalar, list, and lvalue. In contrast with the pass 1 this pass is processed from top to bottom: a node's context determines the context for its children. @@ -1590,6 +1623,13 @@ to indicate the number of items on the stack. Sets up the C<ix> variable for an XSUB which has aliases. This is usually handled automatically by C<xsubpp>. +=item do_binmode + +Switches filehandle to binmode. C<iotype> is what C<IoTYPE(io)> would +contain. + + do_binmode(fp, iotype, TRUE); + =item ENTER Opening bracket on a callback. See C<LEAVE> and L<perlcall>. @@ -1888,10 +1928,13 @@ Prepares a starting point to traverse a hash table. I32 hv_iterinit (HV* tb) -Note that hv_iterinit I<currently> returns the number of I<buckets> in -the hash and I<not> the number of keys (as indicated in the Advanced -Perl Programming book). This may change in future. Use the HvKEYS(hv) -macro to find the number of keys in a hash. +Returns the number of keys in the hash (i.e. the same as C<HvKEYS(tb)>). +The return value is currently only meaningful for hashes without tie +magic. + +NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number +of hash buckets that happen to be in use. If you still need that +esoteric value, you can get it through the macro C<HvFILL(tb)>. =item hv_iterkey @@ -2667,6 +2710,14 @@ specified class. int sv_derived_from(SV* sv, char* class) +=item sv_derived_from + +Returns a boolean indicating whether the SV is derived from the specified +class. This is the function that implements C<UNIVERSAL::isa>. It works +for class names as well as for objects. + + bool sv_derived_from _((SV* sv, char* name)); + =item SvEND Returns a pointer to the last character in the string which is in the SV. @@ -2751,7 +2802,7 @@ B<private> setting. Use C<SvIOK>. =item sv_isa Returns a boolean indicating whether the SV is blessed into the specified -class. This does not know how to check for subtype, so it doesn't work in +class. This does not check for subtypes; use C<sv_derived_from> to verify an inheritance relationship. int sv_isa (SV* sv, char* name) @@ -2768,8 +2819,8 @@ will return false. Returns the integer which is in the SV. - int SvIV (SV* sv) - + int SvIV (SV* sv) + =item SvIVX Returns the integer which is stored in the SV. @@ -3281,6 +3332,25 @@ Like C<sv_usepvn>, but also handles 'set' magic. void sv_usepvn_mg (SV* sv, char* ptr, STRLEN len) +=item sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) + +Processes its arguments like C<vsprintf> and appends the formatted output +to an SV. Uses an array of SVs if the C style variable argument list is +missing (NULL). Indicates if locale information has been used for formatting. + + void sv_catpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list *args, SV **svargs, I32 svmax, + bool *used_locale)); + +=item sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) + +Works like C<vcatpvfn> but copies the text into the SV instead of +appending it. + + void sv_setpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list *args, SV **svargs, I32 svmax, + bool *used_locale)); + =item SvUV Returns the unsigned integer which is in the SV. diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 163fe03984..cbbe0b9cac 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -6,7 +6,7 @@ perlhist - the Perl history records =for RCS # -# $Id: perlhist.pod,v 1.29 1998/02/19 15:49:17 jhi Exp $ +# $Id: perlhist.pod,v 1.31 1998/03/10 16:39:28 jhi Exp $ # =end RCS @@ -18,8 +18,8 @@ This document aims to record the Perl source code releases. Perl history in brief, by Larry Wall: - Perl 0 introduced Perl to my officemates. - Perl 1 introduced Perl to the world, and changed /\(...\|...\)/ to + Perl 0 introduced Perl to my officemates. + Perl 1 introduced Perl to the world, and changed /\(...\|...\)/ to /(...|...)/. \(Dan Faigin still hasn't forgiven me. :-\) Perl 2 introduced Henry Spencer's regular expression package. Perl 3 introduced the ability to handle binary data (embedded nulls). @@ -30,8 +30,8 @@ Perl history in brief, by Larry Wall: =head1 THE KEEPERS OF THE PUMPKIN -Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick -Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie. +Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, +Nick Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie. =head2 PUMPKIN? @@ -269,6 +269,9 @@ the pumpking or the pumpkineer. 5.004_57 1998-Feb-03 5.004_58 1998-Feb-06 5.004_59 1998-Feb-13 + 5.004_60 1998-Feb-20 + 5.004_61 1998-Feb-27 + 5.004_62 1998-Mar-06 =head2 SELECTED RELEASE SIZES @@ -305,6 +308,7 @@ explained below. 5.004_53 1422 62 1295 141 438 70 394 162 1637 56 5.004_56 1501 66 1301 140 447 74 408 165 1648 57 5.004_59 1555 72 1317 142 448 74 424 171 1678 58 + 5.004_62 1602 77 1327 144 629 92 428 173 1674 58 The "core"..."doc" mean the following files from the Perl source code distribution. The glob notation ** means recursively, (.) means @@ -360,22 +364,22 @@ the Perl source distribution for somewhat more selected releases. ====================================================================== - 5.003_07 5.004 5.004_04 5.004_59 + 5.003_07 5.004 5.004_04 5.004_62 - Configure 217 1 225 1 225 1 240 1 + Configure 217 1 225 1 225 1 240 1 cygwin32 - - 23 5 23 5 23 5 - djgpp - - - - - - 15 5 + djgpp - - - - - - 14 5 eg 54 44 81 62 81 62 81 62 emacs 143 1 194 1 204 1 212 2 h2pl 12 12 12 12 12 12 12 12 - hints 90 62 129 69 132 71 139 72 - os2 117 42 121 42 127 42 134 44 + hints 90 62 129 69 132 71 144 72 + os2 117 42 121 42 127 42 127 44 plan9 79 15 82 15 82 15 82 15 - Porting 51 1 94 2 109 4 109 4 + Porting 51 1 94 2 109 4 203 6 qnx - - 1 2 1 2 1 2 - utils 97 7 112 8 118 8 123 8 - vms 505 27 518 34 524 34 536 34 - win32 - - 285 33 378 36 464 39 + utils 97 7 112 8 118 8 124 8 + vms 505 27 518 34 524 34 538 34 + win32 - - 285 33 378 36 470 39 x2p 280 19 281 19 281 19 281 19 =head2 SELECTED PATCH SIZES @@ -436,7 +440,7 @@ context diff output format. p54rc1 1997-May-12 8 1 11 p54rc2 1997-May-14 6 0 40 - 5.004 1997-May-15 4 0 4 + 5.004 1997-May-15 4 0 4 Tim 5.004_01 1997-Jun-13 222 14 57 5.004_02 1997-Aug-07 112 16 119 diff --git a/pod/perlop.pod b/pod/perlop.pod index 5d1aae79a6..4781b7fbbe 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -569,7 +569,7 @@ the same character fore and aft, but the 4 sorts of brackets Note that there can be whitespace between the operator and the quoting characters, except when C<#> is being used as the quoting character. -C<q#foo#> is parsed as being the string C<foo>, which C<q #foo#> is the +C<q#foo#> is parsed as being the string C<foo>, while C<q #foo#> is the operator C<q> followed by a comment. Its argument will be taken from the next line. This allows you to write: @@ -670,7 +670,7 @@ C</o> constitutes a promise that you won't change the variables in the pattern. If you change them, Perl won't even notice. If the PATTERN evaluates to a null string, the last -successfully executed regular expression is used instead. +successfully matched regular expression is used instead. If used in a context that requires a list value, a pattern match returns a list consisting of the subexpressions matched by the parentheses in the diff --git a/pod/perlre.pod b/pod/perlre.pod index 373e1ca84e..95da75d95f 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -278,16 +278,16 @@ matches a word followed by a tab, without including the tab in C<$&>. A zero-width negative lookahead assertion. For example C</foo(?!bar)/> matches any occurrence of "foo" that isn't followed by "bar". Note however that lookahead and lookbehind are NOT the same thing. You cannot -use this for lookbehind: C</(?!foo)bar/> will not find an occurrence of -"bar" that is preceded by something which is not "foo". That's because +use this for lookbehind. If you are looking for a "bar" which isn't preceeded +"foo", C</(?!foo)bar/> will not do what you want. That's because the C<(?!foo)> is just saying that the next thing cannot be "foo"--and it's not, it's a "bar", so "foobar" will match. You would have to do something like C</(?!foo)...bar/> for that. We say "like" because there's the case of your "bar" not having three characters before it. You could -cover that this way: C</(?:(?!foo)...|^..?)bar/>. Sometimes it's still +cover that this way: C</(?:(?!foo)...|^.{0,2})bar/>. Sometimes it's still easier just to say: - if (/foo/ && $` =~ /bar$/) + if (/bar/ && $` !~ /foo$/) For lookbehind see below. @@ -653,9 +653,18 @@ first alternative includes everything from the last pattern delimiter the last alternative contains everything from the last "|" to the next pattern delimiter. For this reason, it's common practice to include alternatives in parentheses, to minimize confusion about where they -start and end. Note however that "|" is interpreted as a literal with -square brackets, so if you write C<[fee|fie|foe]> you're really only -matching C<[feio|]>. +start and end. + +Note that alternatives are tried from left to right, so the first +alternative found for which the entire expression matches, is the one that +is chosen. This means that alternatives are not necessarily greedy. For +example: when mathing C<foo|foot> against "barefoot", only the "foo" +part will match, as that is the first alternative tried, and it successfully +matches the target string. (This might not seem important, but it is +important when you are capturing matched text using parentheses.) + +Also note that "|" is interpreted as a literal within square brackets, +so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>. Within a pattern, you may designate subpatterns for later reference by enclosing them in parentheses, and you may refer back to the I<n>th @@ -695,4 +704,10 @@ different things on the I<left> side of the C<s///>. =head2 SEE ALSO +L<perlop/"Regexp Quote-Like Operators">. + +L<perlfunc/pos>. + +L<perllocale>. + "Mastering Regular Expressions" (see L<perlbook>) by Jeffrey Friedl. diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 87173492d1..4bb55bceeb 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -29,7 +29,8 @@ Specified line by line via B<-e> switches on the command line. =item 2. Contained in the file specified by the first filename on the command line. -(Note that systems supporting the #! notation invoke interpreters this way.) +(Note that systems supporting the #! notation invoke interpreters this +way. See L<Location of Perl>.) =item 3. @@ -72,7 +73,7 @@ The sequences "-*" and "- " are specifically ignored so that you could, if you were so inclined, say #!/bin/sh -- # -*- perl -*- -p - eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' if $running_under_some_shell; to let Perl see the B<-p> switch. @@ -170,6 +171,19 @@ characters as control characters. There is no general solution to all of this. It's just a mess. +=head2 Location of Perl + +It may seem obvious to say, but Perl is useful only when users can +easily find it. When possible, it's good for both B</usr/bin/perl> and +B</usr/local/bin/perl> to be symlinks to the actual binary. If that +can't be done, system administrators are strongly encouraged to put +(symlinks to) perl and its accompanying utilities, such as perldoc, into +a directory typically found along a user's PATH, or in another obvious +and convenient place. + +In this documentation, C<#!/usr/bin/perl> on the first line of the script +will stand in for whatever method works on your system. + =head2 Switches A single-character switch may be combined with the following switch, if @@ -448,7 +462,7 @@ original name fails, and if the name does not already end in one of those suffixes. If your Perl was compiled with DEBUGGING turned on, using the -Dp switch to Perl shows how the search progresses. -If the file supplied contains directory separators (i.e. it is an +If the filename supplied contains directory separators (i.e. it is an absolute or relative pathname), and if the file is not found, platforms that append file extensions will do so and try to look for the file with those extensions added, one by one. @@ -463,7 +477,7 @@ don't support #!. This example works on many platforms that have a shell compatible with Bourne shell: #!/usr/bin/perl - eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' if $running_under_some_shell; The system ignores the first line and feeds the script to /bin/sh, @@ -473,24 +487,27 @@ starts up the Perl interpreter. On some systems $0 doesn't always contain the full pathname, so the B<-S> tells Perl to search for the script if necessary. After Perl locates the script, it parses the lines and ignores them because the variable $running_under_some_shell -is never true. A better construct than C<$*> would be C<${1+"$@"}>, which -handles embedded spaces and such in the filenames, but doesn't work if -the script is being interpreted by csh. To start up sh rather +is never true. If the script will be interpreted by csh, you will need +to replace C<${1+"$@"}> with C<$*>, even though that doesn't understand +embedded spaces (and such) in the argument list. To start up sh rather than csh, some systems may have to replace the #! line with a line containing just a colon, which will be politely ignored by Perl. Other systems can't control that, and need a totally devious construct that will work under any of csh, sh, or Perl, such as the following: - eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - & eval 'exec /usr/bin/perl -S $0 $argv:q' + eval '(exit $?0)' && eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' + & eval 'exec /usr/bin/perl -wS $0 $argv:q' if $running_under_some_shell; =item B<-T> -forces "taint" checks to be turned on so you can test them. Ordinarily these checks are -done only when running setuid or setgid. It's a good idea to turn -them on explicitly for programs run on another's behalf, such as CGI -programs. See L<perlsec>. +forces "taint" checks to be turned on so you can test them. Ordinarily +these checks are done only when running setuid or setgid. It's a good +idea to turn them on explicitly for programs run on another's behalf, +such as CGI programs. See L<perlsec>. Note that (for security reasons) +this option must be seen by Perl quite early; usually this means it must +appear early on the command line or in the #! line (for systems which +support that). =item B<-u> @@ -619,8 +636,8 @@ look in COMSPEC to find a shell fit for interactive use). =item PERL_DEBUG_MSTATS Relevant only if perl is compiled with the malloc included with the perl -distribution (that is, if C<perl -V:d_mymalloc> is 'define'), -if set, this causes memory statistics to be dumped after execution. If set +distribution (that is, if C<perl -V:d_mymalloc> is 'define'). +If set, this causes memory statistics to be dumped after execution. If set to an integer greater than one, also causes memory statistics to be dumped after compilation. diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 73884790b0..3fd903412d 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -36,7 +36,9 @@ L<perllocale>), results of certain system calls (readdir, readlink, the gecos field of getpw* calls), and all file input are marked as "tainted". Tainted data may not be used directly or indirectly in any command that invokes a sub-shell, nor in any command that modifies -files, directories, or processes. Any variable set +files, directories, or processes. (B<Important exception>: If you pass +a list of arguments to either C<system> or C<exec>, the elements of +that list are B<NOT> checked for taintedness.) Any variable set to a value derived from tainted data will itself be tainted, even if it is logically impossible for the tainted data to alter the variable. Because taintedness is associated with each @@ -88,7 +90,7 @@ For example: If you try to do something insecure, you will get a fatal error saying something like "Insecure dependency" or "Insecure PATH". Note that you can still write an insecure B<system> or B<exec>, but only by explicitly -doing something like the last example above. +doing something like the "considered secure" example above. =head2 Laundering and Detecting Tainted Data @@ -173,6 +175,14 @@ guarantee that the executable in question isn't itself going to turn around and execute some other program that is dependent on your PATH, it makes sure you set the PATH. +The PATH isn't the only environment variable which can cause problems. +Because some shells may use the variables IFS, CDPATH, ENV, and +BASH_ENV, Perl checks that those are either empty or untainted when +starting subprocesses. You may wish to add something like this to your +setid and taint-checking scripts. + + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer + It's also possible to get into trouble with other operations that don't care whether they use tainted values. Make judicious use of the file tests in dealing with any user-supplied filenames. When possible, do diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index f7913700db..1d0f5d694f 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -47,7 +47,7 @@ subroutine without defining it by saying C<sub name>, thus: Note that it functions as a list operator, not as a unary operator; so be careful to use C<or> instead of C<||> in this case. However, if you were to declare the subroutine as C<sub myname ($)>, then -C<myname> would functonion as a unary operator, so either C<or> or +C<myname> would function as a unary operator, so either C<or> or C<||> would work. Subroutines declarations can also be loaded up with the C<require> statement diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 02abc3b03b..9d861e3ae5 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -757,15 +757,11 @@ variable is localized subsequent to the assignment # perl4 prints: This is Perl 4 # perl5 prints: - # Another example - - *fred = *barney; # fred is aliased to barney - @barney = (1, 2, 4); - # @fred; - print "@fred"; # should print "1, 2, 4" +=item * (Globs) - # perl4 prints: 1 2 4 - # perl5 prints: In string, @fred now must be written as \@fred +Assigning C<undef> to a glob has no effect in Perl 5. In Perl 4 +it undefines the associated scalar (but may have other side effects +including SEGVs). =item * (Scalar String) diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 221947b508..36b4ec47b6 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -689,7 +689,7 @@ run-time only. This is a new mechanism and the details may change. Current state of the interpreter. Undefined if parsing of the current module/eval is not finished (may happen in $SIG{__DIE__} and -$SIG{__WARN__} handlers). True if inside an eval, othewise false. +$SIG{__WARN__} handlers). True if inside an eval, otherwise false. =item $BASETIME diff --git a/pod/pod2latex.PL b/pod/pod2latex.PL index 1d188099cb..ff8bca691f 100644 --- a/pod/pod2latex.PL +++ b/pod/pod2latex.PL @@ -475,6 +475,9 @@ while (<POD>) { elsif ($cmd eq 'pod') { ; # recognise the pod directive, as no op (hs) } + elsif ($cmd eq 'pod') { + ; # recognise the pod directive, as no op (hs) + } else { warn "Unrecognized directive: $cmd\n"; } diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 5e5dfb0b66..a91d3e585e 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -315,7 +315,7 @@ $cutting = 1; # We try first to get the version number from a local binary, in case we're # running an installed version of Perl to produce documentation from an # uninstalled newer version's pod files. -if ($^O ne 'plan9' && $^O ne 'dos') { +if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { ($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/; } @@ -442,8 +442,13 @@ PP(pp_refgen) { djSP; dMARK; if (GIMME != G_ARRAY) { - MARK[1] = *SP; - SP = MARK + 1; + if (++MARK <= SP) + *MARK = *SP; + else + *MARK = &sv_undef; + *MARK = refto(*MARK); + SP = MARK; + RETURN; } EXTEND_MORTAL(SP - MARK); while (++MARK <= SP) @@ -769,7 +774,17 @@ PP(pp_undef) break; case SVt_PVGV: if (SvFAKE(sv)) - sv_setsv(sv, &sv_undef); + SvSetMagicSV(sv, &sv_undef); + else { + GP *gp; + gp_free((GV*)sv); + Newz(602, gp, 1, GP); + GvGP(sv) = gp_ref(gp); + GvSV(sv) = NEWSV(72,0); + GvLINE(sv) = curcop->cop_line; + GvEGV(sv) = (GV*)sv; + GvMULTI_on(sv); + } break; default: if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { @@ -1776,6 +1791,7 @@ PP(pp_substr) char *tmps; I32 arybase = curcop->cop_arybase; + SvTAINTED_off(TARG); /* decontaminate */ if (MAXARG > 2) len = POPi; pos = POPi; @@ -1864,6 +1880,7 @@ PP(pp_vec) unsigned long retnum; I32 len; + SvTAINTED_off(TARG); /* decontaminate */ offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; if (offset < 0 || size < 1) @@ -3211,6 +3228,13 @@ PP(pp_unpack) Copy(s, &aint, 1, int); s += sizeof(int); sv = NEWSV(40, 0); +#ifdef __osf__ + /* Without the dummy below unpack("i", pack("i",-1)) + * return 0xFFffFFff instead of -1 for Digital Unix V4.0 + * cc with optimization turned on */ + (aint) ? + sv_setiv(sv, (IV)aint) : +#endif sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } @@ -86,11 +86,10 @@ PP(pp_regcomp) { else { t = SvPV(tmpstr, len); - /* JMR: Check against the last compiled regexp - To know for sure, we'd need the length of precomp. - But we don't have it, so we must ... take a guess. */ + /* Check against the last compiled regexp. */ if (!pm->op_pmregexp || !pm->op_pmregexp->precomp || - memNE(pm->op_pmregexp->precomp, t, len + 1)) + pm->op_pmregexp->prelen != len || + memNE(pm->op_pmregexp->precomp, t, len)) { if (pm->op_pmregexp) { ReREFCNT_dec(pm->op_pmregexp); @@ -652,8 +651,9 @@ PP(pp_sort) RETPUSHUNDEF; } + ENTER; + SAVEPPTR(sortcop); if (op->op_flags & OPf_STACKED) { - ENTER; if (op->op_flags & OPf_SPECIAL) { OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */ kid = kUNOP->op_first; /* pass rv2gv */ @@ -740,7 +740,6 @@ PP(pp_sort) POPSTACK(); CATCH_SET(oldcatch); } - LEAVE; } else { if (max > 1) { @@ -749,6 +748,7 @@ PP(pp_sort) (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp); } } + LEAVE; stack_sp = ORIGMARK + max; return nextop; } @@ -1059,8 +1059,10 @@ die_where(char *message) else sv_setpv(ERRSV, message); - while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) + while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) { + dounwind(-1); POPSTACK(); + } if (cxix >= 0) { I32 optype; @@ -1874,14 +1876,26 @@ PP(pp_goto) mark++; } } - if (PERLDB_SUB && curstash != debstash) { + if (PERLDB_SUB) { /* Checking curstash breaks DProf. */ /* * We do not care about using sv to call CV; * it's for informational purposes only. */ SV *sv = GvSV(DBsub); - save_item(sv); - gv_efullname3(sv, CvGV(cv), Nullch); + CV *gotocv; + + if (PERLDB_SUB_NN) { + SvIVX(sv) = (IV)cv; /* Already upgraded, saved */ + } else { + save_item(sv); + gv_efullname3(sv, CvGV(cv), Nullch); + } + if ( PERLDB_GOTO + && (gotocv = perl_get_cv("DB::goto", FALSE)) ) { + PUSHMARK( stack_sp ); + perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG); + stack_sp--; + } } RETURNOP(CvSTART(cv)); } @@ -1800,27 +1800,35 @@ static CV * get_db_sub(SV **svp, CV *cv) { dTHR; - SV *oldsv = *svp; - GV *gv; + SV *dbsv = GvSV(DBsub); + + if (!PERLDB_SUB_NN) { + GV *gv = CvGV(cv); - *svp = GvSV(DBsub); - save_item(*svp); - gv = CvGV(cv); - if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) - || strEQ(GvNAME(gv), "END") - || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ - !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv) - && (gv = (GV*)oldsv) ))) { - /* Use GV from the stack as a fallback. */ - /* GV is potentially non-unique, or contain different CV. */ - sv_setsv(*svp, newRV((SV*)cv)); + save_item(dbsv); + if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) + || strEQ(GvNAME(gv), "END") + || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ + !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) + && (gv = (GV*)*svp) ))) { + /* Use GV from the stack as a fallback. */ + /* GV is potentially non-unique, or contain different CV. */ + sv_setsv(dbsv, newRV((SV*)cv)); + } + else { + gv_efullname3(dbsv, gv, Nullch); + } } else { - gv_efullname3(*svp, gv, Nullch); + SvUPGRADE(dbsv, SVt_PVIV); + SvIOK_on(dbsv); + SAVEIV(SvIVX(dbsv)); + SvIVX(dbsv) = (IV)cv; /* Do it the quickest way */ } - cv = GvCV(DBsub); + if (CvXSUB(cv)) curcopdb = curcop; + cv = GvCV(DBsub); return cv; } @@ -485,40 +485,10 @@ PP(pp_binmode) if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; -#ifdef DOSISH -#ifdef atarist - if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) + if (do_binmode(fp,IoTYPE(io),TRUE)) RETPUSHYES; else RETPUSHUNDEF; -#else - if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -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 - * set the mode explicitly for the stream (though they don't - * document this anywhere). GSAR 97-5-24 - */ - PerlIO_seek(fp,0L,0); - fp->flags |= _F_BIN; -#endif - RETPUSHYES; - } - else - RETPUSHUNDEF; -#endif -#else -#if defined(USEMYBINMODE) - if (my_binmode(fp,IoTYPE(io)) != NULL) - RETPUSHYES; - else - RETPUSHUNDEF; -#else - RETPUSHYES; -#endif -#endif - } @@ -2603,6 +2573,13 @@ PP(pp_chdir) if (svp) tmps = SvPV(*svp, na); } +#ifdef VMS + if (!tmps || !*tmps) { + svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE); + if (svp) + tmps = SvPV(*svp, na); + } +#endif TAINT_PROPER("chdir"); PUSHi( PerlDir_chdir(tmps) >= 0 ); #ifdef VMS @@ -90,6 +90,7 @@ OP* die _((const char* pat,...)); OP* die_where _((char* message)); void dounwind _((I32 cxix)); bool do_aexec _((SV* really, SV** mark, SV** sp)); +int do_binmode _((PerlIO *fp, int iotype, int flag)); void do_chop _((SV* asv, SV* sv)); bool do_close _((GV* gv, bool not_implicit)); bool do_eof _((GV* gv)); @@ -139,6 +140,7 @@ void dump_packsubs _((HV* stash)); void dump_sub _((GV* gv)); void fbm_compile _((SV* sv, U32 flags)); char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); +char* find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags)); #ifdef USE_THREADS PADOFFSET find_threadsv _((char *name)); #endif @@ -367,6 +369,7 @@ void pad_reset _((void)); void pad_swipe _((PADOFFSET po)); void peep _((OP* o)); PerlInterpreter* perl_alloc _((void)); +void perl_atexit _((void(*fn)(void *), void*)); I32 perl_call_argv _((char* subname, I32 flags, char** argv)); I32 perl_call_method _((char* methname, I32 flags)); I32 perl_call_pv _((char* subname, I32 flags)); @@ -127,7 +127,6 @@ static regnode *reg_node _((U8)); static regnode *regpiece _((I32 *)); static void reginsert _((U8, regnode *)); static void regoptail _((regnode *, regnode *)); -static void regset _((char *, I32)); static void regtail _((regnode *, regnode *)); static char* regwhite _((char *, char *)); static char* nextchar _((void)); @@ -1831,15 +1830,6 @@ regwhite(char *p, char *e) return p; } -static void -regset(char *opnd, register I32 c) -{ - if (SIZE_ONLY) - return; - c &= 0xFF; - opnd[1 + (c >> 3)] |= (1 << (c & 7)); -} - static regnode * regclass(void) { @@ -1903,63 +1893,67 @@ regclass(void) Class = UCHARAT(regparse++); switch (Class) { case 'w': - if (regflags & PMf_LOCALE) { - if (!SIZE_ONLY) + if (!SIZE_ONLY) { + if (regflags & PMf_LOCALE) *opnd |= ANYOF_ALNUML; - } - else { - for (Class = 0; Class < 256; Class++) - if (isALNUM(Class)) - regset(opnd, Class); + else { + for (Class = 0; Class < 256; Class++) + if (isALNUM(Class)) + ANYOF_SET(opnd, Class); + } } lastclass = 1234; continue; case 'W': - if (regflags & PMf_LOCALE) { - if (!SIZE_ONLY) + if (!SIZE_ONLY) { + if (regflags & PMf_LOCALE) *opnd |= ANYOF_NALNUML; - } - else { - for (Class = 0; Class < 256; Class++) - if (!isALNUM(Class)) - regset(opnd, Class); + else { + for (Class = 0; Class < 256; Class++) + if (!isALNUM(Class)) + ANYOF_SET(opnd, Class); + } } lastclass = 1234; continue; case 's': - if (regflags & PMf_LOCALE) { - if (!SIZE_ONLY) + if (!SIZE_ONLY) { + if (regflags & PMf_LOCALE) *opnd |= ANYOF_SPACEL; - } - else { - for (Class = 0; Class < 256; Class++) - if (isSPACE(Class)) - regset(opnd, Class); + else { + for (Class = 0; Class < 256; Class++) + if (isSPACE(Class)) + ANYOF_SET(opnd, Class); + } } lastclass = 1234; continue; case 'S': - if (regflags & PMf_LOCALE) { - if (!SIZE_ONLY) + if (!SIZE_ONLY) { + if (regflags & PMf_LOCALE) *opnd |= ANYOF_NSPACEL; - } - else { - for (Class = 0; Class < 256; Class++) - if (!isSPACE(Class)) - regset(opnd, Class); + else { + for (Class = 0; Class < 256; Class++) + if (!isSPACE(Class)) + ANYOF_SET(opnd, Class); + } } lastclass = 1234; continue; case 'd': - for (Class = '0'; Class <= '9'; Class++) - regset(opnd, Class); + if (!SIZE_ONLY) { + for (Class = '0'; Class <= '9'; Class++) + ANYOF_SET(opnd, Class); + } lastclass = 1234; continue; case 'D': - for (Class = 0; Class < '0'; Class++) - regset(opnd, Class); - for (Class = '9' + 1; Class < 256; Class++) - regset(opnd, Class); + if (!SIZE_ONLY) { + for (Class = 0; Class < '0'; Class++) + ANYOF_SET(opnd, Class); + for (Class = '9' + 1; Class < 256; Class++) + ANYOF_SET(opnd, Class); + } lastclass = 1234; continue; case 'n': @@ -2012,13 +2006,31 @@ regclass(void) continue; /* do it next time */ } } - for ( ; lastclass <= Class; lastclass++) - regset(opnd, lastclass); + if (!SIZE_ONLY) { + for ( ; lastclass <= Class; lastclass++) + ANYOF_SET(opnd, lastclass); + } lastclass = Class; } if (*regparse != ']') FAIL("unmatched [] in regexp"); nextchar(); + /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */ + if (!SIZE_ONLY && (*opnd & (0xFF ^ ANYOF_INVERT)) == ANYOF_FOLD) { + for (Class = 0; Class < 256; ++Class) { + if (ANYOF_TEST(opnd, Class)) { + I32 cf = fold[Class]; + ANYOF_SET(opnd, cf); + } + } + *opnd &= ~ANYOF_FOLD; + } + /* optimize inverted simple patterns (e.g. [^a-z]) */ + if (!SIZE_ONLY && (*opnd & 0xFF) == ANYOF_INVERT) { + for (Class = 0; Class < 32; ++Class) + opnd[1 + Class] ^= 0xFF; + *opnd = 0; + } return ret; } @@ -370,6 +370,13 @@ typedef char* regnode; #define ANYOF_SPACEL 0x02 #define ANYOF_NSPACEL 0x01 +/* Utility macros for bitmap of ANYOF */ +#define ANYOF_BYTE(p,c) (p)[1 + (((c) >> 3) & 31)] +#define ANYOF_BIT(c) (1 << ((c) & 7)) +#define ANYOF_SET(p,c) (ANYOF_BYTE(p,c) |= ANYOF_BIT(c)) +#define ANYOF_CLEAR(p,c) (ANYOF_BYTE(p,c) &= ~ANYOF_BIT(c)) +#define ANYOF_TEST(p,c) (ANYOF_BYTE(p,c) & ANYOF_BIT(c)) + #ifdef REGALIGN_STRUCT #define ANY_SKIP ((33 - 1)/sizeof(regnode) + 1) #else @@ -114,9 +114,11 @@ static I32 regmatch _((regnode *prog)); static I32 regrepeat _((regnode *p, I32 max)); static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp)); static I32 regtry _((regexp *prog, char *startpos)); + static bool reginclass _((char *p, I32 c)); static CHECKPOINT regcppush _((I32 parenfloor)); static char * regcppop _((void)); +#define REGINCLASS(p,c) (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c)) static CHECKPOINT regcppush(I32 parenfloor) @@ -422,7 +424,7 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, cha case ANYOF: Class = (char *) OPERAND(c); while (s < strend) { - if (reginclass(Class, *s)) { + if (REGINCLASS(Class, *s)) { if (tmp && regtry(prog, s)) goto got_it; else @@ -890,7 +892,7 @@ regmatch(regnode *prog) s = (char *) OPERAND(scan); if (nextchar < 0) nextchar = UCHARAT(locinput); - if (!reginclass(s, nextchar)) + if (!REGINCLASS(s, nextchar)) sayNO; if (!nextchar && locinput >= regeol) sayNO; @@ -1663,7 +1665,7 @@ regrepeat(regnode *p, I32 max) scan++; break; case ANYOF: - while (scan < loceol && reginclass(opnd, *scan)) + while (scan < loceol && REGINCLASS(opnd, *scan)) scan++; break; case ALNUM: @@ -1774,7 +1776,7 @@ reginclass(register char *p, register I32 c) bool match = FALSE; c &= 0xFF; - if (p[1 + (c >> 3)] & (1 << (c & 7))) + if (ANYOF_TEST(p, c)) match = TRUE; else if (flags & ANYOF_FOLD) { I32 cf; @@ -1784,7 +1786,7 @@ reginclass(register char *p, register I32 c) } else cf = fold[c]; - if (p[1 + (cf >> 3)] & (1 << (cf & 7))) + if (ANYOF_TEST(p, cf)) match = TRUE; } @@ -1800,7 +1802,7 @@ reginclass(register char *p, register I32 c) } } - return match ^ ((flags & ANYOF_INVERT) != 0); + return (flags & ANYOF_INVERT) ? !match : match; } @@ -400,6 +400,10 @@ sv_free_arenas(void) Safefree((void *)sva); } + if (nice_chunk) + Safefree(nice_chunk); + nice_chunk = Nullch; + nice_chunk_size = 0; sv_arenaroot = 0; sv_root = 0; } @@ -1902,8 +1906,11 @@ sv_setsv(SV *dstr, register SV *sstr) switch (stype) { case SVt_NULL: - (void)SvOK_off(dstr); - return; + if (dtype != SVt_PVGV) { + (void)SvOK_off(dstr); + return; + } + break; case SVt_IV: if (dtype != SVt_IV && dtype < SVt_PVIV) { if (dtype < SVt_IV) @@ -2205,7 +2212,12 @@ sv_setsv(SV *dstr, register SV *sstr) SvIVX(dstr) = SvIVX(sstr); } else { - (void)SvOK_off(dstr); + if (dtype == SVt_PVGV) { + if (dowarn) + warn("Undefined value assigned to typeglob"); + } + else + (void)SvOK_off(dstr); } SvTAINT(dstr); } @@ -4111,6 +4123,10 @@ sv_unglob(SV *sv) SvFAKE_off(sv); if (GvGP(sv)) gp_free((GV*)sv); + if (GvSTASH(sv)) { + SvREFCNT_dec(GvSTASH(sv)); + GvSTASH(sv) = Nullhv; + } sv_unmagic(sv, '*'); Safefree(GvNAME(sv)); GvMULTI_off(sv); diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t index 8a23fb6d7d..e4bde30040 100755 --- a/t/lib/filecopy.t +++ b/t/lib/filecopy.t @@ -29,6 +29,7 @@ print "ok 1\n"; print "not " unless $foo eq "ok 3\n"; print "ok 2\n"; +binmode STDOUT; # Copy::copy works in binary mode copy "copy-$$", \*STDOUT; unlink "copy-$$" or die "unlink: $!"; diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t index 0971e7803f..9fab56b237 100755 --- a/t/lib/io_sock.t +++ b/t/lib/io_sock.t @@ -55,11 +55,14 @@ if($pid = fork()) { # This can fail if localhost is undefined or the # special 'loopback' address 127.0.0.1 is not configured # on your system. (/etc/rc.config.d/netconfig on HP-UX.) + # As a shortcut (not recommended) you could change 'localhost' + # here to be the name of this machine eg 'myhost.mycompany.com'. $sock = IO::Socket::INET->new(PeerPort => $port, Proto => 'tcp', PeerAddr => 'localhost' - ) or die "$!"; + ) + or die "$! (maybe your system does not have the 'localhost' address defined)"; $sock->autoflush(1); diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t index 3e16714118..014e12dc58 100755 --- a/t/lib/io_udp.t +++ b/t/lib/io_udp.t @@ -30,9 +30,13 @@ use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY); # This can fail if localhost is undefined or the # special 'loopback' address 127.0.0.1 is not configured # on your system. (/etc/rc.config.d/netconfig on HP-UX.) + # As a shortcut (not recommended) you could change 'localhost' + # here to be the name of this machine eg 'myhost.mycompany.com'. -$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost'); -$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost'); +$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost') + or die "$! (maybe your system does not have the 'localhost' address defined)"; +$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost') + or die "$! (maybe your system does not have the 'localhost' address defined)"; print "ok 1\n"; diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t index 47a75881dc..21ed0d3eae 100755 --- a/t/lib/parsewords.t +++ b/t/lib/parsewords.t @@ -5,24 +5,77 @@ BEGIN { @INC = '../lib'; } -print "1..4\n"; - use Text::ParseWords; -@words = shellwords(qq(foo "bar quiz" zoo)); -#print join(";", @words), "\n"; +print "1..15\n"; +@words = shellwords(qq(foo "bar quiz" zoo)); print "not " if $words[0] ne 'foo'; print "ok 1\n"; - print "not " if $words[1] ne 'bar quiz'; print "ok 2\n"; - print "not " if $words[2] ne 'zoo'; print "ok 3\n"; -# Test quotewords() with other parameters -@words = quotewords(":+", 1, qq(foo:::"bar:foo":zoo zoo:)); -#print join(";", @words), "\n"; -print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo); +# Test quotewords() with other parameters and null last field +@words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:'); +print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;); print "ok 4\n"; + +# Test $keep eq 'delimiters' and last field zero +@words = quotewords('\s+', 'delimiters', '4 3 2 1 0'); +print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0); +print "ok 5\n"; + +# Big ol' nasty test (thanks, Joerk!) +$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"'; + +# First with $keep == 1 +$result = join('|', parse_line('\s+', 1, $string)); +print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"'; +print "ok 6\n"; + +# Now, $keep == 0 +$result = join('|', parse_line('\s+', 0, $string)); +print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg'; +print "ok 7\n"; + +# Now test single quote behavior +$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg'; +$result = join('|', parse_line('\s+', 0, $string)); +print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg'; +print "ok 8\n"; + +# Make sure @nested_quotewords does the right thing +@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z'); +print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3); +print "ok 9\n"; + +# Now test error return +$string = 'foo bar baz"bach blech boop'; + +@words = shellwords($string); +print "not " if (@words); +print "ok 10\n"; + +@words = parse_line('s+', 0, $string); +print "not " if (@words); +print "ok 11\n"; + +@words = quotewords('s+', 0, $string); +print "not " if (@words); +print "ok 12\n"; + +@words = nested_quotewords('s+', 0, $string); +print "not " if (@words); +print "ok 13\n"; + +# Now test empty fields +$result = join('|', parse_line(':', 0, 'foo::0:"":::')); +print "not " unless ($result eq 'foo||0||||'); +print "ok 14\n"; + +# Test for 0 in quotes without $keep +$result = join('|', parse_line(':', 0, ':"0":')); +print "not " unless ($result eq '|0|'); +print "ok 15\n"; diff --git a/t/lib/posix.t b/t/lib/posix.t index d63e695f02..c071c3b067 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -16,6 +16,8 @@ use strict subs; $| = 1; print "1..18\n"; +$Is_W32 = $^O eq 'MSWin32'; + $testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n"; read($testfd, $buffer, 9) if $testfd > 2; print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n"; @@ -31,6 +33,12 @@ close $writer; print <$reader>; close $reader; +if ($Is_W32) { + for (6..11) { + print "ok $_ # skipped, no sigaction support on win32\n"; + } +} +else { $sigset = new POSIX::SigSet 1,3; delset $sigset 1; if (!ismember $sigset 1) { print "ok 6\n" } @@ -53,6 +61,7 @@ sub SigHUP { sub SigINT { print "ok 10\n"; } +} print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n"; diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t index 938ca695b1..100e0768aa 100755 --- a/t/lib/timelocal.t +++ b/t/lib/timelocal.t @@ -11,7 +11,7 @@ use Time::Local; @time = ( #year,mon,day,hour,min,sec - [1970, 1, 1, 00, 00, 00], + [1970, 1, 2, 00, 00, 00], [1980, 2, 28, 12, 00, 00], [1980, 2, 29, 12, 00, 00], [1999, 12, 31, 23, 59, 59], diff --git a/t/op/die_exit.t b/t/op/die_exit.t new file mode 100755 index 0000000000..b01dd35a97 --- /dev/null +++ b/t/op/die_exit.t @@ -0,0 +1,48 @@ +#!./perl + +# +# Verify that C<die> return the return code +# -- Robin Barker <rmb@cise.npl.co.uk> +# + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -e '../lib'; +} +my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl'; + +use strict; + +my %tests = ( + 1 => [ 0, 0], + 2 => [ 0, 1], + 3 => [ 0, 127], + 4 => [ 0, 128], + 5 => [ 0, 255], + 6 => [ 0, 256], + 7 => [ 0, 512], + 8 => [ 1, 0], + 9 => [ 1, 1], + 10 => [ 1, 256], + 11 => [ 128, 0], + 12 => [ 128, 1], + 13 => [ 128, 256], + 14 => [ 255, 0], + 15 => [ 255, 1], + 16 => [ 255, 256], +); + +my $max = keys %tests; + +print "1..$max\n"; + +foreach my $test (1 .. $max) { + my($bang, $query) = @{$tests{$test}}; + my $exit = + system qq($perl -e '\$! = $bang; \$? = $query; die;' 2> /dev/null); + + printf "# 0x%04x 0x%04x 0x%04x\nnot ", $exit, $bang, $query + unless $exit == (($bang || ($query >> 8) || 255) << 8); + print "ok $test\n"; +} + @@ -4,7 +4,7 @@ # various typeglob tests # -print "1..13\n"; +print "1..18\n"; # type coersion on assignment $foo = 'foo'; @@ -65,3 +65,21 @@ if (defined $baa) { { package Foo::Bar } print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n"; print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n"; + +# test undef operator clearing out entire glob +$foo = 'stuff'; +@foo = qw(more stuff); +%foo = qw(even more random stuff); +undef *foo; +print +($foo || @foo || %foo) ? "not ok" : "ok", " 16\n"; + +# test warnings from assignment of undef to glob +{ + my $msg; + local $SIG{__WARN__} = sub { $msg = $_[0] }; + local $^W = 1; + *foo = 'bar'; + print $msg ? "not ok" : "ok", " 17\n"; + *foo = undef; + print $msg ? "ok" : "not ok", " 18\n"; +} diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t index 4127271e7b..6343a2a8d5 100755 --- a/t/op/hashwarn.t +++ b/t/op/hashwarn.t @@ -1,7 +1,8 @@ #!./perl + BEGIN { chdir 't' if -d 't'; - @INC = qw(../lib); + @INC = '../lib'; } use strict; diff --git a/t/op/ipcmsg.t b/t/op/ipcmsg.t new file mode 100755 index 0000000000..336d6d1253 --- /dev/null +++ b/t/op/ipcmsg.t @@ -0,0 +1,124 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +my @define; + +BEGIN { + @define = qw( + IPC_PRIVATE + IPC_RMID + IPC_NOWAIT + IPC_STAT + S_IRWXU + S_IRWXG + S_IRWXO + ); +} + +use Config; +use vars map { '$' . $_ } @define; + +BEGIN { + unless($Config{'d_msgget'} eq 'define' && + $Config{'d_msgctl'} eq 'define' && + $Config{'d_msgsnd'} eq 'define' && + $Config{'d_msgrcv'} eq 'define') { + print "0..0\n"; + exit; + } + my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth})); + my %done = (); + my %define = (); + + sub process_file { + my($file) = @_; + + return unless defined $file; + + my $path = undef; + my $dir; + foreach $dir (@incpath) { + my $tmp = $dir . "/" . $file; + next unless -r $tmp; + $path = $tmp; + last; + } + + return if exists $done{$path}; + $done{$path} = 1; + + unless(defined $path) { + warn "Cannot find '$file'"; + return; + } + + open(F,$path) or return; + while(<F>) { + s#/\*.*(\*/|$)##; + + process_file($mm,$1) + if /^#\s*include\s*[<"]([^>"]+)[>"]/; + + s/(?:\([^)]*\)\s*)//; + + $define{$1} = $2 + if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/; + } + close(F); + } + + process_file("sys/sem.h"); + process_file("sys/ipc.h"); + process_file("sys/stat.h"); + + foreach $d (@define) { + while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) { + $define{$d} = exists $define{$define{$d}} + ? $define{$define{$d}} : undef; + } + unless(defined $define{$d}) { + print "0..0\n"; + exit; + }; + ${ $d } = eval $define{$d}; + } +} + +use strict; + +print "1..6\n"; + +my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO) + || die "msgget failed: $!\n"; + +print "ok 1\n"; + +#Putting a message on the queue +my $msgtype = 1; +my $msgtext = "hello"; + +msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not "; +print "ok 2\n"; + +my $data; +msgctl($msg,$IPC_STAT,$data) or print "not "; +print "ok 3\n"; + +print "not " unless length($data); +print "ok 4\n"; + +my $msgbuf; +msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not "; +print "ok 5\n"; + +my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf); + +print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext); +print "ok 6\n"; + +msgctl($msg,$IPC_RMID,0); + diff --git a/t/op/ipcsem.t b/t/op/ipcsem.t new file mode 100755 index 0000000000..abe32fbf51 --- /dev/null +++ b/t/op/ipcsem.t @@ -0,0 +1,136 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +my @define; + +BEGIN { + @define = qw( + GETALL + SETALL + IPC_PRIVATE + IPC_CREAT + IPC_RMID + IPC_STAT + S_IRWXU + S_IRWXG + S_IRWXO + ); +} + +use Config; +use vars map { '$' . $_ } @define; + +BEGIN { + unless($Config{'d_semget'} eq 'define' && + $Config{'d_semctl'} eq 'define') { + print "0..0\n"; + exit; + } + my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth})); + my %done = (); + my %define = (); + + sub process_file { + my($file) = @_; + + return unless defined $file; + + my $path = undef; + my $dir; + foreach $dir (@incpath) { + my $tmp = $dir . "/" . $file; + next unless -r $tmp; + $path = $tmp; + last; + } + + return if exists $done{$path}; + $done{$path} = 1; + + unless(defined $path) { + warn "Cannot find '$file'"; + return; + } + + open(F,$path) or return; + while(<F>) { + s#/\*.*(\*/|$)##; + + process_file($mm,$1) + if /^#\s*include\s*[<"]([^>"]+)[>"]/; + + s/(?:\([^)]*\)\s*)//; + + $define{$1} = $2 + if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/; + } + close(F); + } + + process_file("sys/sem.h"); + process_file("sys/ipc.h"); + process_file("sys/stat.h"); + + foreach $d (@define) { + while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) { + $define{$d} = exists $define{$define{$d}} + ? $define{$define{$d}} : undef; + } + unless(defined $define{$d}) { + print "0..0\n"; + exit; + }; + ${ $d } = eval $define{$d}; + } +} + +use strict; + +print "1..10\n"; + +my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT) + || die "semget: $!\n"; + +print "ok 1\n"; + +my $data; +semctl($sem,0,$IPC_STAT,$data) or print "not "; +print "ok 2\n"; + +print "not " unless length($data); +print "ok 3\n"; + +semctl($sem,0,$SETALL,pack("s*",(0) x 10)) or print "not "; +print "ok 4\n"; + +$data = ""; +semctl($sem,0,$GETALL,$data) or print "not "; +print "ok 5\n"; + +print "not " unless length($data); +print "ok 6\n"; + +my @data = unpack("s*",$data); + +print "not " unless join("",@data) eq "0000000000"; +print "ok 7\n"; + +$data[2] = 1; +semctl($sem,0,$SETALL,pack("s*",@data)) or print "not "; +print "ok 8\n"; + +$data = ""; +semctl($sem,0,$GETALL,$data) or print "not "; +print "ok 9\n"; + +@data = unpack("s*",$data); + +print "not " unless join("",@data) eq "0010000000"; +print "ok 10\n"; + +semctl($sem,0,$IPC_RMID,undef); + diff --git a/t/op/misc.t b/t/op/misc.t index 582ffa7905..9ab6831859 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -368,6 +368,11 @@ EXPECT 1 2 ######## +-w +sub testme { my $a = "test"; { local $a = "new test"; print $a }} +EXPECT +Can't localize lexical variable $a at - line 2. +######## package X; sub ascalar { my $r; bless \$r } sub DESTROY { print "destroyed\n" }; diff --git a/t/op/pack.t b/t/op/pack.t index f9a89a3ec0..de5fcff218 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -2,7 +2,7 @@ # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $ -print "1..29\n"; +print "1..30\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -100,3 +100,9 @@ sub foo { my $a = "a"; return $a . $a++ . $a++ } # undef should give null pointer print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n"); +# Check for optimizer bug (e.g. Digital Unix GEM cc with -O4 on DU V4.0B gives +# 4294967295 instead of -1) +# see #ifdef __osf__ in pp.c pp_unpack +# Test 30: +print( ((unpack("i",pack("i",-1))) == -1 ? "ok " : "not ok "),$test++,"\n"); + diff --git a/t/op/pos.t b/t/op/pos.t new file mode 100755 index 0000000000..46811b7bbc --- /dev/null +++ b/t/op/pos.t @@ -0,0 +1,16 @@ +#!./perl + +print "1..3\n"; + +$x='banana'; +$x=~/.a/g; +if (pos($x)==2) {print "ok 1\n"} else {print "not ok 1\n";} + +$x=~/.z/gc; +if (pos($x)==2) {print "ok 2\n"} else {print "not ok 2\n";} + +sub f { my $p=$_[0]; return $p } + +$x=~/.a/g; +if (f(pos($x))==4) {print "ok 3\n"} else {print "not ok 3\n";} + diff --git a/t/op/runlevel.t b/t/op/runlevel.t index b5e5dbb08c..bff26e4b71 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -188,6 +188,8 @@ sub sortfn { print "---- ".join(', ', @x)."\n"; EXPECT sortfn 4, 5, 6 +sortfn 4, 5, 6 +sortfn 4, 5, 6 ---- 1, 2, 3 ######## @a = (3, 2, 1); diff --git a/t/op/stat.t b/t/op/stat.t index 9d4b3a6787..c7cd0961f3 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -45,7 +45,12 @@ else { if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2) {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";} -if ($Is_MSWin32 || $Is_Dos || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') { +if ( ($mtime && $mtime != $ctime) + || $Is_MSWin32 + || $Is_Dos + || ($cwd eq '/tmp' and $mtime && $mtime==$ctime) # Solaris tmpfs bug + || $cwd =~ m#/afs/# + || $^O eq 'amigaos') { print "ok 4\n"; } else { @@ -53,7 +58,7 @@ else { print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n"; print "#4 of some sort. Building in /tmp sometimes has this problem.\n"; } -print "#4 :$mtime: != :$ctime:\n"; +print "#4 :$mtime: should != :$ctime:\n"; unlink "Op.stat.tmp"; if ($Is_MSWin32) { open F, '>Op.stat.tmp' and close F } diff --git a/t/pragma/locale.t b/t/pragma/locale.t index 8875f7caa6..bd5267d720 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -19,6 +19,9 @@ eval { $have_setlocale++; }; +# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1" +$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i; + print "1..", ($have_setlocale ? 102 : 98), "\n"; use vars qw($a @@ -768,6 +768,12 @@ sublex_done(void) processing a pattern (lex_inpat is true), a transliteration (lex_inwhat & OP_TRANS is true), or a double-quoted string. + Returns a pointer to the character scanned up to. Iff this is + advanced from the start pointer supplied (ie if anything was + successfully parsed), will leave an OP for the substring scanned + in yylval. Caller must intuit reason for not parsing further + by looking at the next characters herself. + In patterns: backslashes: double-quoted style: \r and \n @@ -835,17 +841,11 @@ scan_const(char *start) bool dorange = FALSE; /* are we in a translit range? */ I32 len; /* ? */ - /* - leave is the set of acceptably-backslashed characters. - - I do *not* understand why there's the double hook here. - */ + /* leaveit is the set of acceptably-backslashed characters */ char *leaveit = lex_inpat ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#" - : (lex_inwhat & OP_TRANS) - ? "" - : ""; + : ""; while (s < send || dorange) { /* get transliterations out of the way (they're most literal) */ @@ -1032,7 +1032,7 @@ scan_const(char *start) Renew(SvPVX(sv), SvLEN(sv), char); } - /* ??? */ + /* return the substring (via yylval) only if we parsed anything */ if (s > bufptr) yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); else @@ -1304,11 +1304,12 @@ die(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); + PUSHSTACK(SI_DIEHOOK); PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); - + POPSTACK(); LEAVE; } } @@ -1369,11 +1370,12 @@ croak(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); + PUSHSTACK(SI_DIEHOOK); PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); - + POPSTACK(); LEAVE; } } @@ -1428,11 +1430,12 @@ warn(pat,va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); + PUSHSTACK(SI_WARNHOOK); PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); - + POPSTACK(); LEAVE; return; } @@ -1832,6 +1835,46 @@ VTOH(vtohs,short) VTOH(vtohl,long) #endif +int +do_binmode(PerlIO *fp, int iotype, int flag) +{ + if (flag != TRUE) + croak("panic: unsetting binmode"); /* Not implemented yet */ +#ifdef DOSISH +#ifdef atarist + if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) + return 1; + else + return 0; +#else + if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -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 + * set the mode explicitly for the stream (though they don't + * document this anywhere). GSAR 97-5-24 + */ + PerlIO_seek(fp,0L,0); + fp->flags |= _F_BIN; +#endif + return 1; + } + else + return 0; +#endif +#else +#if defined(USEMYBINMODE) + if (my_binmode(fp,iotype) != NULL) + return 1; + else + return 0; +#else + return 1; +#endif +#endif +} + /* VMS' my_popen() is in VMS.c, same with OS/2. */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) PerlIO * @@ -2401,6 +2444,211 @@ scan_hex(char *start, I32 len, I32 *retlen) return retval; } +char* +find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) +{ + dTHR; + char *xfound = Nullch; + char *xfailed = Nullch; + register char *s; + I32 len; + int retval; +#if defined(DOSISH) && !defined(OS2) && !defined(atarist) +# define SEARCH_EXTS ".bat", ".cmd", NULL +# define MAX_EXT_LEN 4 +#endif +#ifdef OS2 +# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL +# define MAX_EXT_LEN 4 +#endif +#ifdef VMS +# define SEARCH_EXTS ".pl", ".com", NULL +# define MAX_EXT_LEN 4 +#endif + /* additional extensions to try in each dir if scriptname not found */ +#ifdef SEARCH_EXTS + char *exts[] = { SEARCH_EXTS }; + char **ext = search_ext ? search_ext : exts; + int extidx = 0, i = 0; + char *curext = Nullch; +#else +# define MAX_EXT_LEN 0 +#endif + + /* + * If dosearch is true and if scriptname does not contain path + * delimiters, search the PATH for scriptname. + * + * If SEARCH_EXTS is also defined, will look for each + * scriptname{SEARCH_EXTS} whenever scriptname is not found + * while searching the PATH. + * + * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search + * proceeds as follows: + * If DOSISH or VMSISH: + * + look for ./scriptname{,.foo,.bar} + * + search the PATH for scriptname{,.foo,.bar} + * + * If !DOSISH: + * + look *only* in the PATH for scriptname{,.foo,.bar} (note + * this will not look in '.' if it's not in the PATH) + */ + +#ifdef VMS +# ifdef ALWAYS_DEFTYPES + len = strlen(scriptname); + if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') { + int hasdir, idx = 0, deftypes = 1; + bool seen_dot = 1; + + hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ; +# else + if (dosearch) { + int hasdir, idx = 0, deftypes = 1; + bool seen_dot = 1; + + hasdir = (strpbrk(scriptname,":[</") != Nullch) ; +# endif + /* The first time through, just add SEARCH_EXTS to whatever we + * already have, so we can check for default file types. */ + while (deftypes || + (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) ) + { + if (deftypes) { + deftypes = 0; + *tokenbuf = '\0'; + } + if ((strlen(tokenbuf) + strlen(scriptname) + + MAX_EXT_LEN) >= sizeof tokenbuf) + continue; /* don't search dir with too-long name */ + strcat(tokenbuf, scriptname); +#else /* !VMS */ + +#ifdef DOSISH + if (strEQ(scriptname, "-")) + dosearch = 0; + if (dosearch) { /* Look in '.' first. */ + char *cur = scriptname; +#ifdef SEARCH_EXTS + if ((curext = strrchr(scriptname,'.'))) /* possible current ext */ + while (ext[i]) + if (strEQ(ext[i++],curext)) { + extidx = -1; /* already has an ext */ + break; + } + do { +#endif + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Looking for %s\n",cur)); + if (PerlLIO_stat(cur,&statbuf) >= 0) { + dosearch = 0; + scriptname = cur; +#ifdef SEARCH_EXTS + break; +#endif + } +#ifdef SEARCH_EXTS + if (cur == scriptname) { + len = strlen(scriptname); + if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf)) + break; + cur = strcpy(tokenbuf, scriptname); + } + } while (extidx >= 0 && ext[extidx] /* try an extension? */ + && strcpy(tokenbuf+len, ext[extidx++])); +#endif + } +#endif + + if (dosearch && !strchr(scriptname, '/') +#ifdef DOSISH + && !strchr(scriptname, '\\') +#endif + && (s = PerlEnv_getenv("PATH"))) { + bool seen_dot = 0; + + bufend = s + strlen(s); + while (s < bufend) { +#if defined(atarist) || defined(DOSISH) + for (len = 0; *s +# ifdef atarist + && *s != ',' +# endif + && *s != ';'; len++, s++) { + if (len < sizeof tokenbuf) + tokenbuf[len] = *s; + } + if (len < sizeof tokenbuf) + tokenbuf[len] = '\0'; +#else /* ! (atarist || DOSISH) */ + s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend, + ':', + &len); +#endif /* ! (atarist || DOSISH) */ + if (s < bufend) + s++; + if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf) + continue; /* don't search dir with too-long name */ + if (len +#if defined(atarist) || defined(DOSISH) + && tokenbuf[len - 1] != '/' + && tokenbuf[len - 1] != '\\' +#endif + ) + tokenbuf[len++] = '/'; + if (len == 2 && tokenbuf[0] == '.') + seen_dot = 1; + (void)strcpy(tokenbuf + len, scriptname); +#endif /* !VMS */ + +#ifdef SEARCH_EXTS + len = strlen(tokenbuf); + if (extidx > 0) /* reset after previous loop */ + extidx = 0; + do { +#endif + DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf)); + retval = PerlLIO_stat(tokenbuf,&statbuf); +#ifdef SEARCH_EXTS + } while ( retval < 0 /* not there */ + && extidx>=0 && ext[extidx] /* try an extension? */ + && strcpy(tokenbuf+len, ext[extidx++]) + ); +#endif + if (retval < 0) + continue; + if (S_ISREG(statbuf.st_mode) + && cando(S_IRUSR,TRUE,&statbuf) +#ifndef DOSISH + && cando(S_IXUSR,TRUE,&statbuf) +#endif + ) + { + xfound = tokenbuf; /* bingo! */ + break; + } + if (!xfailed) + xfailed = savepv(tokenbuf); + } +#ifndef DOSISH + if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0)) +#endif + seen_dot = 1; /* Disable message. */ + if (!xfound) + scriptname = NULL; +/* croak("Can't %s %s%s%s", + (xfailed ? "execute" : "find"), + (xfailed ? xfailed : scriptname), + (xfailed ? "" : " on PATH"), + (xfailed || seen_dot) ? "" : ", '.' not in PATH"); */ + if (xfailed) + Safefree(xfailed); + scriptname = xfound; + } + return scriptname; +} + + #ifdef USE_THREADS #ifdef FAKE_THREADS /* Very simplistic scheduler for now */ diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 3a6059b4fd..326da7a563 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -50,6 +50,7 @@ if(@ARGV<1) { die <<EOF; Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName $me -f PerlFunc + $me -q FAQKeywords The -h option prints more help. Also try "perldoc perldoc" to get aquainted with the system. @@ -73,18 +74,20 @@ sub usage{ die <<EOF; perldoc [options] PageName|ModuleName|ProgramName... perldoc [options] -f BuiltinFunction +perldoc [options] -q FAQRegex Options: -h Display this help message -t Display pod using pod2text instead of pod2man and nroff (-t is the default on win32) -u Display unformatted pod text - -m Display modules file in its entirety - -l Display the modules file name + -m Display module's file in its entirety + -l Display the module's file name -F Arguments are file names, not modules -v Verbosely describe what's going on -X use index if present (looks for pod.idx at $Config{archlib}) + PageName|ModuleName... is the name of a piece of documentation that you want to look at. You may either give a descriptive name of the page (as in the case of @@ -95,7 +98,11 @@ PageName|ModuleName... BuiltinFunction is the name of a perl function. Will extract documentation from `perlfunc'. - + +FAQRegex + is a regex. Will search perlfaq[1-9] for and extract any + questions that match. + Any switches in the PERLDOC environment variable will be used before the command line arguments. The optional pod index file contains a list of filenames, one per line. @@ -108,7 +115,7 @@ use Text::ParseWords; unshift(@ARGV,shellwords($ENV{"PERLDOC"})); -getopts("mhtluvFf:X") || usage; +getopts("mhtluvFf:Xq:") || usage; usage if $opt_h || $opt_h; # avoid -w warning @@ -125,6 +132,8 @@ if ($opt_t) { require Pod::Text; import Pod::Text; } if ($opt_f) { @pages = ("perlfunc"); +} elsif ($opt_q) { + @pages = ("perlfaq1" .. "perlfaq9"); } else { @pages = @ARGV; } @@ -206,11 +215,11 @@ sub minus_f_nocase { sub check_file { my($file) = @_; - if ($opt_m) { - return minus_f_nocase($file) ? $file : ""; - } else { - return minus_f_nocase($file) && containspod($file) ? $file : ""; - } + $file = minus_f_nocase($file); + return "" unless $file; + return $file if $::opt_m; + return $file if containspod($file); + return ""; } @@ -352,6 +361,7 @@ if ($Is_MSWin32) { if ($^O eq 'os2') { require POSIX; $tmp = POSIX::tmpnam(); + unshift @pagers, 'less', 'cmd /c more <'; } else { $tmp = "/tmp/perldoc1.$$"; } @@ -391,14 +401,23 @@ if ($opt_f) { ++$found if /^\w/; # found descriptive text } if (@pod) { + my $lines = $ENV{LINES} || 24; + if ($opt_t) { open(FORMATTER, "| pod2text") || die "Can't start filter"; print FORMATTER "=over 8\n\n"; print FORMATTER @pod; print FORMATTER "=back\n"; close(FORMATTER); - } else { + } elsif (@pod < $lines-2) { print @pod; + } else { + foreach $pager (@pagers) { + open (PAGER, "| $pager") or next; + print PAGER @pod ; + close(PAGER) or next; + last; + } } } else { die "No documentation for perl function `$opt_f' found\n"; @@ -406,6 +425,39 @@ if ($opt_f) { exit; } +if ($opt_q) { + local @ARGV = @found; # I'm lazy, sue me. + my $found = 0; + my %found_in; + my @pod; + + while (<>) { + if (/^=head2\s+.*$opt_q/oi) { + $found = 1; + push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++; + } elsif (/^=head2/) { + $found = 0; + } + next unless $found; + push @pod, $_; + } + + if (@pod) { + if ($opt_t) { + open(FORMATTER, "| pod2text") || die "Can't start filter"; + print FORMATTER "=over 8\n\n"; + print FORMATTER @pod; + print FORMATTER "=back\n"; + close(FORMATTER); + } else { + print @pod; + } + } else { + die "No documentation for perl function `$opt_f' found\n"; + } + exit; +} + foreach (@found) { if($opt_t) { @@ -539,7 +591,10 @@ command line arguments. C<perldoc> also searches directories specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not defined) and C<PATH> environment variables. (The latter is so that embedded pods for executables, such as -C<perldoc> itself, are available.) +C<perldoc> itself, are available.) C<perldoc> will use, in order of +preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or +C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not +used if C<perldoc> was told to display plain text or unformatted pod.) =head1 AUTHOR diff --git a/vms/config.vms b/vms/config.vms index 9bd6863b3d..9614ea60c3 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -1040,7 +1040,7 @@ * have select(), of course. */ #if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) && defined(DECCRTL_SOCKETS) -#define Select_fd_set_t fd_set * /**/ +#define Select_fd_set_t fd_set * /* config-skip */ #else #define Select_fd_set_t int * /* config-skip */ #endif diff --git a/vms/descrip.mms b/vms/descrip.mms index 8f887dfbd4..a7fbf3d1bf 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -823,14 +823,14 @@ B : [.lib]B.pm [.lib]O.pm [.lib.B]Asmdata.pm [.lib.B]Assembler.pm [.lib.B]Bblock [.lib]perlbug.com : [.utils]perlbug.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.utils]perlbug.com $(MMS$TARGET) + Copy/Log [.utils]perlbug.com $(MMS$TARGET) [.utils]pl2pm.com : [.utils]pl2pm.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) [.lib]splain.com : [.utils]splain.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.utils]splain.com $(MMS$TARGET) + Copy/Log [.utils]splain.com $(MMS$TARGET) [.x2p]find2perl.com : [.x2p]find2perl.PL $(ARCHDIR)Config.pm $(MINIPERL) $(MMS$SOURCE) @@ -870,22 +870,22 @@ B : [.lib]B.pm [.lib]O.pm [.lib.B]Asmdata.pm [.lib.B]Assembler.pm [.lib.B]Bblock [.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.pod]pod2html.com $(MMS$TARGET) + Copy/Log [.pod]pod2html.com $(MMS$TARGET) [.lib.pod]pod2latex.com : [.pod]pod2latex.PL $(ARCHDIR)Config.pm @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.pod]pod2latex.com $(MMS$TARGET) + Copy/Log [.pod]pod2latex.com $(MMS$TARGET) [.lib.pod]pod2man.com : [.pod]pod2man.PL $(ARCHDIR)Config.pm @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.pod]pod2man.com $(MMS$TARGET) + Copy/Log [.pod]pod2man.com $(MMS$TARGET) [.lib.pod]pod2text.com : [.pod]pod2text.PL $(ARCHDIR)Config.pm @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] $(MINIPERL) $(MMS$SOURCE) - Rename/Log [.pod]pod2text.com $(MMS$TARGET) + Copy/Log [.pod]pod2text.com $(MMS$TARGET) preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ Write Sys$Output "Autosplitting Perl library . . ." @@ -1110,6 +1110,9 @@ perly$(O) : perly.c, perly.h, $(h) test : all [.t.lib]vmsfspec.t [.t.lib]vmsish.t - @[.VMS]Test.Com "$(E)" +install : + $(MINIPERL) installperl + archify : all @ Write Sys$Output "Moving files to architecture-specific locations for $(ARCH)" archroot = "$(ARCHAUTO)" - "]" + "...]" @@ -1357,6 +1360,7 @@ tidy : cleanlis - If F$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar - If F$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O) - If F$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C + - If F$Search("[.Ext.Socket]Socket.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C - If F$Search("[.Ext.Opcode...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Opcode] - If F$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C - If F$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O) @@ -1372,6 +1376,7 @@ tidy : cleanlis - If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod - If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* - If F$Search("[.lib]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib]*.com + - If F$Search("[.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.pod]*.com - If F$Search("[.utils]*.com;-1").nes."" Then Purge/NoConfirm/Log [.utils]*.com - If F$Search("[.x2p]*.com;-1").nes."" Then Purge/NoConfirm/Log [.x2p]*.com - If F$Search("[.lib.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.com @@ -1431,6 +1436,7 @@ clean : tidy - If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;* - If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* - If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* + - If F$Search("[.pod]*.com").nes."" Then Delete/NoConfirm/Log [.pod]*.com;* realclean : clean Set Default [.ext.Fcntl] diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm index b0b1414599..4a539c2701 100644 --- a/vms/ext/Filespec.pm +++ b/vms/ext/Filespec.pm @@ -266,6 +266,7 @@ sub fileify ($) { my($path) = @_; if (!$path) { return undef } + if ($path eq '/') { return 'sys$disk:[000000]'; } if ($path =~ /(.+)\.([^:>\]]*)$/) { $path = $1; if ($2 !~ /^dir(?:;1)?$/i) { return undef } diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 05644917b6..779396be73 100644 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t @@ -96,6 +96,7 @@ some/where/... vmsify [.some.where...] .. vmsify [-] ../.. vmsify [--] .../ vmsify [...] +/ vmsify sys$disk:[000000] # Fileifying directory specs down:[the.garden.path] fileify down:[the.garden]path.dir;1 @@ -135,6 +136,7 @@ down:[the.garden.path...] unixpath /down/the/garden/path/.../ [.down.the.garden]path.dir unixpath down/the/garden/path/ down/the/garden/path vmspath [.down.the.garden.path] path vmspath [.path] +/ vmspath sys$disk:[000000] # Redundant characters in Unix paths //some/where//over/../the.rainbow vmsify some:[where]the.rainbow diff --git a/vms/test.com b/vms/test.com index affc6a83c7..f131088dda 100644 --- a/vms/test.com +++ b/vms/test.com @@ -21,8 +21,17 @@ $ EndIf $ EndIf $ Set Message /Facility/Severity/Identification/Text $ -$ exe = ".Exe" -$ If p1.nes."" Then exe = p1 +$ exe = ".Exe" +$ If p1.nes."" Then exe = p1 +$ If F$Extract(0,1,exe) .nes. "." +$ Then +$ Write Sys$Error "" +$ Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the" +$ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited" +$ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line." +$ Write Sys$Error "" +$ Exit 44 +$ EndIf $! Pick up a copy of perl to use for the tests $ Delete/Log/NoConfirm Perl.;* $ Copy/Log/NoConfirm [-]Perl'exe' []Perl. @@ -103,7 +112,7 @@ use Config; # insists on stat()ing a file descriptor before it'll use it. push(@libexcl,'io_xs.t') if $Config{'vms_cc_type'} ne 'decc'; -@opexcl=('exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t'); +@opexcl=('die_exit.t','exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t'); @exclist=(@compexcl,@ioexcl,@libexcl,@opexcl); foreach $file (@exclist) { $skip{$file}++; } diff --git a/win32/Makefile b/win32/Makefile index 951c15a84d..4a518fbbd7 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1,6 +1,5 @@ -# # Makefile to build perl on Windowns NT using Microsoft NMAKE. -# +# Works with MS command line compilers from VC++ etc. # # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. @@ -9,30 +8,30 @@ # # Set these to wherever you want "nmake install" to put your # newly built perl. -INST_DRV=c: -INST_TOP=$(INST_DRV)\perl5004.5x +INST_DRV = c: +INST_TOP = $(INST_DRV)\perl5004.5x # # uncomment to enable threads-capabilities -#USE_THREADS=define +#USE_THREADS = define # # uncomment next line if you are using Visual C++ 2.x -#CCTYPE=MSVC20 +#CCTYPE = MSVC20 # # uncomment next line if you want debug version of perl (big,slow) -#CFG=Debug +#CFG = Debug # # if you have the source for des_fcrypt(), uncomment this and make sure the # file exists (see README.win32) -#CRYPT_SRC=des_fcrypt.c +#CRYPT_SRC = des_fcrypt.c # # if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a # library, uncomment this, and make sure the library exists (see README.win32) -#CRYPT_LIB=des_fcrypt.lib +#CRYPT_LIB = des_fcrypt.lib # # set this if you wish to use perl's malloc @@ -43,37 +42,44 @@ PERL_MALLOC = define # # set the install locations of the compiler include/libraries -#CCHOME = f:\msvc20 -CCHOME = $(MSVCDIR) -CCINCDIR = $(CCHOME)\include -CCLIBDIR = $(CCHOME)\lib +# (you'll need to quote the value if it contains spaces: i.e. +# CCHOME = "f:\Program Files\vc" +# +#CCHOME = f:\msvc20 +CCHOME = $(MSVCDIR) +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib # # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) -#EMAIL = +#EMAIL = ##################### CHANGE THESE ONLY IF YOU MUST ##################### !IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" -D_CRYPT=undef +D_CRYPT = undef !ELSE -D_CRYPT=define -CRYPT_FLAG=-DHAVE_DES_FCRYPT +D_CRYPT = define +CRYPT_FLAG = -DHAVE_DES_FCRYPT +!ENDIF + +!IF "$(OBJECT)" != "" +PERL_MALLOC = undef !ENDIF !IF "$(PERL_MALLOC)" == "" PERL_MALLOC = undef !ENDIF +!IF "$(USE_THREADS)" == "" +USE_THREADS = undef +!ENDIF + #BUILDOPT = -DMULTIPLICITY #BUILDOPT = -DPERL_GLOBAL_STRUCT -DMULTIPLICITY # -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include -!IF "$(USE_THREADS)" == "" -USE_THREADS = undef -!ENDIF - !IF "$(PROCESSOR_ARCHITECTURE)" == "" PROCESSOR_ARCHITECTURE = x86 !ENDIF @@ -86,60 +92,70 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE +AUTODIR = ..\lib\auto # # Programs to compile, build .lib files and link # -CC=cl.exe -LINK32=link.exe -LIB32=$(LINK32) -lib +CC = cl.exe +LINK32 = link.exe +LIB32 = $(LINK32) -lib + # # Options # + !IF "$(RUNTIME)" == "" -RUNTIME = -MD +RUNTIME = -MD !ENDIF -INCLUDES = -I.\include -I. -I.. -#PCHFLAGS = -Fpc:\temp\modules.pch -YX -DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console + +INCLUDES = -I.\include -I. -I.. +#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -TP -GX !IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib -WINIOMAYBE = +LIBC = msvcrt.lib !ELSE -LIBC = libcmt.lib -WINIOMAYBE = +LIBC = libcmt.lib !ENDIF !IF "$(CFG)" == "Debug" ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING ! ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING ! ENDIF -LINK_DBG = -debug -pdb:none +LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ELSE -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ENDIF -LINK_DBG = -release +LINK_DBG = -release +!ENDIF + +!IF "$(OBJECT)" != "" +OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) !ENDIF # we don't add LIBC here, the compiler do it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ - version.lib odbc32.lib odbccp32.lib +LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib -CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) -OBJOUT_FLAG = -Fo -EXEOUT_FLAG = -Fe +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +OBJOUT_FLAG = -Fo +EXEOUT_FLAG = -Fe + +CFLAGS_O = $(CFLAGS) $(OBJECT) #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -153,258 +169,278 @@ o = .obj .SUFFIXES : .c $(o) .dll .lib .exe .c$(o): - $(CC) -c -I$(<D) $(CFLAGS) $(OBJOUT_FLAG)$@ $< + $(CC) -c -I$(<D) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< + +.y.c: + $(NOOP) $(o).dll: $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL) -.y.c: - $(NOOP) - # -INST_BIN=$(INST_TOP)\bin -INST_LIB=$(INST_TOP)\lib -INST_POD=$(INST_LIB)\pod -INST_HTML=$(INST_POD)\html -LIBDIR=..\lib -EXTDIR=..\ext -PODDIR=..\pod -EXTUTILSDIR=$(LIBDIR)\extutils +INST_BIN = $(INST_TOP)\bin +INST_LIB = $(INST_TOP)\lib +INST_POD = $(INST_LIB)\pod +INST_HTML = $(INST_POD)\html +LIBDIR = ..\lib +EXTDIR = ..\ext +PODDIR = ..\pod +EXTUTILSDIR = $(LIBDIR)\extutils # # various targets -PERLIMPLIB=..\perl.lib -MINIPERL=..\miniperl.exe -PERLDLL=..\perl.dll -PERLEXE=..\perl.exe -GLOBEXE=..\perlglob.exe -CONFIGPM=..\lib\Config.pm -MINIMOD=..\lib\ExtUtils\Miniperl.pm -X2P=..\x2p\a2p.exe - -PL2BAT=bin\pl2bat.pl -GLOBBAT = bin\perlglob.bat - -CFGSH_TMPL = config.vc -CFGH_TMPL = config_H.vc -PERL95EXE=..\perl95.exe -XCOPY=xcopy /f /r /i /d -RCOPY=xcopy /f /r /i /e /d -NOOP=@echo -NULL= - -!IF "$(CRYPT_SRC)" != "" -CRYPT_OBJ=$(CRYPT_SRC:.c=.obj) +!IF "$(OBJECT)" == "-DPERL_OBJECT" +PERLIMPLIB = ..\perlcore.lib +PERLDLL = ..\perlcore.dll +!ELSE +PERLIMPLIB = ..\perl.lib +PERLDLL = ..\perl.dll !ENDIF -!IF "$(PERL_MALLOC)" == "define" -MALLOC_SRC = ..\malloc.c -MALLOC_OBJ = ..\malloc$(o) -!ENDIF +MINIPERL = ..\miniperl.exe +MINIDIR = .\mini +PERLEXE = ..\perl.exe +GLOBEXE = ..\perlglob.exe +CONFIGPM = ..\lib\Config.pm +MINIMOD = ..\lib\ExtUtils\Miniperl.pm +X2P = ..\x2p\a2p.exe + +PL2BAT = bin\pl2bat.pl +GLOBBAT = bin\perlglob.bat + +MAKE = nmake -nologo + +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE = ..\perl95.exe + +XCOPY = xcopy /f /r /i /d +RCOPY = xcopy /f /r /i /e /d +NOOP = @echo +NULL = # # filenames given to xsubpp must have forward slashes (since it puts # full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes - -CORE_C= ..\av.c \ - ..\byterun.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dump.c \ - ..\globals.c \ - ..\gv.c \ - ..\hv.c \ - ..\mg.c \ - ..\op.c \ - ..\perl.c \ - ..\perlio.c \ - ..\perly.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_hot.c \ - ..\pp_sys.c \ - ..\regcomp.c \ - ..\regexec.c \ - ..\run.c \ - ..\scope.c \ - ..\sv.c \ - ..\taint.c \ - ..\toke.c \ - ..\universal.c \ - ..\util.c \ - $(MALLOC_SRC) \ - $(CRYPT_SRC) - -CORE_OBJ= ..\av$(o) \ - ..\byterun$(o) \ - ..\deb$(o) \ - ..\doio$(o) \ - ..\doop$(o) \ - ..\dump$(o) \ - ..\globals$(o) \ - ..\gv$(o) \ - ..\hv$(o) \ - ..\mg$(o) \ - ..\op$(o) \ - ..\perl$(o) \ - ..\perlio$(o) \ - ..\perly$(o) \ - ..\pp$(o) \ - ..\pp_ctl$(o) \ - ..\pp_hot$(o) \ - ..\pp_sys$(o) \ - ..\regcomp$(o) \ - ..\regexec$(o) \ - ..\run$(o) \ - ..\scope$(o) \ - ..\sv$(o) \ - ..\taint$(o) \ - ..\toke$(o) \ - ..\universal$(o)\ - ..\util$(o) \ - $(MALLOC_OBJ) \ - $(CRYPT_OBJ) - -WIN32_C = perllib.c \ - win32.c \ - win32sck.c \ - win32thread.c - -WIN32_OBJ = win32$(o) \ - win32sck$(o) \ - win32thread$(o) - -PERL95_OBJ = perl95$(o) \ - win32mt$(o) \ - win32sckmt$(o) \ - $(CRYPT_OBJ) - -DLL_OBJ = perllib$(o) $(DYNALOADER)$(o) - -X2P_OBJ = ..\x2p\a2p$(o) \ - ..\x2p\hash$(o) \ - ..\x2p\str$(o) \ - ..\x2p\util$(o) \ - ..\x2p\walk$(o) - -CORE_H = ..\av.h \ - ..\byterun.h \ - ..\bytecode.h \ - ..\cop.h \ - ..\cv.h \ - ..\dosish.h \ - ..\embed.h \ - ..\form.h \ - ..\gv.h \ - ..\handy.h \ - ..\hv.h \ - ..\mg.h \ - ..\nostdio.h \ - ..\op.h \ - ..\opcode.h \ - ..\perl.h \ - ..\perlio.h \ - ..\perlsdio.h \ - ..\perlsfio.h \ - ..\perly.h \ - ..\pp.h \ - ..\proto.h \ - ..\regexp.h \ - ..\scope.h \ - ..\sv.h \ - ..\thread.h \ - ..\unixish.h \ - ..\util.h \ - ..\XSUB.h \ - .\config.h \ - ..\EXTERN.h \ - ..\perlvars.h \ - ..\intrpvar.h \ - ..\thrdvar.h \ - .\include\dirent.h \ - .\include\netdb.h \ - .\include\sys\socket.h \ - .\win32.h - -DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B -STATIC_EXT=DynaLoader - -DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader -SOCKET=$(EXTDIR)\Socket\Socket -FCNTL=$(EXTDIR)\Fcntl\Fcntl -OPCODE=$(EXTDIR)\Opcode\Opcode -SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File -IO=$(EXTDIR)\IO\IO -ATTRS=$(EXTDIR)\attrs\attrs -THREAD=$(EXTDIR)\Thread\Thread -B=$(EXTDIR)\B\B - -SOCKET_DLL=..\lib\auto\Socket\Socket.dll -FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll -OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll -SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll -IO_DLL=..\lib\auto\IO\IO.dll -ATTRS_DLL=..\lib\auto\attrs\attrs.dll -THREAD_DLL=..\lib\auto\Thread\Thread.dll -B_DLL=..\lib\auto\B\B.dll - -STATICLINKMODULES=DynaLoader -DYNALOADMODULES= \ - $(SOCKET_DLL) \ - $(FCNTL_DLL) \ - $(OPCODE_DLL) \ - $(SDBM_FILE_DLL)\ - $(IO_DLL) \ - $(ATTRS_DLL) \ - $(THREAD_DLL) \ - $(B_DLL) - -POD2HTML=$(PODDIR)\pod2html -POD2MAN=$(PODDIR)\pod2man -POD2LATEX=$(PODDIR)\pod2latex -POD2TEXT=$(PODDIR)\pod2text - -CFG_VARS= "INST_DRV=$(INST_DRV)" \ - "INST_TOP=$(INST_TOP)" \ - "archname=$(ARCHNAME)" \ - "cc=$(CC)" \ - "ccflags=$(OPTIMIZE) $(DEFINES)" \ - "cf_email=$(EMAIL)" \ - "d_crypt=$(D_CRYPT)" \ - "d_mymalloc=$(PERL_MALLOC)" \ - "libs=$(LIBFILES)" \ - "incpath=$(CCINCDIR)" \ - "libpth=$(CCLIBDIR)" \ - "libc=$(LIBC)" \ - "make=nmake" \ - "static_ext=$(STATIC_EXT)" \ - "dynamic_ext=$(DYNAMIC_EXT)" \ - "usethreads=$(USE_THREADS)" \ - "LINK_FLAGS=$(LINK_FLAGS)" \ - "optimize=$(OPTIMIZE)" +XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ + -C++ -prototypes + +CORE_SRC = \ + ..\av.c \ + ..\byterun.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\util.c + +CORE_SRC = $(CORE_SRC) $(CRYPT_SRC) + +!IF "$(PERL_MALLOC)" == "define" +CORE_SRC = $(CORE_SRC) ..\malloc.c +!ENDIF + +!IF "$(OBJECT)" == "" +CORE_SRC = $(CORE_SRC) ..\perlio.c +!ENDIF + +WIN32_SRC = \ + .\win32.c \ + .\win32sck.c + +!IF "$(USE_THREADS)" == "define" +WIN32_SRC = $(WIN32_SRC) .\win32thread.c +!ENDIF + +PERL95_SRC = \ + perl95.c \ + win32mt.c \ + win32sckmt.c + +DLL_SRC = $(DYNALOADER).c + + +!IF "$(OBJECT)" == "" +DLL_SRC = $(DLL_SRC) perllib.c +!ENDIF + +X2P_SRC = \ + ..\x2p\a2p.c \ + ..\x2p\hash.c \ + ..\x2p\str.c \ + ..\x2p\util.c \ + ..\x2p\walk.c + +CORE_H = \ + ..\av.h \ + ..\byterun.h \ + ..\bytecode.h \ + ..\cop.h \ + ..\cv.h \ + ..\dosish.h \ + ..\embed.h \ + ..\form.h \ + ..\gv.h \ + ..\handy.h \ + ..\hv.h \ + ..\mg.h \ + ..\nostdio.h \ + ..\op.h \ + ..\opcode.h \ + ..\perl.h \ + ..\perlio.h \ + ..\perlsdio.h \ + ..\perlsfio.h \ + ..\perly.h \ + ..\pp.h \ + ..\proto.h \ + ..\regexp.h \ + ..\scope.h \ + ..\sv.h \ + ..\thread.h \ + ..\unixish.h \ + ..\util.h \ + ..\XSUB.h \ + .\config.h \ + ..\EXTERN.h \ + ..\perlvars.h \ + ..\intrpvar.h \ + ..\thrdvar.h \ + .\include\dirent.h \ + .\include\netdb.h \ + .\include\sys\socket.h \ + .\win32.h + +CORE_OBJ = $(CORE_SRC:.c=.obj) +WIN32_OBJ = $(WIN32_SRC:.c=.obj) +MINICORE_OBJ = $(CORE_OBJ:..\=.\mini\) $(MINIDIR)\miniperlmain$(o) +MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\) +MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) +PERL95_OBJ = $(PERL95_SRC:.c=.obj) +DLL_OBJ = $(DLL_SRC:.c=.obj) +X2P_OBJ = $(X2P_SRC:.c=.obj) + +!IF "$(OBJECT)" != "" +MINICORE_OBJ = $(MINICORE_OBJ) $(MINIDIR)\perlio$(o) +!ENDIF + +PERLDLL_OBJ = $(CORE_OBJ) +PERLEXE_OBJ = perlmain$(o) + +!IF "$(OBJECT)" == "" +PERLDLL_OBJ = $(PERLDLL_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +!ELSE +PERLEXE_OBJ = $(PERLEXE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +!ENDIF + +DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B +STATIC_EXT = DynaLoader + +DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader +SOCKET = $(EXTDIR)\Socket\Socket +FCNTL = $(EXTDIR)\Fcntl\Fcntl +OPCODE = $(EXTDIR)\Opcode\Opcode +SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File +IO = $(EXTDIR)\IO\IO +POSIX = $(EXTDIR)\POSIX\POSIX +ATTRS = $(EXTDIR)\attrs\attrs +THREAD = $(EXTDIR)\Thread\Thread +B = $(EXTDIR)\B\B + +SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll +FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll +OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll +SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll +IO_DLL = $(AUTODIR)\IO\IO.dll +POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll +ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll +THREAD_DLL = $(AUTODIR)\Thread\Thread.dll +B_DLL = $(AUTODIR)\B\B.dll + +EXTENSION_C = \ + $(SOCKET).c \ + $(FCNTL).c \ + $(OPCODE).c \ + $(SDBM_FILE).c \ + $(IO).c \ + $(POSIX).c \ + $(ATTRS).c \ + $(THREAD).c \ + $(B).c + +EXTENSION_DLL = \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) \ + $(POSIX_DLL) \ + $(ATTRS_DLL) \ + $(THREAD_DLL) \ + $(B_DLL) + +POD2HTML = $(PODDIR)\pod2html +POD2MAN = $(PODDIR)\pod2man +POD2LATEX = $(PODDIR)\pod2latex +POD2TEXT = $(PODDIR)\pod2text + +CFG_VARS = \ + "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" \ + "archname=$(ARCHNAME)" \ + "cc=$(CC)" \ + "ccflags=$(OPTIMIZE) $(DEFINES)" \ + "cf_email=$(EMAIL)" \ + "d_crypt=$(D_CRYPT)" \ + "d_mymalloc=$(PERL_MALLOC)" \ + "libs=$(LIBFILES)" \ + "incpath=$(CCINCDIR)" \ + "libpth=$(CCLIBDIR)" \ + "libc=$(LIBC)" \ + "make=nmake" \ + "static_ext=$(STATIC_EXT)" \ + "dynamic_ext=$(DYNAMIC_EXT)" \ + "usethreads=$(USE_THREADS)" \ + "LINK_FLAGS=$(LINK_FLAGS)" \ + "optimize=$(OPTIMIZE)" # # Top targets # -all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \ - $(X2P) +all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \ + $(EXTENSION_DLL) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c #------------------------------------------------------------ -$(GLOBEXE): perlglob$(o) +$(GLOBEXE) : perlglob$(o) $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \ perlglob$(o) setargv$(o) perlglob$(o) : perlglob.c -..\miniperlmain$(o) : ..\miniperlmain.c $(CORE_H) - config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 @@ -423,24 +459,34 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(RCOPY) include $(COREDIR)\*.* $(MINIPERL) -I..\lib config_h.PL || $(MAKE) $(MAKEFLAGS) $(CONFIGPM) -$(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) $(LINK32) -subsystem:console -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ) << -$(WIN32_OBJ) : $(CORE_H) -$(CORE_OBJ) : $(CORE_H) -$(DLL_OBJ) : $(CORE_H) -$(PERL95_OBJ) : $(CORE_H) -$(X2P_OBJ) : $(CORE_H) +$(MINIDIR) : + if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" + +$(MINICORE_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*F).c + +$(MINIWIN32_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(MINI_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) +$(PERL95_OBJ) : $(CORE_H) +$(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ CCTYPE=$(CCTYPE) > perldll.def -$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(LINK32) -dll -def:perldll.def -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ) << $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -450,45 +496,60 @@ perl.def : $(MINIPERL) makeperldef.pl $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm -$(X2P) : $(X2P_OBJ) +..\x2p\a2p$(o) : ..\x2p\a2p.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c + +..\x2p\hash$(o) : ..\x2p\hash.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c + +..\x2p\str$(o) : ..\x2p\str.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c + +..\x2p\util$(o) : ..\x2p\util.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c + +..\x2p\walk$(o) : ..\x2p\walk.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c + +$(X2P) : $(MINIPERL) $(X2P_OBJ) + $(MINIPERL) ..\x2p\find2perl.PL + $(MINIPERL) ..\x2p\s2p.PL $(LINK32) -subsystem:console -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ) << perlmain.c : runperl.c copy runperl.c perlmain.c perlmain$(o) : perlmain.c - $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c + $(CC) $(CFLAGS_O) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) - $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \ - perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) - copy perl.exe $@ - del perl.exe +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) + $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ + $(PERLEXE_OBJ) $(PERLIMPLIB) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) perl95.c : runperl.c copy runperl.c perl95.c perl95$(o) : perl95.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c perl95.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c win32sckmt$(o) : win32sck.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c win32mt$(o) : win32.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32mt$(o) win32.c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) - $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \ - $(PERL95_OBJ) $(PERLIMPLIB) - copy perl95.exe $@ - del perl95.exe + $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ + $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) - if not exist ..\lib\auto mkdir ..\lib\auto + if not exist $(AUTODIR) mkdir $(AUTODIR) $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) $(XSUBPP) dl_win32.xs > $(*B).c @@ -515,7 +576,13 @@ $(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs $(MAKE) cd ..\..\win32 -$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs +$(POSIX_DLL): $(PERLEXE) $(POSIX).xs + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\win32 + +$(IO_DLL): $(PERLEXE) $(IO).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) @@ -558,7 +625,7 @@ doc: $(PERLEXE) utils: $(PERLEXE) cd ..\utils - nmake PERL=$(MINIPERL) + $(MAKE) PERL=$(MINIPERL) $(PERLEXE) -I..\lib ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph $(PERLEXE) ..\win32\$(PL2BAT) h2xs perldoc pstruct $(XCOPY) *.bat ..\win32\bin\*.* @@ -570,32 +637,54 @@ distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) -del /f *.def *.map - -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ - $(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL) - -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ - $(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c + -del /f $(EXTENSION_DLL) + -del /f $(EXTENSION_C) $(DYNALOADER).c + -del /f $(EXTDIR)\DynaLoader\dl_win32.xs + -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm + -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm + -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm + -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm + -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm + -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO + -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread + -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat - -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \ - config.h.new perl95.c + cd ..\utils + -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct + -del /f *.bat + cd ..\win32 + cd ..\x2p + -del /f find2perl s2p + -del /f *.bat + cd ..\win32 + -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new + -del /f $(CONFIGPM) + -del /f perl95.c -del /f bin\*.bat - -rmdir /s /q ..\lib\auto || rmdir /s ..\lib\auto - -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) cd $(EXTDIR) -del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib cd ..\win32 + -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) + -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) + +install : all installbare installutils installhtml -install : all doc utils +installbare : $(PERLEXE) ..\installperl $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* + +installutils : utils $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_BIN)\*.* $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* + +installhtml : doc $(RCOPY) html\*.* $(INST_HTML)\*.* inst_lib : $(CONFIGPM) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) $(RCOPY) ..\lib $(INST_LIB)\*.* minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils @@ -634,6 +723,7 @@ clean : -@erase $(PERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) + -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) @@ -642,5 +732,3 @@ clean : -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk -@erase *.pdb - - diff --git a/win32/config.bc b/win32/config.bc index dd66406f4f..cd82b30471 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -159,10 +159,10 @@ d_mkfifo='undef' d_mkstemp='undef' d_mktime='define' d_msg='undef' -d_msgctl='define' -d_msgget='define' -d_msgrcv='define' -d_msgsnd='define' +d_msgctl='undef' +d_msgget='undef' +d_msgrcv='undef' +d_msgsnd='undef' d_mymalloc='define' d_nice='undef' d_oldpthreads='undef' @@ -195,9 +195,9 @@ d_sched_yield='undef' d_seekdir='define' d_select='define' d_sem='undef' -d_semctl='define' -d_semget='define' -d_semop='define' +d_semctl='undef' +d_semget='undef' +d_semop='undef' d_setegid='undef' d_seteuid='undef' d_setgrps='undef' @@ -223,9 +223,9 @@ d_sfio='undef' d_shm='undef' d_shmat='undef' d_shmatprototype='undef' -d_shmctl='define' -d_shmdt='define' -d_shmget='define' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' diff --git a/win32/config.gc b/win32/config.gc index d571dff337..e06fe815ba 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -159,10 +159,10 @@ d_mkfifo='undef' d_mkstemp='undef' d_mktime='define' d_msg='undef' -d_msgctl='define' -d_msgget='define' -d_msgrcv='define' -d_msgsnd='define' +d_msgctl='undef' +d_msgget='undef' +d_msgrcv='undef' +d_msgsnd='undef' d_mymalloc='define' d_nice='undef' d_oldpthreads='undef' @@ -194,9 +194,9 @@ d_sched_yield='undef' d_seekdir='define' d_select='define' d_sem='undef' -d_semctl='define' -d_semget='define' -d_semop='define' +d_semctl='undef' +d_semget='undef' +d_semop='undef' d_setegid='undef' d_seteuid='undef' d_setgrps='undef' @@ -222,9 +222,9 @@ d_sfio='undef' d_shm='undef' d_shmat='undef' d_shmatprototype='undef' -d_shmctl='define' -d_shmdt='define' -d_shmget='define' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' diff --git a/win32/config.vc b/win32/config.vc index d409bae70b..84ee590de0 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -159,10 +159,10 @@ d_mkfifo='undef' d_mkstemp='undef' d_mktime='define' d_msg='undef' -d_msgctl='define' -d_msgget='define' -d_msgrcv='define' -d_msgsnd='define' +d_msgctl='undef' +d_msgget='undef' +d_msgrcv='undef' +d_msgsnd='undef' d_mymalloc='define' d_nice='undef' d_oldpthreads='undef' @@ -195,9 +195,9 @@ d_sched_yield='undef' d_seekdir='define' d_select='define' d_sem='undef' -d_semctl='define' -d_semget='define' -d_semop='define' +d_semctl='undef' +d_semget='undef' +d_semop='undef' d_setegid='undef' d_seteuid='undef' d_setgrps='undef' @@ -223,9 +223,9 @@ d_sfio='undef' d_shm='undef' d_shmat='undef' d_shmatprototype='undef' -d_shmctl='define' -d_shmdt='define' -d_shmget='define' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' diff --git a/win32/makedef.pl b/win32/makedef.pl index c6af1a0f3c..c366be4cdd 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -200,6 +200,8 @@ if ($define{'MYMALLOC'}) unless ($define{'USE_THREADS'}) { skip_symbols [qw( +Perl_getTHR +Perl_setTHR Perl_condpair_magic Perl_thr_key Perl_sv_mutex @@ -373,6 +375,7 @@ __DATA__ perl_init_i18nl10n perl_init_ext perl_alloc +perl_atexit perl_construct perl_destruct perl_free @@ -389,6 +392,11 @@ perl_call_sv perl_require_pv perl_eval_pv perl_eval_sv +perl_new_ctype +perl_new_collate +perl_new_numeric +perl_set_numeric_standard +perl_set_numeric_local boot_DynaLoader Perl_thread_create win32_errno diff --git a/win32/makefile.mk b/win32/makefile.mk index 6fc900572e..17dda74c73 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -49,6 +49,9 @@ PERL_MALLOC *= define # # set the install locations of the compiler include/libraries +# (you'll need to quote the value if it contains spaces: i.e. +# CCHOME *= "f:\Program Files\vc" +# #CCHOME *= f:\msdev\vc CCHOME *= C:\bc5 #CCHOME *= D:\packages\mingw32 @@ -63,29 +66,29 @@ CCLIBDIR *= $(CCHOME)\lib # # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) -#EMAIL *= +#EMAIL *= ##################### CHANGE THESE ONLY IF YOU MUST ##################### .IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" -D_CRYPT=undef +D_CRYPT = undef .ELSE -D_CRYPT=define -CRYPT_FLAG=-DHAVE_DES_FCRYPT +D_CRYPT = define +CRYPT_FLAG = -DHAVE_DES_FCRYPT .ENDIF -.IF "$(PERL_MALLOC)" == "" -PERL_MALLOC *= undef +.IF "$(OBJECT)" != "" +PERL_MALLOC != undef .ENDIF +PERL_MALLOC *= undef + +USE_THREADS *= undef + #BUILDOPT *= -DMULTIPLICITY #BUILDOPT *= -DPERL_GLOBAL_STRUCT -DMULTIPLICITY # -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include -.IF "$(USE_THREADS)" == "" -USE_THREADS = undef -.ENDIF - .IMPORT .IGNORE : PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITECTURE *= x86 @@ -98,6 +101,7 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE +AUTODIR = ..\lib\auto # # Programs to compile, build .lib files and link @@ -107,133 +111,146 @@ COREDIR = ..\lib\CORE .IF "$(CCTYPE)" == "BORLAND" -CC = bcc32 -LINK32 = tlink32 -LIB32 = tlib -IMPLIB = implib -c +CC = bcc32 +LINK32 = tlink32 +LIB32 = tlib +IMPLIB = implib -c # # Options # -RUNTIME = -D_RTLDLL -INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) -#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console -LIBC = cw32mti.lib -LIBFILES = $(CRYPT_LIB) import32.lib $(LIBC) odbc32.lib odbccp32.lib +RUNTIME = -D_RTLDLL +INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) +#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch +DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -P -WINIOMAYBE = +LIBC = cw32mti.lib +LIBFILES = $(CRYPT_LIB) import32.lib $(LIBC) odbc32.lib odbccp32.lib .IF "$(CFG)" == "Debug" -OPTIMIZE = -v $(RUNTIME) -DDEBUGGING -LINK_DBG = -v +OPTIMIZE = -v $(RUNTIME) -DDEBUGGING +LINK_DBG = -v .ELSE -OPTIMIZE = -5 -O2 $(RUNTIME) -LINK_DBG = +OPTIMIZE = -O2 $(RUNTIME) +LINK_DBG = .ENDIF -CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) -OBJOUT_FLAG = -o -EXEOUT_FLAG = -e +CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +OBJOUT_FLAG = -o +EXEOUT_FLAG = -e .ELIF "$(CCTYPE)" == "GCC" -CC = gcc -pipe -LINK32 = gcc -pipe -LIB32 = ar -IMPLIB = dlltool +CC = gcc -pipe +LINK32 = gcc -pipe +LIB32 = ar +IMPLIB = dlltool o = .o # # Options # -RUNTIME = -INCLUDES = -I.\include -I. -I.. -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console -LIBC = -lcrtdll -LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 -lmingw32 \ - -lgcc -lmoldname $(LIBC) -lkernel32 +RUNTIME = +INCLUDES = -I.\include -I. -I.. +DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -xc++ -WINIOMAYBE = +LIBC = -lcrtdll +LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 -lmingw32 \ + -lgcc -lmoldname $(LIBC) -lkernel32 .IF "$(CFG)" == "Debug" -OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING -LINK_DBG = -g +OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING +LINK_DBG = -g .ELSE -OPTIMIZE = -g -O2 $(RUNTIME) -LINK_DBG = +OPTIMIZE = -g -O2 $(RUNTIME) +LINK_DBG = .ENDIF -CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) -OBJOUT_FLAG = -o -EXEOUT_FLAG = -o +CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +OBJOUT_FLAG = -o +EXEOUT_FLAG = -o .ELSE -CC=cl.exe -LINK32=link.exe -LIB32=$(LINK32) -lib +CC = cl.exe +LINK32 = link.exe +LIB32 = $(LINK32) -lib + # # Options # + .IF "$(RUNTIME)" == "" -RUNTIME = -MD +RUNTIME = -MD .ENDIF -INCLUDES = -I.\include -I. -I.. -#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console + +INCLUDES = -I.\include -I. -I.. +#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -TP -GX .IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib -WINIOMAYBE = +LIBC = msvcrt.lib .ELSE -LIBC = libcmt.lib -WINIOMAYBE = +LIBC = libcmt.lib .ENDIF .IF "$(CFG)" == "Debug" .IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING .ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING .ENDIF -LINK_DBG = -debug -pdb:none +LINK_DBG = -debug -pdb:none .ELSE .IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ELSE -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ENDIF -LINK_DBG = -release +LINK_DBG = -release .ENDIF -# we don't add LIBC here, the compiler do it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ - version.lib odbc32.lib odbccp32.lib +# we don't add LIBC here, the compiler does it based on -MD/-MT +LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib -CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) -OBJOUT_FLAG = -Fo -EXEOUT_FLAG = -Fe +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +OBJOUT_FLAG = -Fo +EXEOUT_FLAG = -Fe + +.ENDIF +.IF "$(OBJECT)" != "" +OPTIMIZE += $(CXX_FLAG) .ENDIF +CFLAGS_O = $(CFLAGS) $(OBJECT) + #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## o *= .obj +LKPRE = INPUT ( +LKPOST = ) + # # Rules # @@ -241,7 +258,7 @@ o *= .obj .SUFFIXES : .c $(o) .dll .lib .exe .a .c$(o): - $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS) $(OBJOUT_FLAG)$@ $< + $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< .y.c: $(NOOP) @@ -259,256 +276,274 @@ $(o).dll: .ENDIF # -INST_BIN=$(INST_TOP)\bin -INST_LIB=$(INST_TOP)\lib -INST_POD=$(INST_LIB)\pod -INST_HTML=$(INST_POD)\html -LIBDIR=..\lib -EXTDIR=..\ext -PODDIR=..\pod -EXTUTILSDIR=$(LIBDIR)\extutils +INST_BIN = $(INST_TOP)\bin +INST_LIB = $(INST_TOP)\lib +INST_POD = $(INST_LIB)\pod +INST_HTML = $(INST_POD)\html +LIBDIR = ..\lib +EXTDIR = ..\ext +PODDIR = ..\pod +EXTUTILSDIR = $(LIBDIR)\extutils # # various targets -PERLIMPLIB=..\perl.lib -MINIPERL=..\miniperl.exe -PERLDLL=..\perl.dll -PERLEXE=..\perl.exe -GLOBEXE=..\perlglob.exe -CONFIGPM=..\lib\Config.pm -MINIMOD=..\lib\ExtUtils\Miniperl.pm -X2P=..\x2p\a2p.exe - -PL2BAT=bin\pl2bat.pl -GLOBBAT = bin\perlglob.bat +.IF "$(OBJECT)" == "-DPERL_OBJECT" +PERLIMPLIB = ..\perlcore.lib +PERLDLL = ..\perlcore.dll +.ELSE +PERLIMPLIB = ..\perl.lib +PERLDLL = ..\perl.dll +.ENDIF + +MINIPERL = ..\miniperl.exe +MINIDIR = .\mini +PERLEXE = ..\perl.exe +GLOBEXE = ..\perlglob.exe +CONFIGPM = ..\lib\Config.pm +MINIMOD = ..\lib\ExtUtils\Miniperl.pm +X2P = ..\x2p\a2p.exe + +PL2BAT = bin\pl2bat.pl +GLOBBAT = bin\perlglob.bat .IF "$(CCTYPE)" == "BORLAND" -CFGSH_TMPL = config.bc -CFGH_TMPL = config_H.bc +CFGSH_TMPL = config.bc +CFGH_TMPL = config_H.bc .ELIF "$(CCTYPE)" == "GCC" -CFGSH_TMPL = config.gc -CFGH_TMPL = config_H.gc +CFGSH_TMPL = config.gc +CFGH_TMPL = config_H.gc .ELSE -CFGSH_TMPL = config.vc -CFGH_TMPL = config_H.vc -PERL95EXE=..\perl95.exe +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE = ..\perl95.exe .ENDIF -XCOPY=xcopy /f /r /i /d -RCOPY=xcopy /f /r /i /e /d -NOOP=@echo -#NULL= +XCOPY = xcopy /f /r /i /d +RCOPY = xcopy /f /r /i /e /d +NOOP = @echo -.IF "$(CRYPT_SRC)" != "" -CRYPT_OBJ=$(CRYPT_SRC:db:+$(o)) -.ENDIF +# +# filenames given to xsubpp must have forward slashes (since it puts +# full pathnames in #line strings) +XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ + -C++ -prototypes + +CORE_SRC = \ + ..\av.c \ + ..\byterun.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\util.c + +CORE_SRC += $(CRYPT_SRC) .IF "$(PERL_MALLOC)" == "define" -MALLOC_SRC = ..\malloc.c -MALLOC_OBJ = ..\malloc$(o) +CORE_SRC += ..\malloc.c .ENDIF -# -# filenames given to xsubpp must have forward slashes (since it puts -# full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes - -CORE_C= ..\av.c \ - ..\byterun.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dump.c \ - ..\globals.c \ - ..\gv.c \ - ..\hv.c \ - ..\mg.c \ - ..\op.c \ - ..\perl.c \ - ..\perlio.c \ - ..\perly.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_hot.c \ - ..\pp_sys.c \ - ..\regcomp.c \ - ..\regexec.c \ - ..\run.c \ - ..\scope.c \ - ..\sv.c \ - ..\taint.c \ - ..\toke.c \ - ..\universal.c \ - ..\util.c \ - $(MALLOC_SRC) \ - $(CRYPT_SRC) - -CORE_OBJ= ..\av$(o) \ - ..\byterun$(o) \ - ..\deb$(o) \ - ..\doio$(o) \ - ..\doop$(o) \ - ..\dump$(o) \ - ..\globals$(o) \ - ..\gv$(o) \ - ..\hv$(o) \ - ..\mg$(o) \ - ..\op$(o) \ - ..\perl$(o) \ - ..\perlio$(o) \ - ..\perly$(o) \ - ..\pp$(o) \ - ..\pp_ctl$(o) \ - ..\pp_hot$(o) \ - ..\pp_sys$(o) \ - ..\regcomp$(o) \ - ..\regexec$(o) \ - ..\run$(o) \ - ..\scope$(o) \ - ..\sv$(o) \ - ..\taint$(o) \ - ..\toke$(o) \ - ..\universal$(o)\ - ..\util$(o) \ - $(MALLOC_OBJ) \ - $(CRYPT_OBJ) - -WIN32_C = perllib.c \ - win32.c \ - win32sck.c \ - win32thread.c - -WIN32_OBJ = win32$(o) \ - win32sck$(o) \ - win32thread$(o) - -PERL95_OBJ = perl95$(o) \ - win32mt$(o) \ - win32sckmt$(o) \ - $(CRYPT_OBJ) - -DLL_OBJ = perllib$(o) $(DYNALOADER)$(o) - -X2P_OBJ = ..\x2p\a2p$(o) \ - ..\x2p\hash$(o) \ - ..\x2p\str$(o) \ - ..\x2p\util$(o) \ - ..\x2p\walk$(o) - -CORE_H = ..\av.h \ - ..\byterun.h \ - ..\bytecode.h \ - ..\cop.h \ - ..\cv.h \ - ..\dosish.h \ - ..\embed.h \ - ..\form.h \ - ..\gv.h \ - ..\handy.h \ - ..\hv.h \ - ..\mg.h \ - ..\nostdio.h \ - ..\op.h \ - ..\opcode.h \ - ..\perl.h \ - ..\perlio.h \ - ..\perlsdio.h \ - ..\perlsfio.h \ - ..\perly.h \ - ..\pp.h \ - ..\proto.h \ - ..\regexp.h \ - ..\scope.h \ - ..\sv.h \ - ..\thread.h \ - ..\unixish.h \ - ..\util.h \ - ..\XSUB.h \ - .\config.h \ - ..\EXTERN.h \ - ..\perlvars.h \ - ..\intrpvar.h \ - ..\thrdvar.h \ - .\include\dirent.h \ - .\include\netdb.h \ - .\include\sys\socket.h \ - .\win32.h - -DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B -STATIC_EXT=DynaLoader - -DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader -SOCKET=$(EXTDIR)\Socket\Socket -FCNTL=$(EXTDIR)\Fcntl\Fcntl -OPCODE=$(EXTDIR)\Opcode\Opcode -SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File -IO=$(EXTDIR)\IO\IO -ATTRS=$(EXTDIR)\attrs\attrs -THREAD=$(EXTDIR)\Thread\Thread -B=$(EXTDIR)\B\B - -SOCKET_DLL=..\lib\auto\Socket\Socket.dll -FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll -OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll -SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll -IO_DLL=..\lib\auto\IO\IO.dll -ATTRS_DLL=..\lib\auto\attrs\attrs.dll -THREAD_DLL=..\lib\auto\Thread\Thread.dll -B_DLL=..\lib\auto\B\B.dll - -STATICLINKMODULES=DynaLoader -DYNALOADMODULES= \ - $(SOCKET_DLL) \ - $(FCNTL_DLL) \ - $(OPCODE_DLL) \ - $(SDBM_FILE_DLL)\ - $(IO_DLL) \ - $(ATTRS_DLL) \ - $(THREAD_DLL) \ - $(B_DLL) - -POD2HTML=$(PODDIR)\pod2html -POD2MAN=$(PODDIR)\pod2man -POD2LATEX=$(PODDIR)\pod2latex -POD2TEXT=$(PODDIR)\pod2text - -CFG_VARS= "INST_DRV=$(INST_DRV)" \ - "INST_TOP=$(INST_TOP)" \ - "archname=$(ARCHNAME)" \ - "cc=$(CC)" \ - "ccflags=$(OPTIMIZE) $(DEFINES)" \ - "cf_email=$(EMAIL)" \ - "d_crypt=$(D_CRYPT)" \ - "d_mymalloc=$(PERL_MALLOC)" \ - "libs=$(LIBFILES:f)" \ - "incpath=$(CCINCDIR)" \ - "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \ - "libc=$(LIBC)" \ - "make=dmake" \ - "static_ext=$(STATIC_EXT)" \ - "dynamic_ext=$(DYNAMIC_EXT)" \ - "usethreads=$(USE_THREADS)" \ - "LINK_FLAGS=$(LINK_FLAGS)" \ - "optimize=$(OPTIMIZE)" +.IF "$(OBJECT)" == "" +CORE_SRC += ..\perlio.c +.ENDIF + +WIN32_SRC = \ + .\win32.c \ + .\win32sck.c + +.IF "$(USE_THREADS)" == "define" +WIN32_SRC += .\win32thread.c +.ENDIF + +PERL95_SRC = \ + perl95.c \ + win32mt.c \ + win32sckmt.c + +DLL_SRC = $(DYNALOADER).c + + +.IF "$(OBJECT)" == "" +DLL_SRC += perllib.c +.ENDIF + +X2P_SRC = \ + ..\x2p\a2p.c \ + ..\x2p\hash.c \ + ..\x2p\str.c \ + ..\x2p\util.c \ + ..\x2p\walk.c + +CORE_H = \ + ..\av.h \ + ..\byterun.h \ + ..\bytecode.h \ + ..\cop.h \ + ..\cv.h \ + ..\dosish.h \ + ..\embed.h \ + ..\form.h \ + ..\gv.h \ + ..\handy.h \ + ..\hv.h \ + ..\mg.h \ + ..\nostdio.h \ + ..\op.h \ + ..\opcode.h \ + ..\perl.h \ + ..\perlio.h \ + ..\perlsdio.h \ + ..\perlsfio.h \ + ..\perly.h \ + ..\pp.h \ + ..\proto.h \ + ..\regexp.h \ + ..\scope.h \ + ..\sv.h \ + ..\thread.h \ + ..\unixish.h \ + ..\util.h \ + ..\XSUB.h \ + .\config.h \ + ..\EXTERN.h \ + ..\perlvars.h \ + ..\intrpvar.h \ + ..\thrdvar.h \ + .\include\dirent.h \ + .\include\netdb.h \ + .\include\sys\socket.h \ + .\win32.h + +CORE_OBJ = $(CORE_SRC:db:+$(o)) +WIN32_OBJ = $(WIN32_SRC:db:+$(o)) +MINICORE_OBJ = $(MINIDIR)\{$(CORE_OBJ:f) miniperlmain$(o)} +MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)} +MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) +PERL95_OBJ = $(PERL95_SRC:db:+$(o)) +DLL_OBJ = $(DLL_SRC:db:+$(o)) +X2P_OBJ = $(X2P_SRC:db:+$(o)) + +.IF "$(OBJECT)" != "" +MINICORE_OBJ += $(MINIDIR)\perlio$(o) +.ENDIF + +PERLDLL_OBJ = $(CORE_OBJ) +PERLEXE_OBJ = perlmain$(o) + +.IF "$(OBJECT)" == "" +PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ) +.ELSE +PERLEXE_OBJ += $(WIN32_OBJ) $(DLL_OBJ) +.ENDIF + +DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B +STATIC_EXT = DynaLoader + +DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader +SOCKET = $(EXTDIR)\Socket\Socket +FCNTL = $(EXTDIR)\Fcntl\Fcntl +OPCODE = $(EXTDIR)\Opcode\Opcode +SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File +IO = $(EXTDIR)\IO\IO +POSIX = $(EXTDIR)\POSIX\POSIX +ATTRS = $(EXTDIR)\attrs\attrs +THREAD = $(EXTDIR)\Thread\Thread +B = $(EXTDIR)\B\B + +SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll +FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll +OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll +SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll +IO_DLL = $(AUTODIR)\IO\IO.dll +POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll +ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll +THREAD_DLL = $(AUTODIR)\Thread\Thread.dll +B_DLL = $(AUTODIR)\B\B.dll + +EXTENSION_C = \ + $(SOCKET).c \ + $(FCNTL).c \ + $(OPCODE).c \ + $(SDBM_FILE).c \ + $(IO).c \ + $(POSIX).c \ + $(ATTRS).c \ + $(THREAD).c \ + $(B).c + +EXTENSION_DLL = \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) \ + $(POSIX_DLL) \ + $(ATTRS_DLL) \ + $(THREAD_DLL) \ + $(B_DLL) + +POD2HTML = $(PODDIR)\pod2html +POD2MAN = $(PODDIR)\pod2man +POD2LATEX = $(PODDIR)\pod2latex +POD2TEXT = $(PODDIR)\pod2text + +CFG_VARS = \ + "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" \ + "archname=$(ARCHNAME)" \ + "cc=$(CC)" \ + "ccflags=$(OPTIMIZE) $(DEFINES)" \ + "cf_email=$(EMAIL)" \ + "d_crypt=$(D_CRYPT)" \ + "d_mymalloc=$(PERL_MALLOC)" \ + "libs=$(LIBFILES:f)" \ + "incpath=$(CCINCDIR)" \ + "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \ + "libc=$(LIBC)" \ + "make=dmake" \ + "static_ext=$(STATIC_EXT)" \ + "dynamic_ext=$(DYNAMIC_EXT)" \ + "usethreads=$(USE_THREADS)" \ + "LINK_FLAGS=$(LINK_FLAGS)" \ + "optimize=$(OPTIMIZE)" # # Top targets # -all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \ - $(X2P) +all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \ + $(EXTENSION_DLL) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c #------------------------------------------------------------ -$(GLOBEXE): perlglob$(o) +$(GLOBEXE) : perlglob$(o) .IF "$(CCTYPE)" == "BORLAND" $(CC) -c -w -v -tWM -I$(CCINCDIR) perlglob.c $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \ @@ -522,8 +557,6 @@ $(GLOBEXE): perlglob$(o) perlglob$(o) : perlglob.c -..\miniperlmain$(o) : ..\miniperlmain.c $(CORE_H) - config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 @@ -554,58 +587,60 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(RCOPY) include $(COREDIR)\*.* $(MINIPERL) -I..\lib config_h.PL || $(MAKE) $(MAKEMACROS) $(CONFIGPM) -LKPRE = INPUT ( -LKPOST = ) - -$(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpe -ap $(LINK_FLAGS) \ - @$(mktmp c0x32$(o) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) + @$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -v -o $@ $(LINK_FLAGS) \ - $(mktmp $(LKPRE) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) + $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) .ELSE $(LINK32) -subsystem:console -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\)) + @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\)) .ENDIF -$(WIN32_OBJ) : $(CORE_H) -$(CORE_OBJ) : $(CORE_H) -$(DLL_OBJ) : $(CORE_H) -$(X2P_OBJ) : $(CORE_H) +$(MINIDIR) : + if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" + +$(MINICORE_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c + +$(MINIWIN32_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(MINI_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) +$(PERL95_OBJ) : $(CORE_H) +$(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ CCTYPE=$(CCTYPE) > perldll.def -$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpd -ap $(LINK_FLAGS) \ - @$(mktmp c0d32$(o) $(CORE_OBJ:s,\,\\) \ - $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)\n \ + @$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \ $@,\n \ $(LIBFILES)\n \ perldll.def\n) $(IMPLIB) $*.lib $@ .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \ - $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \ - $(DLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) + $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) dlltool --output-lib $(PERLIMPLIB) \ --dllname perl.dll \ --def perldll.def \ --base-file perl.base \ --output-exp perl.exp $(LINK32) -mdll -o $@ $(LINK_FLAGS) \ - $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \ - $(DLL_OBJ:s,\,\\) $(LIBFILES) perl.exp $(LKPOST)) + $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \ + perl.exp $(LKPOST)) .ELSE $(LINK32) -dll -def:perldll.def -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ:s,\,\\) \ - $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)) + @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\)) .ENDIF $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -615,7 +650,22 @@ perl.def : $(MINIPERL) makeperldef.pl $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm -$(X2P) : $(X2P_OBJ) +..\x2p\a2p$(o) : ..\x2p\a2p.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c + +..\x2p\hash$(o) : ..\x2p\hash.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c + +..\x2p\str$(o) : ..\x2p\str.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c + +..\x2p\util$(o) : ..\x2p\util.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c + +..\x2p\walk$(o) : ..\x2p\walk.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c + +$(X2P) : $(MINIPERL) $(X2P_OBJ) $(MINIPERL) ..\x2p\find2perl.PL $(MINIPERL) ..\x2p\s2p.PL .IF "$(CCTYPE)" == "BORLAND" @@ -633,23 +683,23 @@ perlmain.c : runperl.c copy runperl.c perlmain.c perlmain$(o) : perlmain.c - $(CC) $(CFLAGS) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c + $(CC) $(CFLAGS_O) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpe -ap $(LINK_FLAGS) \ - @$(mktmp c0x32$(o) perlmain$(o) $(WINIOMAYBE)\n \ + @$(mktmp c0x32$(o) $(PERLEXE_OBJ)\n \ $@,\n \ $(PERLIMPLIB) $(LIBFILES)\n) .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -o $@ $(LINK_FLAGS) \ - perlmain.o $(WINIOMAYBE) $(PERLIMPLIB) $(LIBFILES) + $(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES) .ELSE $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) + $(PERLEXE_OBJ) $(PERLIMPLIB) .ENDIF copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) .IF "$(CCTYPE)" != "BORLAND" .IF "$(CCTYPE)" != "GCC" @@ -658,23 +708,25 @@ perl95.c : runperl.c copy runperl.c perl95.c perl95$(o) : perl95.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c perl95.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c win32sckmt$(o) : win32sck.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c win32mt$(o) : win32.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32mt$(o) win32.c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) - $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - $(PERL95_OBJ) $(PERLIMPLIB) + $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ + $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib .ENDIF .ENDIF $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) - if not exist ..\lib\auto mkdir ..\lib\auto + if not exist $(AUTODIR) mkdir $(AUTODIR) $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c . @@ -697,6 +749,11 @@ $(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\$(*B) && $(MAKE) +$(POSIX_DLL): $(PERLEXE) $(POSIX).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + $(IO_DLL): $(PERLEXE) $(IO).xs cd $(EXTDIR)\$(*B) && \ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl @@ -743,34 +800,50 @@ distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) -del /f *.def *.map - -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ - $(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL) - -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ - $(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c + -del /f $(EXTENSION_DLL) + -del /f $(EXTENSION_C) $(DYNALOADER).c + -del /f $(EXTDIR)\DynaLoader\dl_win32.xs + -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm + -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm + -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm + -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm + -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm + -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO + -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread + -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat + -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct *.bat + -cd ..\x2p && del /f find2perl s2p *.bat -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new + -del /f $(CONFIGPM) .IF "$(PERL95EXE)" != "" -del /f perl95.c .ENDIF -del /f bin\*.bat -cd $(EXTDIR) && del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib - -rmdir /s /q ..\lib\auto || rmdir /s ..\lib\auto + -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) -install : all doc utils +install : all installbare installutils installhtml + +installbare : $(PERLEXE) ..\installperl .IF "$(PERL95EXE)" != "" $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* .ENDIF + +installutils : utils $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_BIN)\*.* $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* + +installhtml : doc $(RCOPY) html\*.* $(INST_HTML)\*.* inst_lib : $(CONFIGPM) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) $(RCOPY) ..\lib $(INST_LIB)\*.* minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils @@ -812,6 +885,7 @@ clean : -@erase $(PERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) + -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) @@ -820,5 +894,3 @@ clean : -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk -@erase *.pdb - - diff --git a/win32/win32.c b/win32/win32.c index af7c4a8616..9cee6b51fa 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -73,48 +73,29 @@ static BOOL has_redirection(char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); -char * w32_perlshell_tokens = Nullch; -char ** w32_perlshell_vec; -long w32_perlshell_items = -1; -DWORD w32_platform = (DWORD)-1; -char w32_perllib_root[MAX_PATH+1]; HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; -#ifndef __BORLANDC__ -long w32_num_children = 0; -HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS]; -#endif - -#ifndef FOPEN_MAX -# if defined(_NSTREAM_) -# define FOPEN_MAX _NSTREAM_ -# elsif defined(_NFILE_) -# define FOPEN_MAX _NFILE_ -# elsif defined(_NFILE) -# define FOPEN_MAX _NFILE -# endif -#endif - -#ifndef USE_CRT_POPEN -int w32_popen_pids[FOPEN_MAX]; -#endif +static DWORD w32_platform = (DWORD)-1; #ifdef USE_THREADS # ifdef USE_DECLSPEC_THREAD __declspec(thread) char strerror_buffer[512]; __declspec(thread) char getlogin_buffer[128]; +__declspec(thread) char w32_perllib_root[MAX_PATH+1]; # ifdef HAVE_DES_FCRYPT __declspec(thread) char crypt_buffer[30]; # endif # else # define strerror_buffer (thr->i.Wstrerror_buffer) # define getlogin_buffer (thr->i.Wgetlogin_buffer) +# define w32_perllib_root (thr->i.Ww32_perllib_root) # define crypt_buffer (thr->i.Wcrypt_buffer) # endif #else -char strerror_buffer[512]; -char getlogin_buffer[128]; +static char strerror_buffer[512]; +static char getlogin_buffer[128]; +static char w32_perllib_root[MAX_PATH+1]; # ifdef HAVE_DES_FCRYPT -char crypt_buffer[30]; +static char crypt_buffer[30]; # endif #endif @@ -131,8 +112,10 @@ IsWinNT(void) { char * win32_perllib_path(char *sfx,...) { + dTHR; va_list ap; char *end; + va_start(ap,sfx); GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) ? GetModuleHandle(NULL) @@ -882,7 +865,7 @@ win32_utime(const char *filename, struct utimbuf *times) DllExport int win32_wait(int *status) { -#ifdef __BORLANDC__ +#ifdef USE_RTL_WAIT return wait(status); #else /* XXX this wait emulation only knows about processes @@ -1407,7 +1390,7 @@ win32_pipe(int *pfd, unsigned int size, int mode) DllExport FILE* win32_popen(const char *command, const char *mode) { -#ifdef USE_CRT_POPEN +#ifdef USE_RTL_POPEN return _popen(command, mode); #else int p[2]; @@ -1467,7 +1450,7 @@ win32_popen(const char *command, const char *mode) /* close saved handle */ win32_close(oldfd); - w32_popen_pids[p[parent]] = childpid; + sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); /* we have an fd, return a file stream */ return (win32_fdopen(p[parent], (char *)mode)); @@ -1482,7 +1465,7 @@ cleanup: } return (NULL); -#endif /* USE_CRT_POPEN */ +#endif /* USE_RTL_POPEN */ } /* @@ -1492,13 +1475,22 @@ cleanup: DllExport int win32_pclose(FILE *pf) { -#ifdef USE_CRT_POPEN +#ifdef USE_RTL_POPEN return _pclose(pf); #else - int fd, childpid, status; - fd = win32_fileno(pf); - childpid = w32_popen_pids[fd]; +#ifndef USE_RTL_WAIT + int child; +#endif + + int childpid, status; + SV *sv; + + sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); + if (SvIOK(sv)) + childpid = SvIVX(sv); + else + childpid = 0; if (!childpid) { errno = EBADF; @@ -1506,7 +1498,18 @@ win32_pclose(FILE *pf) } win32_fclose(pf); - w32_popen_pids[fd] = 0; + SvIVX(sv) = 0; + +#ifndef USE_RTL_WAIT + for (child = 0 ; child < w32_num_children ; ++child) { + if (w32_child_pids[child] == (HANDLE)childpid) { + Copy(&w32_child_pids[child+1], &w32_child_pids[child], + (w32_num_children-child-1), HANDLE); + w32_num_children--; + break; + } + } +#endif /* wait for the child */ if (cwait(&status, childpid, WAIT_CHILD) == -1) @@ -1518,7 +1521,7 @@ win32_pclose(FILE *pf) return (status); #endif -#endif /* USE_CRT_OPEN */ +#endif /* USE_RTL_POPEN */ } DllExport int @@ -1613,8 +1616,13 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) { int status; +#ifndef USE_RTL_WAIT + if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS) + return -1; +#endif + status = spawnvp(mode, cmdname, (char * const *) argv); -#ifndef __BORLANDC__ +#ifndef USE_RTL_WAIT /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId * while VC RTL returns pinfo.hProcess. For purposes of the custom * implementation of win32_wait(), we assume the latter. @@ -1913,8 +1921,8 @@ static XS(w32_DomainName) { dXSARGS; -#ifdef __MINGW32__ - /* mingw32 doesn't have NetWksta*() yet, so do it the old way */ +#ifndef HAS_NETWKSTAGETINFO + /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */ char name[256]; DWORD size = sizeof(name); if (GetUserName(name,&size)) { @@ -1929,7 +1937,9 @@ XS(w32_DomainName) } } #else - /* this way is more reliable, in case user has a local account */ + /* this way is more reliable, in case user has a local account. + * XXX need dynamic binding of netapi32.dll symbols or this will fail on + * Win95. Probably makes more sense to move it into libwin32. */ char dname[256]; DWORD dnamelen = sizeof(dname); PWKSTA_INFO_100 pwi; @@ -2109,6 +2119,13 @@ Perl_init_os_extras() char *file = __FILE__; dXSUB_SYS; + w32_perlshell_tokens = Nullch; + w32_perlshell_items = -1; + w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */ +#ifndef USE_RTL_WAIT + w32_num_children = 0; +#endif + /* these names are Activeware compatible */ newXS("Win32::GetCwd", w32_GetCwd, file); newXS("Win32::SetCwd", w32_SetCwd, file); @@ -2151,7 +2168,7 @@ Perl_win32_init(int *argcp, char ***argvp) #if !defined(_ALPHA_) && !defined(__GNUC__) _control87(MCW_EM, MCW_EM); #endif - MALLOC_INIT; + MALLOC_INIT; } #ifdef USE_BINMODE_SCRIPTS diff --git a/win32/win32.h b/win32/win32.h index 781c720ed0..d2ac9b9a5d 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -119,6 +119,8 @@ struct tms { #pragma warn -csu /* "comparing signed and unsigned values" */ #pragma warn -pro /* "call to function with no prototype" */ +#define USE_RTL_WAIT /* Borland has a working wait() */ + #endif #ifdef _MSC_VER /* Microsoft Visual C++ */ @@ -216,6 +218,28 @@ EXT void win32_strip_return(struct sv *sv); #define win32_strip_return(sv) NOOP #endif +#define HAVE_INTERP_INTERN +struct interp_intern { + char * w32_perlshell_tokens; + char ** w32_perlshell_vec; + long w32_perlshell_items; + struct av * w32_fdpid; +#ifndef USE_RTL_WAIT + long w32_num_children; + HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS]; +#endif +}; + +#define w32_perlshell_tokens (sys_intern.w32_perlshell_tokens) +#define w32_perlshell_vec (sys_intern.w32_perlshell_vec) +#define w32_perlshell_items (sys_intern.w32_perlshell_items) +#define w32_fdpid (sys_intern.w32_fdpid) + +#ifndef USE_RTL_WAIT +# define w32_num_children (sys_intern.w32_num_children) +# define w32_child_pids (sys_intern.w32_child_pids) +#endif + /* * Now Win32 specific per-thread data stuff */ @@ -229,6 +253,7 @@ struct thread_intern { char Wstrerror_buffer[512]; struct servent Wservent; char Wgetlogin_buffer[128]; + char Ww32_perllib_root[MAX_PATH+1]; # ifdef USE_SOCKETS_AS_HANDLES int Winit_socktype; # endif |