From: Tim Bunce Date: Thu, 7 Aug 1997 00:00:00 +0000 (+0000) Subject: [inseperable differences up to perl 5.004_02] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8490252049bf42d3d2f75d89178a8682bf22ba74;p=p5sagit%2Fp5-mst-13.2.git [inseperable differences up to perl 5.004_02] [editor's note - this list of differences was built manually, so is either a little inaccurate or the most well preened out of the "unapplied changes" lists so far. It certainly didn't get the usual injection of message bodies. The aim of these changes is to give you a vector for finding a list message if you have an annotate operation hit this commit] ------ BUILD PROCESS ------ Title: "[PATCH]: HP-UX 10 w/o transition links" From: Jeff Okamoto Msg-ID: <199706231650.AA070364627@hpcc123.corp.hp.com> Files: Configure Title: "INSTALL updates for GNU ld and __inet_* errors" From: Andy Dougherty Files: INSTALL ------ CORE LANGUAGE ------ Title: "[PATCH] Additional patch for "Can't execute ..."" From: Ilya Zakharevich Msg-ID: <199707191651.MAA04897@monk.mps.ohio-state.edu> Files: pod/perldiag.pod perl.c See 21fc060b433a5fd003b9aca5789342207c46ada4 and 2a92aaa05aa1acbf01092228d30e9b1d7b2a3f61 Title: "[PATCH] Re: Can't pack literals as pointers" From: Gurusamy Sarathy Msg-ID: <199708012250.SAA20278@aatma.engin.umich.edu> Files: pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t On Wed, 25 Jun 1997 00:23:18 GMT, John Tobey wrote: > >IMHO, pack("p","foo") should evaluate to a pointer that's valid >in the current context. pack("p",undef) should return the NULL >value. Currently, they both produce the error "Modification of a >read-only value attempted". > >This looks pretty easy to fix, so I've prepared a diff against >the 5.004_01 distribution. This tests fine on my Linux. I hope >I'm not introducing a memory leak or other ailment... That doesn't look quite right to me. When provided a literal, you should point at the actual literal (which normally has a global lifetime), rather than making a mortal copy of it and pointing at that. The mortal copy will be destroyed at the next statement boundary, and you'll be left with a dangling pointer when you unpack(). You're doing the very thing the XXX comment above was intended to highlight. I do agree that literals should be pack('p')-able. So, I'd suggest the change be modified [...] Title: "One-liner regex causes SEGV on 5.003 under HP-UX and Linux" From: Hugo van der Sanden Msg-ID: <199707061144.MAA04443@crypt.compulink.co.uk> Files: regexec.c t/op/re_tests [was originally credited as the same change as 44ed422101809141bc33c2b85c1cff357de4d7bf] Title: "Free temps before calling END blocks", "Too late destruction" From: Chip Salzenberg Msg-ID: Files: perl.c Title: "Forbid "goto" into middle of foreach loop" From: Chip Salzenberg Files: pod/perldiag.pod pp_ctl.c Title: "[PATCH] m2t2: problem in NetBSD 1.2D with sfio" From: Jarkko Hietaniemi Files: perl.h Title: "Forbid negative splice offset beyond array start" From: "John L. Allen" , Chip Salzenberg Msg-ID: Files: pp.c Title: "Fix memory leak on eval 'sub {}'" From: Chip Salzenberg Files: pp_ctl.c Title: "Fix C" From: Chip Salzenberg Files: toke.c Title: "Don't warn about "${foo}" in string, even if &foo exists" From: Chip Salzenberg Files: toke.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "Fix C parsing" From: "Chuck D. Phillips (NON-HP Employee)" , Chip Salzenberg Msg-ID: <199706121737.KAA00503@palrel3.hp.com> Files: toke.c Title: "Fix lockf_emulate_flock() positioning" From: Chip Salzenberg , gen@atd.rdc.ricoh.co.jp Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> Files: pp_sys.c Title: "[PATCH] Make DEBUGGING_MSTATS info consistent" From: Andy Dougherty Msg-ID: Files: INSTALL pod/perldelta.pod perl.h Title: "semctl broken under Linux" From: Andreas Schwab , Andreas Schwab , Graham Barr , Tim Bunce Msg-ID: <33C38291.2D9302DA@ti.com>, <9707040912.AA03470@issan.informatik.uni-dortmund.de>, <9707041538.AA08946@toad.ig.co.uk>, <9707070924.AA11774@issan.informatik.uni-dortmund.de>, <9707090933.AA19012@issan.informatik.uni-dortmund.de> Files: doio.c [one change made it, as 8e591e46b4c6543ed80895327199c4a628ce11b6] Title: "One-liner regex causes SEGV on 5.003 under HP-UX and Linux" From: Hugo van der Sanden Msg-ID: <199707061144.MAA04443@crypt.compulink.co.uk> Files: regexec.c t/op/re_tests [was originally credited as the same change as 44ed422101809141bc33c2b85c1cff357de4d7bf] Title: "Fix up problems with *DBM tests" From: Paul Marquess Files: t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer safety code" From: Chip Salzenberg , Hugo van der Sanden , Tim Bunce Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, <199707142050.QAA20976@rio.atlantic.net>, <199707182035.VAA20990@crypt.compulink.co.uk>, <9707151040.AA02883@toad.ig.co.uk> Files: global.sym sv.c Title: "Fix '-' flag on sprintf() of floats" From: Chip Salzenberg , Jarkko Hietaniemi Msg-ID: <199705270646.JAA02510@alpha.hut.fi> Files: sv.c Title: "Don't use atol() for unsigned values", "signedness problem in pack("N", "value");" From: Chip Salzenberg , Roger Espel Llima Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> Files: sv.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "[PATCH] Exporter new export_to_level method" From: epeschko@elmer.tci.com (Ed Peschko) Files: lib/Exporter.pm Title: "[MM] Small patch to MakeMaker, new release" From: "Andreas J. Koenig" Msg-ID: <199706281603.SAA10869@anna.in-berlin.de> Files: lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "CPAN.pm, $VERSION and nested (bundled) modules." From: a.koenig@kulturbox.de (Andreas J. Koenig) Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Time::Local patch (plus perl.c and filehand.t)" From: ilya@math.ohio-state.edu (Ilya Zakharevich) Files: lib/Time/Local.pm perl.c t/lib/filehand.t Title: "Slightly safer signals" From: Ilya Zakharevich Files: mg.c perl.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "'use UNIVERSAL;' deprecated, do C instead", "UNIVERSAL.pm and import methods" From: "M.J.T. Guy" , Gisle Aas , Graham Barr , Gurusamy Sarathy , Hugo van der Sanden Msg-ID: <199706271701.NAA25664@aatma.engin.umich.edu>, <199706271904.UAA00120@crypt.compulink.co.uk>, <199706272054.QAA28913@aatma.engin.umich.edu>, <199706301554.LAA03763@aatma.engin.umich.edu>, <33B22248.7D7C1985@ti.com>, , , , , , Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm t/op/universal.t universal.c [two changes made it, as d704f39a0db2dc23790dfd9d7bd59ce9928a6e2c, e09f3e01ccd721309f0eb0aae224d84db2e8436a] ------ PORTABILITY - WIN32 ------ Title: "[PATCH] Embedding threaded apps in perl.dll" From: Gurusamy Sarathy Msg-ID: <199707261518.LAA24346@aatma.engin.umich.edu>, <199707301833.OAA19570@aatma.engin.umich.edu> Files: win32/win32.c [one change made it, as 4dd614da4d1132b957c4951dd00f64d81b89dc20] Title: "minor win32 scribbles" From: Hugo van der Sanden Msg-ID: <199707270832.JAA19399@crypt.compulink.co.uk> Files: README.win32 [nitpicking f7c603cbfba7c97f77e257c42aa119ffdb47fe1e] Title: "[PATCH] binary coexistence on win32", "[RESEND] [PATCH] binary coexistence on win32" From: Gurusamy Sarathy Msg-ID: <199707250109.VAA02666@aatma.engin.umich.edu>, <199707301829.OAA19516@aatma.engin.umich.edu> Files: lib/ExtUtils/Mksymlists.pm win32/win32.h win32/win32io.h win32/win32iop.h win32/makedef.pl win32/win32.c win32/win32io.c Title: "WIN32 Build - pod2xxx.bat Missing?", "[PATCH] Re: WIN32 Build - pod2xxx.bat Missing?" From: Chris Williams , Gurusamy Sarathy Msg-ID: <199707011423.KAA15855@aatma.engin.umich.edu>, <33B8B962.D96FA1F5@netinfo.com.au> Files: win32/Makefile win32/makefile.mk Title: "[PATCH] docs for win32 utilities" From: Gurusamy Sarathy Msg-ID: <199707250045.UAA02510@aatma.engin.umich.edu> Files: win32/bin/pl2bat.bat win32/bin/runperl.bat Title: "[PATCH] trial2: some batch files won't run" From: Gurusamy Sarathy Msg-ID: <199708040226.WAA17301@aatma.engin.umich.edu> Files: win32/bin/pl2bat.bat win32/bin/runperl.bat Title: "[PATCH] win32 extras and embedding" From: Gurusamy Sarathy Msg-ID: <199707250232.WAA03421@aatma.engin.umich.edu>, <199707301831.OAA19528@aatma.engin.umich.edu> Files: dosish.h win32/win32.h perl.c win32/config.bc win32/config_H.bc win32/makedef.pl win32/perllib.c win32/win32.c [one change was applied (hastily), as ad2e33dc060dc2ccf73a5ff1557a69a9b09c30c8] ------ PORTABILITY - OTHER ------ Title: "Additional OS/2 patches" From: Gurusamy Sarathy , Ilya Zakharevich Msg-ID: <199708020823.EAA19521@monk.mps.ohio-state.edu>, <199708021424.KAA28561@aatma.engin.umich.edu>, <199708042108.RAA27671@aatma.engin.umich.edu> Files: README.os2 os2/Changes perl.c [one change was applied, as d8c2d278168b862ff4120ad8e5887d37d31f858b] Title: "make depend loop fix and minor OS/2 improvements to build process" From: ilya@math.ohio-state.edu (Ilya Zakharevich) Files: Makefile.SH hints/os2.sh os2/Makefile.SHs Title: "Minor VMS patches" From: Charles Bailey Msg-ID: <01ILCUO6XXTE000WFK@hmivax.humgen.upenn.edu> Files: lib/ExtUtils/MM_VMS.pm vms/vmsish.h vms/descrip.mms vms/test.com vms/vms.c vms/ext/filespec.t Title: "[PATCH] Two un-disabled tests for VMS" From: Dan Sugalski Msg-ID: <3.0.2.32.19970718095842.00879220@stargate.lbcc.cc.or.us> Files: vms/test.com Title: "fix substr fix (tests 27 etc)", "perl5.004_02 trial 1 available (with substr bug and still some" From: "M.J.T. Guy" , Hugo van der Sanden , Jarkko Hietaniemi Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>, <199707302228.BAA18032@alpha.hut.fi>, <199707310929.KAA06515@crypt.compulink.co.uk>, Files: pp.c Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't intersect original at all" From: "M.J.T. Guy" , Jarkko Hietaniemi Msg-ID: <199707100655.JAA14924@alpha.hut.fi>, Files: pod/perlfunc.pod pp.c t/op/substr.t [one change was applied, as d9fdd1afe4b88705294e21dc4e070c42d3d9a4d8] Title: "[PATCH] Changes for VMS 7.1 support" From: Charles Bailey , Dan Sugalski Msg-ID: <01ILDXUH0J1W00026U@hmivax.humgen.upenn.edu>, <3.0.2.32.19970718095935.0087a2d0@stargate.lbcc.cc.or.us> Files: vms/sockadapt.h vms/config.vms vms/sockadapt.c ------ DOCUMENTATION ------ Title: "Document bug fix in localization of $1 etc." From: Chip Salzenberg Files: pod/perldelta.pod Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag" From: "M.J.T. Guy" Msg-ID: , Files: pod/perldiag.pod [one change was applied, as 702d120df290e0de1b21f167f7d0110b35ee2fef] Title: "OK: perl on (corrected)", "enhancements to perlbug -ok" From: "M.J.T. Guy" , Stephen McCamant Msg-ID: , , Files: utils/Makefile utils/perlbug.PL Title: "perldoc doesn't grok Win32 UNC paths" From: Warren Jones Msg-ID: <97Jun17.184420pdt.35728-1@gateway.fluke.com>, <97Jun18.165618pdt.35713-1@gateway.fluke.com> Files: utils/perldoc.PL [one change was applied, as f72119fc50f0d88b02501ba41112f82ab99f0c3b] --- diff --git a/Changes b/Changes index 9c2f048..b30c33e 100644 --- a/Changes +++ b/Changes @@ -48,6 +48,859 @@ And the Keepers of the Patch Pumpkin: ---------------- +Version 5.004_02 Maintenance release 2 for 5.004 +---------------- + +"When you work you are a flute through whose + heart the whispering of the hours turns to music." + -- from The Prophet by Kahlil Gibran + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + Major memory growth bug fixed. + Object destruction is more timely and orderly. + Further major enhancements to Win32 support, including: + Win32 binary compatibility between Visual C++ and Borland C++. + The -S option is now more useful on dos/Win32 (see perlrun). + Implicit -p print now checks for write errors. + DB_File now sub-classable (and other fixes). + Memory usage stats available with perl's malloc (see perldelta). + 'use UNIVERSAL;' deprecated (see perldelta). + Internal integer to string conversions are faster. + Carp can be forced to give stack traces (see perldoc Carp). + Many other bug fixes and enhancements. + + + ------ BUILD PROCESS ------ + + Title: "[PATCH] m2t3: Configure: cf_time always in C locale" + From: Jarkko Hietaniemi + Msg-ID: <199708061827.VAA09623@alpha.hut.fi> + Files: Configure + + Title: "Configure can't find open3 on NeXTstep" + From: Andy Dougherty , hans@icgned.nl + (Hans Mulder) + Msg-ID: <9706271816.AA10551@ icgned.icgned.nl > + Files: Configure + + Title: "Don't use undef value in Config::myconfig" + From: "Andreas J. Koenig" , Chip Salzenberg + + Msg-ID: <199706271525.RAA13517@sissy.in-berlin.de> + Files: configpm + + Title: "make Configure recognize powerux hint (perl5.004_01)" + From: tom@amber.ssd.hcsc.com (Tom Horsley) + Msg-ID: <9707301938.AA08352@amber.ssd.hcsc.com> + Files: Configure + + Title: "[PATCH]: HP-UX 10 w/o transition links" + From: Jeff Okamoto + Msg-ID: <199706181851.AA093329906@hpcc123.corp.hp.com>, + <199706231650.AA070364627@hpcc123.corp.hp.com> + Files: Configure + + Title: "INSTALL updates for GNU ld and __inet_* errors" + From: Andy Dougherty + Files: INSTALL + + ------ CORE LANGUAGE ------ + + Title: "[PATCH] Additional patch for "Can't execute ..."" + From: Ilya Zakharevich + Msg-ID: <199707191651.MAA04897@monk.mps.ohio-state.edu> + Files: pod/perldiag.pod perl.c + + Title: "[PATCH] Band-aid fix for local([@%]$x)" + From: Stephen McCamant + Msg-ID: + Files: pod/perldiag.pod op.c pp_hot.c t/op/local.t + + Title: "[PATCH] Re: Bug in Regular Expressions when using colon as + delimiter" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perldiag.pod regcomp.c t/op/re_tests t/op/regexp.t + + Title: "[PATCH] Re: Can't pack literals as pointers" + From: Gurusamy Sarathy + Msg-ID: <199708012250.SAA20278@aatma.engin.umich.edu> + Files: pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t + + Title: "[PATCH] Do not constant-fold ops that depend on locale if C" + From: Chip Salzenberg + Msg-ID: <199707210519.BAA13785@nielsenmedia.com> + Files: op.c + + Title: "Eval fails in certain situations (eval "{'...")" + From: Gurusamy Sarathy + Msg-ID: <199707211753.NAA14940@aatma.engin.umich.edu> + Files: t/comp/term.t toke.c + + Title: "Fix memory leak on eval 'sub {}'" + From: Chip Salzenberg + Files: pp_ctl.c + + Title: "stringify looses integerness" + From: Gisle Aas + Msg-ID: + Files: sv.c + + Title: "Fix intolerance of a space between "print" and opening paren" + From: Gurusamy Sarathy + Msg-ID: <199707011421.KAA15836@aatma.engin.umich.edu> + Files: toke.c + + Title: "[PATCH] Re: Calling Perl from within C from within Perl" + From: Gurusamy Sarathy + Msg-ID: <199706301842.OAA05569@aatma.engin.umich.edu> + Files: perl.c + + Title: "UNIVERSAL.pm and import methods (tests)" + From: "M.J.T. Guy" + Msg-ID: + Files: t/op/universal.t universal.c + + Title: "Avoid core dump on some paren'd regexp matches", "One-liner regex + causes SEGV on 5.003 under HP-UX and Linux" + From: Hugo van der Sanden + Msg-ID: <199706261236.NAA03472@crypt.compulink.co.uk>, + <199707061144.MAA04443@crypt.compulink.co.uk> + Files: regexec.c t/op/re_tests + + Title: "Forbid negative splice offset beyond array start" + From: "John L. Allen" , Chip Salzenberg + + Msg-ID: + Files: pp.c + + Title: "Forbid "goto" into middle of foreach loop" + From: Chip Salzenberg + Files: pod/perldiag.pod pp_ctl.c + + Title: "Fix C" + From: Chip Salzenberg + Files: toke.c + + Title: "bless file handles as FileHandle if loaded else IO::Handle" + From: Gisle Aas + Msg-ID: + Files: gv.c lib/FileHandle.pm + + Title: "infinite recursion in malloc() with some compile flags" + From: Hans Mulder + Msg-ID: <199706240050.CAA10550@xs2.xs4all.nl> + Files: malloc.c + + Title: "sv_vcatpvfn hogs memory [Patch included]" + From: Matthias Neeracher + Msg-ID: <199706211521.RAA12778@solar.ethz.ch> + Files: sv.c + + Title: "Fix '-' flag on sprintf() of floats" + From: Chip Salzenberg , Jarkko Hietaniemi + + Msg-ID: <199705270646.JAA02510@alpha.hut.fi> + Files: sv.c + + Title: "Free temps before calling END blocks", "Too late destruction" + From: Chip Salzenberg + Msg-ID: + Files: perl.c + + Title: "Fix C parsing" + From: "Chuck D. Phillips (NON-HP Employee)" , Chip + Salzenberg + Msg-ID: <199706121737.KAA00503@palrel3.hp.com> + Files: toke.c + + Title: "Fix lockf_emulate_flock() positioning" + From: Chip Salzenberg , gen@atd.rdc.ricoh.co.jp + Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> + Files: pp_sys.c + + Title: "Don't use atol() for unsigned values", "signedness problem in + pack("N", "value");" + From: Chip Salzenberg , Roger Espel Llima + + Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> + Files: sv.c + + Title: "Don't warn about "${foo}" in string, even if &foo exists" + From: Chip Salzenberg + Files: toke.c + + Title: "[PATCH] -p does not check for failure of implicit print" + From: Dominic Dunlop + Msg-ID: + Files: pod/perldiag.pod pod/perlrun.pod toke.c + + Title: "Fix double form() in XS version check" + From: Ilya Zakharevich + Msg-ID: <199707150010.UAA00816@monk.mps.ohio-state.edu> + Files: XSUB.h + + Title: "Constant-fold sprintf()" + From: Chip Salzenberg + Files: opcode.pl + + Title: "[PATCH] Fix double form() in XS version check" + From: Chip Salzenberg + Msg-ID: <199707210518.BAA13771@nielsenmedia.com> + Files: XSUB.h + + Title: "[PATCH] Make DEBUGGING_MSTATS info consistent" + From: Andy Dougherty + Msg-ID: + Files: INSTALL pod/perldelta.pod perl.h + + Title: "Minor Win32 glitch with -S flag" + From: Warren Jones + Msg-ID: <97Jun19.150511pdt.35717-2@gateway.fluke.com> + Files: perl.c + + Title: "Slightly safer signals" + From: Ilya Zakharevich + Files: mg.c perl.c + + Title: "Time::Local patch (plus perl.c and filehand.t)" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Files: lib/Time/Local.pm perl.c t/lib/filehand.t + + Title: "[PATCH] Weirdness in sv_peek()" + From: Stephen McCamant + Msg-ID: , + + Files: sv.c + + Title: "Win32 UNC path causes autoload to fail" + From: Warren Jones + Msg-ID: <97Jun18.163826pdt.35714-1@gateway.fluke.com> + Files: pp_ctl.c + + Title: "[PATCH]: reduced malloc patch" + From: Ilya Zakharevich + Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu> + Files: av.c + + Title: "[PATCH] $\1 and serious bug in evalling" + From: Ilya Zakharevich + Msg-ID: <199707262127.RAA12883@monk.mps.ohio-state.edu> + Files: pp_ctl.c + + Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer + safety code" + From: Chip Salzenberg , Hugo van der Sanden + , Tim Bunce + Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, + <199707142050.QAA20976@rio.atlantic.net>, + <199707182035.VAA20990@crypt.compulink.co.uk>, + <9707151040.AA02883@toad.ig.co.uk> + Files: global.sym sv.c + + Title: "object never destructs" + From: Gurusamy Sarathy + Msg-ID: <199707131955.PAA29655@aatma.engin.umich.edu> + Files: scope.c t/op/ref.t + + Title: "[PATCH] -S flag fixes for DOSISH platforms", "[RESEND] [PATCH] -S + flag fixes for DOSISH platforms" + From: Gurusamy Sarathy + Msg-ID: <199707250043.UAA02385@aatma.engin.umich.edu>, + <199707301828.OAA19508@aatma.engin.umich.edu> + Files: pod/perldiag.pod pod/perlrun.pod perl.c + + Title: "Perldb internal flag rehaul" + From: Ilya Zakharevich + Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c + pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c + + Title: "[PATCH] Re: q and escaping paired delimiters" + From: Gurusamy Sarathy , Kenneth Albanowski + + Msg-ID: <199707280516.BAA14055@aatma.engin.umich.edu>, + , + + Files: t/base/lex.t toke.c + + Title: "Enable PERL_DEBUG_MSTATS without -DDEBUGGING_MSTATS" + From: Ilya Zakharevich + Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu> + Files: malloc.c perl.c + + Title: "semctl broken under Linux" + From: Andreas Schwab , Andreas + Schwab , Graham + Barr , Tim Bunce + Msg-ID: <33C38291.2D9302DA@ti.com>, + <9707040912.AA03470@issan.informatik.uni-dortmund.de>, + <9707041538.AA08946@toad.ig.co.uk>, + <9707070924.AA11774@issan.informatik.uni-dortmund.de>, + <9707090933.AA19012@issan.informatik.uni-dortmund.de> + Files: doio.c + + Title: "[PATCH] m2t2: problem in NetBSD 1.2D with sfio" + From: Jarkko Hietaniemi + Files: perl.h + + Title: "fix substr fix (tests 27 etc)", "perl5.004_02 trial 1 available + (with substr bug and still some" + From: "M.J.T. Guy" , Hugo van der Sanden + , Jarkko Hietaniemi + Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>, + <199707302228.BAA18032@alpha.hut.fi>, + <199707310929.KAA06515@crypt.compulink.co.uk>, + + Files: pp.c + + Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't + intersect original at all" + From: "M.J.T. Guy" , Jarkko Hietaniemi + Msg-ID: <199707100655.JAA14924@alpha.hut.fi>, + + Files: pod/perlfunc.pod pp.c t/op/substr.t + + Title: "[PATCH] work around compiler bug on CX/UX (perl5.004_01)" + From: tom@amber.ssd.hcsc.com (Tom Horsley) + Msg-ID: <9707301934.AA18594@amber.ssd.hcsc.com> + Files: hints/cxux.sh pp.c + + ------ DOCUMENTATION ------ + + Title: "Duplicates in perlguts.pod" + From: hans@icgned.nl (Hans Mulder) + Msg-ID: <9707082346.AA13231@ icgned.icgned.nl > + Files: pod/perlguts.pod + + Title: "Better "Can't locate auto/%s.al in @INC" error documentation" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Jun24.195847.2091744@hmivax.humgen.upenn.edu> + Files: pod/perldiag.pod + + Title: "new perlembed.pod:match.c" + From: Doug MacEachern + Msg-ID: <199707170355.XAA21370@postman.opengroup.org> + Files: pod/perlembed.pod + + Title: "Document bug fix in localization of $1 etc." + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "[PATCH] Major goof in XS Tutorial regarding subdirs" + From: Ilya Zakharevich + Msg-ID: <199707260920.FAA12453@monk.mps.ohio-state.edu> + Files: pod/perlxstut.pod + + Title: "[PATCH] Magic info in perlguts, take 2" + From: Stephen McCamant + Msg-ID: + Files: pod/perlguts.pod + + Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag" + From: "M.J.T. Guy" + Msg-ID: , + + Files: pod/perldiag.pod + + Title: "[PATCH] Updates to perlguts (repost)" + From: Ilya Zakharevich + Msg-ID: <199707152223.SAA00776@monk.mps.ohio-state.edu> + Files: pod/perlguts.pod + + Title: "[BUG:47:LOG] Dropped "and" in pod2man" + From: hans@icgned.nl (Hans Mulder) + Msg-ID: <9707082355.AA13254@ icgned.icgned.nl > + Files: pod/pod2man.PL + + Title: "[BUG] perlembed.pod:power.c example" + From: Doug MacEachern + Msg-ID: <199707181344.JAA10565@postman.opengroup.org> + Files: pod/perlembed.pod + + Title: "[PATCH] arguments swapped in perlapio.pod" + From: Hans Mulder + Msg-ID: <199706240049.CAA10534@xs2.xs4all.nl> + Files: pod/perlapio.pod + + Title: "[PATCH] cool quote for perldebug" + From: Greg Bacon + Msg-ID: <199707292140.QAA28579@adtrn-srv4.adtran.com> + Files: pod/perldebug.pod + + Title: "[PATCH] multiline commands in qx//" + From: Gurusamy Sarathy + Msg-ID: <199707212350.TAA18496@aatma.engin.umich.edu> + Files: pod/perlfunc.pod pod/perlop.pod + + Title: "patch to 5.004_01 perltrap.pod" + From: jmm@revenge.elegant.com (John Macdonald) + Msg-ID: <9706231525.AA22790@revenge.elegant.com> + Files: pod/perltrap.pod + + Title: "perl4 to perl5.004 converion with debugger problem" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perltrap.pod + + Title: "done3/perlbook.pod" + From: Randal Schwartz + Files: pod/perlbook.pod + + Title: "[PATCH] readline and readpipe are undocumented" + From: Hans Mulder + Files: pod/perlfunc.pod + + Title: "Document use of - in a regex char class." + From: Dominic Dunlop + Msg-ID: + Files: pod/perlre.pod + + Title: "[PATCH] splitpod broken in 5.004_01" + From: Hans Mulder , Tim Bunce + Msg-ID: <199706240048.CAA10515@xs2.xs4all.nl>, + <9706241612.AA09119@toad.ig.co.uk> + Files: pod/splitpod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "Carp::cluck() and -MCarp=verbose" + From: Tim.Bunce@ig.co.uk, epeschko@elmer.tci.com (Ed Peschko) + Msg-ID: <199708060607.AAA16681@den-mdev1.tci.com>, + <199708062105.PAA09878@den-mdev1.tci.com> + Files: lib/Carp.pm + + Title: "Warning from calls using "use Shell"" + From: Andrew Pimlott + Msg-ID: + Files: lib/Shell.pm + + Title: "confessing a carp" + From: Chip Salzenberg , Hugo van der Sanden + , Nick Ing-Simmons + , Tim Bunce + Msg-ID: <199708052155.WAA25393@crypt.compulink.co.uk>, + <199708060721.IAA30894@crypt.compulink.co.uk>, + <199708061533.LAA01313@rio.atlantic.net>, + <33E79BE2.4E6F@ni-s.u-net.com>, + <33E8E3C5.62C@ni-s.u-net.com>, + <9708051619.AA13764@toad.ig.co.uk> + Files: lib/Carp.pm + + Title: "[BUG:PATCH] dumpvar.pl parses some references incorrectly" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/dumpvar.pl + + Title: "[PATCH] m2t3: minor doc patch (to obsolete I18N::Collate)" + From: Jarkko Hietaniemi + Msg-ID: <199708060732.KAA02675@alpha.hut.fi> + Files: lib/I18N/Collate.pm + + Title: "[PATCH] Binary installers for Perl modules" + From: Ilya Zakharevich + Msg-ID: <199707210006.UAA06165@monk.mps.ohio-state.edu> + Files: lib/ExtUtils/Install.pm + + Title: "m2t2 broke CPAN.pm :-(" + From: a.koenig@kulturbox.de (Andreas J. Koenig) + Files: lib/CPAN.pm lib/Bundle/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm + + Title: "[PATCH] CPAN.pm on OS/2" + From: "Andreas J. Koenig" , Ilya Zakharevich + + Msg-ID: <199707180415.AAA03180@monk.mps.ohio-state.edu>, + <199707181407.QAA12920@anna.in-berlin.de> + Files: lib/CPAN.pm + + Title: "Docs of IO::Handle [PATCH]" + From: Ilya Zakharevich + Msg-ID: <199707222307.TAA08380@monk.mps.ohio-state.edu> + Files: ext/IO/lib/IO/Handle.pm + + Title: "Exporter errors give wrong location" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Exporter.pm + + Title: "[PATCH] Exporter new export_to_level method" + From: epeschko@elmer.tci.com (Ed Peschko) + Files: lib/Exporter.pm + + Title: "DB_File produces spurious output when trapping __DIE__" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9706302125.AA28254@claudius.bfsec.bt.co.uk> + Files: ext/DB_File/DB_File.pm + + Title: "Remove 'use UNIVERSAL;', switch to UNIVERSAL::isa()" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm + + Title: "perl5.004 Time::Local still broken" + From: Mathias Koerber + Msg-ID: <199706260452.MAA22647@dnssec1.singnet.com.sg> + Files: lib/Time/Local.pm + + Title: "Sys::Hostname should localize $SIG{__DIE__}" + From: Ken Shan + Msg-ID: <199707070357.XAA18065@digitas.harvard.edu> + Files: lib/Sys/Hostname.pm + + Title: "xsubpp patch" + From: John Tobey + Msg-ID: <199707010221.CAA01234@remote133> + Files: lib/ExtUtils/xsubpp + + Title: "DB_File 1.15 patch" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9707192117.AA01973@claudius.bfsec.bt.co.uk> + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DB_File/typemap + t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t + + Title: "Problems with setvbuf" + From: Ilya Zakharevich + Msg-ID: <199707250040.UAA11000@monk.mps.ohio-state.edu> + Files: ext/IO/IO.xs + + Title: "[PATCH] Repost of fork() debugger patch" + From: Ilya Zakharevich + Msg-ID: <199707252101.RAA11846@monk.mps.ohio-state.edu> + Files: lib/perl5db.pl lib/Term/ReadLine.pm + + Title: "IO::File and DB_File pollutes namespace with Fcntl constants" + From: Gisle Aas + Msg-ID: + Files: ext/IO/lib/IO/File.pm + + Title: "[MM] [PATCH] Re: Liblist problems for MSWin32" + From: Gurusamy Sarathy + Msg-ID: <199706182152.RAA20273@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + Title: "Net::hostent documentation error" + From: gnat@frii.com + Msg-ID: <199707082222.QAA24728@elara.frii.com> + Files: lib/Net/hostent.pm + + Title: "PATCH: make DBM*_File modules sub-classable" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9707121854.AA19472@claudius.bfsec.bt.co.uk> + Files: ext/GDBM_File/typemap ext/NDBM_File/typemap + ext/ODBM_File/ODBM_File.xs ext/SDBM_File/typemap + t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t + + Title: "Sys::Syslog patch to allow unix domain sockets" + From: Sean Robinson + Msg-ID: <33B31342.7EB16A44@sc.maricopa.edu> + Files: lib/Sys/Syslog.pm + + Title: "'use UNIVERSAL;' deprecated, do C instead", + "UNIVERSAL.pm and import methods" + From: "M.J.T. Guy" , Gisle Aas , + Graham Barr , Gurusamy Sarathy + , Hugo van der Sanden + + Msg-ID: <199706271701.NAA25664@aatma.engin.umich.edu>, + <199706271904.UAA00120@crypt.compulink.co.uk>, + <199706272054.QAA28913@aatma.engin.umich.edu>, + <199706301554.LAA03763@aatma.engin.umich.edu>, + <33B22248.7D7C1985@ti.com>, + , + , + , + , + , + + Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm + t/op/universal.t universal.c + + Title: "[MM] Small patch to MakeMaker, new release" + From: "Andreas J. Koenig" + Msg-ID: <199706281603.SAA10869@anna.in-berlin.de> + Files: lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm + lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + + Title: "ExtUtils-Embed upgrade" + From: Doug MacEachern + Files: lib/ExtUtils/Embed.pm + + Title: "[PATCH] icmp tweak for IO::Socket" + From: Nick.Ing-Simmons@tiuk.ti.com + Msg-ID: <199707041240.NAA21484@pluto.tiuk.ti.com> + Files: ext/IO/lib/IO/Socket.pm + + Title: "Allow concurrent mkdir in File::Path::mkpath" + From: schattev@imb-jena.de (Ruben Schattevoy) + Msg-ID: <199707300943.LAA21574@kant.imb-jena.de> + Files: lib/File/Path.pm + + Title: "CPAN.pm, $VERSION and nested (bundled) modules." + From: a.koenig@kulturbox.de (Andreas J. Koenig) + Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm + lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Mksymlists.pm + + Title: "[PATCH] perl debugger, win32, and emacs" + From: Jay Rogers + Msg-ID: <199707311759.NAA13276@crooked-i.mitre.org> + Files: lib/perl5db.pl + + Title: "[PATCH] pod2html mangles C<&foo(42);>" + From: Hans Mulder + Msg-ID: <199706250057.CAA10162@xs1.xs4all.nl> + Files: lib/Pod/Html.pm + + Title: "[PATCH] posix.xs broken on VMS 7.1" + From: Dan Sugalski + Msg-ID: <3.0.2.32.19970718095755.00875ba0@stargate.lbcc.cc.or.us> + Files: ext/POSIX/POSIX.xs + + Title: "MM_Unix.pm nits for Win32 DMAKE" + From: Gurusamy Sarathy + Msg-ID: <199708032051.QAA14248@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Sys::Hostname -w unclean in trial 2" + From: Gurusamy Sarathy + Msg-ID: <199708032055.QAA14278@aatma.engin.umich.edu> + Files: lib/Sys/Hostname.pm + + Title: "(3) File::Find::find()/finddepth() bugs with toplevel paths" + From: "Conrad E. Kimball" + Msg-ID: <199707040045.RAA24459@mailgate2.boeing.com> + Files: lib/File/Find.pm + + ------ OTHER CHANGES ------ + + Title: "EMERGENCY_SBRK or PERL_EMERGENCY_SBRK ?" + From: Andy Dougherty , + ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Aug1.191631.2167470@hmivax.humgen.upenn.edu>, + + Files: + Files: + + ------ PORTABILITY - WIN32 ------ + + Title: "[PATCH] Embedding threaded apps in perl.dll" + From: Gurusamy Sarathy + Msg-ID: <199707261518.LAA24346@aatma.engin.umich.edu>, + <199707301833.OAA19570@aatma.engin.umich.edu> + Files: win32/win32.c + + Title: "Minor fix for pl2bat.bat", "[PATCH] Re: Minor fix for pl2bat.bat" + From: Gurusamy Sarathy , Warren Jones + + Msg-ID: <199707061843.OAA23874@aatma.engin.umich.edu>, + <97Jun24.115804pdt.35752-2@gateway.fluke.com> + Files: win32/bin/pl2bat.bat + + Title: "WIN32 Build - pod2xxx.bat Missing?", "[PATCH] Re: WIN32 Build - + pod2xxx.bat Missing?" + From: Chris Williams , Gurusamy Sarathy + + Msg-ID: <199707011423.KAA15855@aatma.engin.umich.edu>, + <33B8B962.D96FA1F5@netinfo.com.au> + Files: win32/Makefile win32/makefile.mk + + Title: "[PATCH] Win32 sitelib intuition from DLL location" + From: Gurusamy Sarathy + Msg-ID: <199706231647.MAA23260@aatma.engin.umich.edu> + Files: win32/win32.h win32/config_h.PL win32/win32.c + + Title: "[PATCH] binary coexistence on win32", "[RESEND] [PATCH] binary + coexistence on win32" + From: Gurusamy Sarathy + Msg-ID: <199707250109.VAA02666@aatma.engin.umich.edu>, + <199707301829.OAA19516@aatma.engin.umich.edu> + Files: lib/ExtUtils/Mksymlists.pm win32/win32.h win32/win32io.h + win32/win32iop.h win32/makedef.pl win32/win32.c + win32/win32io.c + + Title: "[PATCH] docs for win32 utilities" + From: Gurusamy Sarathy + Msg-ID: <199707250045.UAA02510@aatma.engin.umich.edu> + Files: win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] exec() fixed on win32" + From: Gurusamy Sarathy + Msg-ID: <199706241525.LAA06554@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32io.h win32/win32iop.h README.win32 doio.c + win32/config_H.bc win32/config_H.vc win32/makedef.pl + win32/win32.c win32/win32io.c + + Title: "[PATCH] getenv() after my_setenv() gets old entry on Win32" + From: Gurusamy Sarathy + Msg-ID: <199706231700.NAA23400@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32.c + + Title: "[PATCH] getservby*() calls fail on Windows NT" + From: Gurusamy Sarathy + Msg-ID: <199706231654.MAA23276@aatma.engin.umich.edu> + Files: win32/win32sck.c + + Title: "[PATCH] minor win32 scribbles" + From: Gurusamy Sarathy , Hugo van der Sanden + + Msg-ID: <199707262307.TAA28410@aatma.engin.umich.edu>, + <199707270832.JAA19399@crypt.compulink.co.uk> + Files: pod/perldelta.pod README.win32 win32/Makefile win32/config.bc + win32/config.vc win32/makefile.mk + + Title: "[PATCH] trial2: some batch files won't run" + From: Gurusamy Sarathy + Msg-ID: <199708040226.WAA17301@aatma.engin.umich.edu> + Files: win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] win32 docs and runperl.bat" + From: Gurusamy Sarathy + Msg-ID: <199707070446.AAA29560@aatma.engin.umich.edu> + Files: MANIFEST README.win32 win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] win32 extras and embedding" + From: Gurusamy Sarathy + Msg-ID: <199707250232.WAA03421@aatma.engin.umich.edu>, + <199707301831.OAA19528@aatma.engin.umich.edu> + Files: dosish.h win32/win32.h perl.c win32/config.bc win32/config_H.bc + win32/makedef.pl win32/perllib.c win32/win32.c + + Title: "[PATCH] win32 tweaks" + From: Gurusamy Sarathy + Msg-ID: <199707042150.RAA01065@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32.c + + Title: "[PATCH] win32_stat() fixes (2nd try)" + From: Gurusamy Sarathy + Msg-ID: <199708040137.VAA16810@aatma.engin.umich.edu> + Files: t/op/stat.t win32/win32iop.h win32/win32.c + + ------ PORTABILITY - OTHER ------ + + Title: "Additional OS/2 patches" + From: Gurusamy Sarathy , Ilya Zakharevich + + Msg-ID: <199708020823.EAA19521@monk.mps.ohio-state.edu>, + <199708021424.KAA28561@aatma.engin.umich.edu>, + <199708042108.RAA27671@aatma.engin.umich.edu> + Files: README.os2 os2/Changes perl.c + + Title: "Additional patch is needed for os2/diff.configure" + From: Ilya Zakharevich + Msg-ID: <199708020745.DAA19483@monk.mps.ohio-state.edu> + Files: os2/diff.configure + + Title: "Assorted OS/2 fixes" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Jun16.163234.2091727@hmivax.humgen.upenn.edu> + Files: hints/os2.sh os2/diff.configure os2/os2ish.h README.os2 os2/Changes + os2/Makefile.SHs os2/os2.c util.c + + Title: "[PATCH] Changes for VMS 7.1 support" + From: Charles Bailey , Dan Sugalski + + Msg-ID: <01ILDXUH0J1W00026U@hmivax.humgen.upenn.edu>, + <3.0.2.32.19970718095935.0087a2d0@stargate.lbcc.cc.or.us> + Files: vms/sockadapt.h vms/config.vms vms/sockadapt.c + + Title: "[PATCH] Easier TCP stack selection for VMS" + From: Dan Sugalski + Msg-ID: <3.0.1.32.19970624151939.00994490@stargate.lbcc.cc.or.us> + Files: vms/descrip.mms + + Title: "Minor VMS patches" + From: Charles Bailey + Msg-ID: <01ILCUO6XXTE000WFK@hmivax.humgen.upenn.edu> + Files: lib/ExtUtils/MM_VMS.pm vms/vmsish.h vms/descrip.mms vms/test.com + vms/vms.c vms/ext/filespec.t + + Title: "[PATCH] Two un-disabled tests for VMS" + From: Dan Sugalski + Msg-ID: <3.0.2.32.19970718095842.00879220@stargate.lbcc.cc.or.us> + Files: vms/test.com + + Title: "fixes for hints/svr4 for UnixWare >= 2.1.1" + From: John Hughes + Msg-ID: <199707021230.OAA24230@titanic.AtlanTech.COM> + Files: hints/svr4.sh + + Title: "make depend loop fix and minor OS/2 improvements to build process" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Files: Makefile.SH hints/os2.sh os2/Makefile.SHs + + ------ TESTS ------ + + Title: "Add xor tests to test suite" + From: Hugo van der Sanden + Msg-ID: <199706250730.IAA06097@crypt.compulink.co.uk> + Files: t/comp/cmdopt.t + + Title: "[PATCH] enable some tests on Win32" + From: Gurusamy Sarathy + Msg-ID: <199707250029.UAA02351@aatma.engin.umich.edu> + Files: t/op/magic.t + + Title: "Fix up problems with *DBM tests" + From: Paul Marquess + Files: t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t + + ------ UTILITIES ------ + + Title: "[PATCH] m2t3: utils/perlbug.PL: -ok report is not a bug" + From: Jarkko Hietaniemi + Msg-ID: <199708071022.NAA13008@alpha.hut.fi> + Files: utils/perlbug.PL + + Title: "perlbug - check sendmail and fix win32 tmp path" + From: Gurusamy Sarathy + Msg-ID: <199708060349.XAA15895@aatma.engin.umich.edu> + Files: utils/perlbug.PL + + Title: "OK: perl on (corrected)", "enhancements + to perlbug -ok" + From: "M.J.T. Guy" , Stephen McCamant + Msg-ID: , + , + + Files: utils/Makefile utils/perlbug.PL + + Title: "perlbug -ok [PATCH]" + From: "Charles F. Randall" + Msg-ID: <199706181824.MAA04082@free.click-n-call.com> + Files: utils/perlbug.PL + + Title: "perlbug broken" + From: Andreas Schwab + Msg-ID: <9707040912.AA03466@issan.informatik.uni-dortmund.de> + Files: utils/perlbug.PL + + Title: "[PATCH] perlbug under OS/2" + From: Ilya Zakharevich + Msg-ID: <199707180333.XAA03102@monk.mps.ohio-state.edu> + Files: utils/perlbug.PL + + Title: "perldoc doesn't grok Win32 UNC paths" + From: Warren Jones + Msg-ID: <97Jun17.184420pdt.35728-1@gateway.fluke.com>, + <97Jun18.165618pdt.35713-1@gateway.fluke.com> + Files: utils/perldoc.PL + + Title: "[PATCH] perldoc under OS/2" + From: Ilya Zakharevich + Msg-ID: <199707180340.XAA03114@monk.mps.ohio-state.edu> + Files: utils/perldoc.PL + + Title: "h2ph corrections to avoid redefined sub warnings" + From: wdconsta + Msg-ID: + Files: utils/h2ph.PL + + + +---------------- Version 5.004_01 Maintenance release 1 for 5.004 ---------------- diff --git a/Configure b/Configure index e017b34..ceb215c 100755 --- a/Configure +++ b/Configure @@ -739,7 +739,7 @@ loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" : general looking path for locating libraries -glibpth="/shlib /usr/shlib /lib/pa1.1 /usr/lib/pa1.1 /usr/lib/large" +glibpth="/shlib /usr/shlib /usr/lib/pa1.1 /usr/lib/large" glibpth="$glibpth /lib /usr/lib $xlibpth" glibpth="$glibpth /lib/large /usr/lib/small /lib/small" glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib" @@ -6381,7 +6381,7 @@ main() { EOCP : check sys/file.h first to get FREAD on Sun if $test `./findhdr sys/file.h` && \ - $cc $ccflags "-DI_SYS_FILE" open3.c -o open3 ; then + $cc $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs ; then h_sysfile=true; echo " defines the O_* constants..." >&4 if ./open3; then @@ -6392,7 +6392,7 @@ if $test `./findhdr sys/file.h` && \ val="$undef" fi elif $test `./findhdr fcntl.h` && \ - $cc $ccflags "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then + $cc $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs ; then h_fcntl=true; echo " defines the O_* constants..." >&4 if ./open3; then diff --git a/INSTALL b/INSTALL index fa6c823..ffb755a 100644 --- a/INSTALL +++ b/INSTALL @@ -123,6 +123,10 @@ are simplified. For example, if you use prefix=/opt/perl, then Configure will suggest /opt/perl/lib instead of /opt/perl/lib/perl5/. +NOTE: You must not specify an installation directory that is below +your perl source directory. If you do, installperl will attempt +infinite recursion. + 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 @@ -661,20 +665,9 @@ In a future version of perl, these might be enabled by default. =over 4 -=item -DDEBUGGING_MSTATS - -If DEBUGGING_MSTATS is defined, you can extract malloc -statistics from the Perl interpreter. The overhead this imposes is not -large (perl just twiddles integers at malloc/free/sbrk time). When you -run perl with the environment variable PERL_DEBUG_MSTATS set to -either 1 or 2, the interpreter will dump statistics to stderr at exit -time and (with a value of 2) after compilation. If you install the -Devel::Peek module you can get the statistics whenever you like by -invoking its mstat() function. +=item -DPERL_EMERGENCY_SBRK -=item -DEMERGENCY_SBRK - -If EMERGENCY_SBRK is defined, running out of memory need not be a +If PERL_EMERGENCY_SBRK is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special variable $^M. See perlvar(1) for more details. @@ -986,6 +979,10 @@ invoke Configure with for Solaris systems. For a SunOS system, you must use -B/bin/ instead. +Alternatively, recent versions of GNU ld reportedly work if you +include C<-Wl,-export-dynamic> in the ccdlflags variable in +config.sh. + =item ld.so.1: ./perl: fatal: relocation error: If you get this message on SunOS or Solaris, and you're using gcc, @@ -1045,6 +1042,18 @@ problem is probably that Configure failed to detect your system's fork() function. Follow the procedure in the previous items on L<"vsprintf"> and L<"nm extraction">. +=item __inet_* errors + +If you receive unresolved symbol errors during Perl build and/or test +referring to __inet_* symbols, check to see whether BIND 8.1 is +installed. It installs a /usr/local/include/arpa/inet.h that refers to +these symbols. Versions of BIND later than 8.1 do not install inet.h +in that location and avoid the errors. You should probably update to a +newer version of BIND. If you can't, you can either link with the +updated resolver library provided with BIND 8.1 or rename +/usr/local/bin/arpa/inet.h during the Perl build and test process to +avoid the problem. + =item Optimizer If you can't compile successfully, try turning off your compiler's @@ -1145,10 +1154,14 @@ Machines with half-implemented dbm routines will need to #undef I_ODBM =head1 make test -This will run the regression tests on the perl you just made. If it -doesn't say "All tests successful" then something went wrong. See the -file t/README in the t subdirectory. Note that you can't run the -tests in background if this disables opening of /dev/tty. +This will run the regression tests on the perl you just made (you +should run plain 'make' before 'make test' otherwise you won't have a +complete build). If 'make test' doesn't say "All tests successful" +then something went wrong. See the file t/README in the t subdirectory. + +If you want to run make test in the background you should +Note that you can't run the tests in background if this disables +opening of /dev/tty. If make test bombs out, just cd to the t directory and run ./TEST by hand to see if it makes any difference. If individual tests @@ -1410,4 +1423,4 @@ feedback from the perl5-porters@perl.org folks. =head1 LAST MODIFIED -$Id: INSTALL,v 1.18 1997/05/29 18:24:10 doughera Exp $ +$Id: INSTALL,v 1.22 1997/08/01 15:39:14 doughera Released $ diff --git a/Makefile.SH b/Makefile.SH index 61d2ca4..b941bb0 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -359,9 +359,18 @@ install.perl: all installperl install.man: all installman ./perl installman -# Not implemented yet. -#install.html: all installhtml -# ./perl installhtml +# XXX Experimental. Hardwired values, but useful for testing. +# Eventually Configure could ask for some of these values. +install.html: all installhtml + ./installhtml \ + --podroot=. --podpath=. --recurse \ + --htmldir=$(privlib)/html \ + --htmlroot=$(privlib)/html \ + --splithead=pod/perlipc \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --verbose + # I now supply perly.c with the kits, so the following section is # used only if you force byacc to run by saying @@ -475,9 +484,9 @@ lint: perly.c $(c) # Need to unset during recursion to go out of loop -MAKEDEPEND = makedepend +MAKEDEPEND = Makefile makedepend -$(FIRSTMAKEFILE): Makefile $(MAKEDEPEND) +$(FIRSTMAKEFILE): $(MAKEDEPEND) $(MAKE) depend MAKEDEPEND= config.h: config_h.SH config.sh @@ -514,6 +523,11 @@ minitest: miniperl - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \ && ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t .clist diff --git a/Porting/patchls b/Porting/patchls index b3e968d..f4de529 100755 --- a/Porting/patchls +++ b/Porting/patchls @@ -18,18 +18,19 @@ use Text::Tabs qw(expand unexpand); use strict; sub usage { -die qq{ - +die q{ patchls [options] patchfile [ ... ] - -i Invert: for each patched file list which patch files patch it - -h no filename headers (like grep), only the listing - -l no listing (like grep), only the filename headers - -c Categorise the patch and sort by category (perl specific) - -m print formatted Meta-information (Subject,From,Msg-ID etc) - -p N strip N levels of directory Prefix (like patch), else automatic - -v more verbose (-d for noisy debugging) - + -i Invert: for each patched file list which patch files patch it. + -h no filename headers (like grep), only the listing. + -l no listing (like grep), only the filename headers. + -c Categorise the patch and sort by category (perl specific). + -m print formatted Meta-information (Subject,From,Msg-ID etc). + -p N strip N levels of directory Prefix (like patch), else automatic. + -v more verbose (-d for noisy debugging). + -f F only list patches which patch files matching regexp F + (F has $ appended unless it contains a /). + -I just gather and display summary Information about the patches. } } @@ -43,20 +44,23 @@ $::opt_i = 0; $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; +$::opt_f = ''; +$::opt_I = 0; usage unless @ARGV; -getopts("mihlvcp:") or usage; +getopts("mihlvcp:f:I") or usage; my %cat_title = ( - 'TEST' => 'TESTS', + 'BUILD' => 'BUILD PROCESS', + 'CORE' => 'CORE LANGUAGE', 'DOC' => 'DOCUMENTATION', - 'UTIL' => 'UTILITIES', - 'PORT' => 'PORTABILITY', 'LIB' => 'LIBRARY AND EXTENSIONS', - 'CORE' => 'CORE LANGUAGE', - 'BUILD' => 'BUILD PROCESS', - 'OTHER' => 'OTHER', + 'PORT1' => 'PORTABILITY - WIN32', + 'PORT2' => 'PORTABILITY - OTHER', + 'TEST' => 'TESTS', + 'UTIL' => 'UTILITIES', + 'OTHER' => 'OTHER CHANGES', ); my %ls; @@ -94,10 +98,10 @@ foreach my $argv (@ARGV) { unless (/^([-+*]{3}) / || /^(Index):/) { # not an interesting patch line but possibly meta-information next unless $::opt_m; - $ls->{From}{$1}=1 if /^From: (.*\S)/i; - $ls->{Title}{$1}=1 if /^Subject: (?:Re: )?(.*\S)/i; - $ls->{'Msg-ID'}{$1}=1 if /^Message-Id: (.*\S)/i; - $ls->{Date}{$1}=1 if /^Date: (.*\S)/i; + $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; next; } $type = $1; @@ -141,6 +145,41 @@ my @ls = sort { $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in} } values %ls; +if ($::opt_f) { # filter out patches based on -f + my $out; + $::opt_f .= '$' unless $::opt_f =~ m:/:; + @ls = grep { + my @out = keys %{$_->{out}}; + my $match = 0; + for $out (@out) { + ++$match if $out =~ m/$::opt_f/o; + } + $match; + } @ls; +} + +if ($::opt_I) { + my $n_patches = 0; + my($in,$out); + my %all_out; + foreach $in (@ls) { + next unless $in->{is_in}; + ++$n_patches; + my @outs = keys %{$in->{out}}; + @all_out{@outs} = ($in->{in}) x @outs; + } + my @all_out = sort keys %all_out; + my @missing = grep { ! -f $_ } @all_out; + print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n"; + if ($::opt_v and @missing) { + print "Missing files:\n"; + foreach $out (@missing) { + printf " %-20s\t%s\n", $out, $all_out{$out}; + } + } + exit 0+@missing; +} + unless ($::opt_c and $::opt_m) { foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; @@ -151,7 +190,8 @@ else { my $c = ''; foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; - print "\n $cat_title{$ls->{category}}\n" if $ls->{category} ne $c; + print "\n ------ $cat_title{$ls->{category}} ------\n" + if $ls->{category} ne $c; $c = $ls->{category}; unless ($::opt_i) { list_files_by_patch($ls); @@ -194,6 +234,8 @@ sub add_file { sub trim_name { # reduce/tidy file paths from diff lines my $name = shift; $name = "$name ($in)" if $name eq "/dev/null"; + $name =~ s:\\:/:g; # adjust windows paths + $name =~ s://:/:g; # simplify (and make win \\share into absolute path) if (defined $::opt_p) { # strip on -p levels of directory prefix my $dc = $::opt_p; @@ -202,7 +244,7 @@ sub trim_name { # reduce/tidy file paths from diff lines else { # try to strip off leading path to perl directory # if absolute path, strip down to any *perl* directory first $name =~ s:^/.*?perl.*?/::i; - $name =~ s:.*perl[-_]?5\.[-_a-z0-9.]+/::i; + $name =~ s:.*perl[-_]?5?[._]?[-_a-z0-9.+]*/::i; $name =~ s:^\./::; } return $name; @@ -239,7 +281,9 @@ sub list_files_by_patch { sub my_wrap { - return expand(wrap(@_)); + my $txt = eval { expand(wrap(@_)) }; # die's on long lines! + return $txt unless $@; + return expand("@_"); } @@ -253,17 +297,18 @@ sub categorize_files { $c{TEST} += 5,next if m:^t/:; $c{DOC} += 5,next if m:^pod/:; $c{UTIL} += 10,next if m:^(utils|x2p|h2pl)/:; - $c{PORT} += 15,next - if m:^(cygwin32|os2|plan9|qnx|vms|win32)/: + $c{PORT1}+= 15,next if m:^win32:; + $c{PORT2} += 15,next + if m:^(cygwin32|os2|plan9|qnx|vms)/: or m:^(hints|Porting|ext/DynaLoader)/: or m:^README\.:; $c{LIB} += 10,next if m:^(lib|ext)/:; $c{'CORE'} += 15,next - if m:^[^/]+[\._]([chH]|sym)$:; + if m:^[^/]+[\._]([chH]|sym|pl)$:; $c{BUILD} += 10,next if m:^[A-Z]+$: or m:^[^/]+\.SH$: - or m:^(install|configure):i; + or m:^(install|configure|configpm):i; print "Couldn't categorise $_\n" if $::opt_v; $c{OTHER} += 1; } diff --git a/README.win32 b/README.win32 index aafb1cc..1f8dd07 100644 --- a/README.win32 +++ b/README.win32 @@ -294,7 +294,7 @@ This pipes "foo" to the pager and writes "bar" in the file "blurch": perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less -Discovering the usefullness of the "command.com" shell on Windows95 +Discovering the usefulness of the "command.com" shell on Windows95 is left as an exercise to the reader :) =item Building Extensions diff --git a/Todo b/Todo index 5e48ba6..627045c 100644 --- a/Todo +++ b/Todo @@ -47,7 +47,6 @@ Vague possibilities ref function in list context data prettyprint function? (or is it, as I suspect, a lib routine?) make tr/// return histogram in list context? - undef wantarray in void context Loop control on do{} et al Explicit switch statements built-in globbing diff --git a/doio.c b/doio.c index 8373d09..00e2e75 100644 --- a/doio.c +++ b/doio.c @@ -1366,17 +1366,17 @@ SV **sp; { struct semid_ds semds; #ifdef __linux__ /* XXX Need metaconfig test */ -/* linux uses : - int semctl (int semid, int semnun, int cmd, union semun arg) - +/* linux (and Solaris2?) uses : + int semctl (int semid, int semnum, int cmd, union semun arg) union semun { int val; struct semid_ds *buf; ushort *array; }; */ - unsemds.buf = &semds; - if (semctl(id, 0, IPC_STAT, unsemds) == -1) + union semun semun; + semun.buf = &semds; + if (semctl(id, 0, IPC_STAT, semun) == -1) #else if (semctl(id, 0, IPC_STAT, &semds) == -1) #endif diff --git a/embed.h b/embed.h index 3c30106..4be72d7 100644 --- a/embed.h +++ b/embed.h @@ -307,8 +307,8 @@ #define lshift_amg Perl_lshift_amg #define lshift_ass_amg Perl_lshift_ass_amg #define lt_amg Perl_lt_amg -#define magic_clearenv Perl_magic_clearenv #define magic_clear_all_env Perl_magic_clear_all_env +#define magic_clearenv Perl_magic_clearenv #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack @@ -1046,6 +1046,7 @@ #define sv_setptrobj Perl_sv_setptrobj #define sv_setpv Perl_sv_setpv #define sv_setpvf Perl_sv_setpvf +#define sv_setpviv Perl_sv_setpviv #define sv_setpvn Perl_sv_setpvn #define sv_setref_iv Perl_sv_setref_iv #define sv_setref_nv Perl_sv_setref_nv diff --git a/global.sym b/global.sym index 4532d33..a8d99d7 100644 --- a/global.sym +++ b/global.sym @@ -1118,6 +1118,7 @@ sv_setiv sv_setnv sv_setptrobj sv_setpv +sv_setpviv sv_setpvn sv_setref_iv sv_setref_nv diff --git a/gv.c b/gv.c index 8b38bbe..6658259 100644 --- a/gv.c +++ b/gv.c @@ -79,7 +79,7 @@ char *name; sv_setpv(GvSV(gv), name); if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) GvMULTI_on(gv); - if (perldb) + if (PERLDB_LINE) hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); return gv; } @@ -1341,7 +1341,7 @@ int flags; ENTER; SAVESPTR(op); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; PUTBACK; pp_pushmark(); diff --git a/hints/os2.sh b/hints/os2.sh index adbb7f1..b468f2d 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -28,7 +28,28 @@ startsh="#!$sh" sysman=`../UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1` cc='gcc' usrinc='/emx/include' -libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`" +emxpath="`../UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`" + +libemx="$emxpath/lib" +if test ! -d "$libemx"; then + if test -d "$LIBRARY_PATH"; then + usrinc="$LIBRARY_PATH" + else + libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`" + fi +fi + +if test -d "$emxpath/include"; then + usrinc="$emxpath/include" +else + if test -d "$C_INCLUDE_PATH"; then + usrinc="$C_INCLUDE_PATH" + else + usrinc="`../UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`" + fi +fi + +rsx="`../UU/loc rsx.exe undef $pth`" if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi @@ -66,8 +87,8 @@ fi aout_ldflags="$aout_ldflags" aout_d_fork='define' -aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' -aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' +aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' +aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK' aout_use_clib='c' aout_usedl='undef' aout_archobjs="os2.o dl_os2.o" @@ -192,15 +213,11 @@ 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" - lddlflags="$lddlflags -s" # Strip symbol table - aout_ldflags="$aout_ldflags -s" # Strip symbol table + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" ;; esac -####### All the rest is commented - -# The next two are commented. pdksh handles #! +# The next two are commented. pdksh handles #!, extproc gives no path part. # sharpbang='extproc ' # shsharp='false' diff --git a/hints/sunos_4_1.sh b/hints/sunos_4_1.sh index 16ea47a..a040d36 100644 --- a/hints/sunos_4_1.sh +++ b/hints/sunos_4_1.sh @@ -25,7 +25,9 @@ d_tzname='undef' # The gcc fix-includes script exposes those incorrect prototypes. # There may be other examples as well. Volunteers are welcome to # track them all down :-). In the meantime, we'll just skip unistd.h -# for SunOS. +# for SunOS in most of the code. The POSIX extension is built with +# unistd.h because, even though unistd.h has problems, if used with +# care, it helps create a better POSIX extension. i_unistd='undef' cat << 'EOM' >&4 diff --git a/installhtml b/installhtml index 72564d1..6fa22ca 100755 --- a/installhtml +++ b/installhtml @@ -93,14 +93,14 @@ The following command-line is an example of the one we use to convert perl documentation: ./installhtml --podpath=lib:ext:pod:vms \ - --podroot=/usr/src/perl \ - --htmldir=/perl/nmanual \ - --htmlroot=/perl/nmanual \ - --splithead=pod/perlipc \ - --splititem=pod/perlfunc \ - --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ - --recurse \ - --verbose + --podroot=/usr/src/perl \ + --htmldir=/perl/nmanual \ + --htmlroot=/perl/nmanual \ + --splithead=pod/perlipc \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --recurse \ + --verbose =head1 AUTHOR diff --git a/lib/Exporter.pm b/lib/Exporter.pm index a91014b..3f42e40 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -167,6 +167,15 @@ sub export { } } +sub export_to_level +{ + my $pkg = shift; + my ($level, $junk) = (shift, shift); # need to get rid of first arg + # we know it already. + my $callpkg = caller($level); + $pkg->export($callpkg, @_); +} + sub import { my $pkg = shift; my $callpkg = caller($ExportLevel); @@ -174,6 +183,7 @@ sub import { } + # Utility functions sub _push_tags { @@ -348,6 +358,53 @@ You can say C to see how the specifications are being processed and what is actually being imported into modules. +=head2 Exporting without using Export's import method + +Exporter has a special method, 'export_to_level' which is used in situations +where you can't directly call Export's import method. The export_to_level +method looks like: + +MyPackage->export_to_level($where_to_export, @what_to_export); + +where $where_to_export is an integer telling how far up the calling stack +to export your symbols, and @what_to_export is an array telling what +symbols *to* export (usually this is @_). + +For example, suppose that you have a module, A, which already has an +import function: + +package A; + +@ISA = qw(Exporter); +@EXPORT_OK = qw ($b); + +sub import +{ + $A::b = 1; # not a very useful import method +} + +and you want to Export symbol $A::b back to the module that called +package A. Since Exporter relies on the import method to work, via +inheritance, as it stands Exporter::import() will never get called. +Instead, say the following: + +package A; +@ISA = qw(Exporter); +@EXPORT_OK = qw ($b); + +sub import +{ + $A::b = 1; + A->export_to_level(1, @_); +} + +This will export the symbols one level 'above' the current package - ie: to +the program or module that used package A. + +Note: Be careful not to modify '@_' at all before you call export_to_level +- or people using your package will get very unexplained results! + + =head2 Module Version Checking The Exporter module will convert an attempt to import a number from a diff --git a/lib/ExtUtils/Command.pm b/lib/ExtUtils/Command.pm index bdf32d4..d37d0f3 100644 --- a/lib/ExtUtils/Command.pm +++ b/lib/ExtUtils/Command.pm @@ -10,7 +10,7 @@ require Exporter; use vars qw(@ISA @EXPORT $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); -$VERSION = '1.00'; +$VERSION = '1.01'; =head1 NAME @@ -18,16 +18,16 @@ ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. =head1 SYNOPSIS - perl -MExtUtils::command -e cat files... > destination - perl -MExtUtils::command -e mv source... destination - perl -MExtUtils::command -e cp source... destination - perl -MExtUtils::command -e touch files... - perl -MExtUtils::command -e rm_f file... - perl -MExtUtils::command -e rm_rf directories... - perl -MExtUtils::command -e mkpath directories... - perl -MExtUtils::command -e eqtime source destination - perl -MExtUtils::command -e chmod mode files... - perl -MExtUtils::command -e test_f file + perl -MExtUtils::Command -e cat files... > destination + perl -MExtUtils::Command -e mv source... destination + perl -MExtUtils::Command -e cp source... destination + perl -MExtUtils::Command -e touch files... + perl -MExtUtils::Command -e rm_f file... + perl -MExtUtils::Command -e rm_rf directories... + perl -MExtUtils::Command -e mkpath directories... + perl -MExtUtils::Command -e eqtime source destination + perl -MExtUtils::Command -e chmod mode files... + perl -MExtUtils::Command -e test_f file =head1 DESCRIPTION diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 9284396..ff5dbf1 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -1,7 +1,7 @@ package ExtUtils::Install; -$VERSION = substr q$Revision: 1.16 $, 10; -# $Date: 1996/12/17 00:31:26 $ +$VERSION = substr q$Revision: 1.19 $, 10; +# $Date: 1997/08/01 08:39:37 $ use Exporter; use Carp (); diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index 90186d8..fed25ae 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -2,7 +2,7 @@ package ExtUtils::Liblist; use vars qw($VERSION); # Broken out of MakeMaker from version 4.11 -$VERSION = substr q$Revision: 1.2201 $, 10; +$VERSION = substr q$Revision: 1.25 $, 10; use Config; use Cwd 'cwd'; diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index d189898..7669167 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -8,8 +8,8 @@ use strict; use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Verbose %pm %static $Xsubpp_Version); -$VERSION = substr q$Revision: 1.114 $, 10; -# $Id: MM_Unix.pm,v 1.113 1997/02/11 21:54:09 k Exp $ +$VERSION = substr q$Revision: 1.118 $, 10; +# $Id: MM_Unix.pm,v 1.118 1997/08/01 09:42:52 k Exp $ Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); @@ -181,6 +181,7 @@ sub ExtUtils::MM_Unix::export_list ; sub ExtUtils::MM_Unix::extliblist ; sub ExtUtils::MM_Unix::file_name_is_absolute ; sub ExtUtils::MM_Unix::find_perl ; +sub ExtUtils::MM_Unix::fixin ; sub ExtUtils::MM_Unix::force ; sub ExtUtils::MM_Unix::guess_name ; sub ExtUtils::MM_Unix::has_link_code ; @@ -1103,6 +1104,86 @@ specified by @ExtUtils::MakeMaker::MM_Sections. =over 2 +=item fixin + +Inserts the sharpbang or equivalent magic number to a script + +=cut + +sub fixin { # stolen from the pink Camel book, more or less + my($self,@files) = @_; + my($does_shbang) = $Config::Config{'sharpbang'} =~ /^\s*\#\!/; + my($file,$interpreter); + for $file (@files) { + local(*FIXIN); + local(*FIXOUT); + open(FIXIN, $file) or Carp::croak "Can't process '$file': $!"; + local $/ = "\n"; + chomp(my $line = ); + next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. + # Now figure out the interpreter name. + my($cmd,$arg) = split ' ', $line, 2; + $cmd =~ s!^.*/!!; + + # Now look (in reverse) for interpreter in absolute PATH (unless perl). + if ($cmd eq "perl") { + $interpreter = $Config{perlpath}; + } else { + my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path; + $interpreter = ''; + my($dir); + foreach $dir (@absdirs) { + if ($self->maybe_command($cmd)) { + warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter; + $interpreter = $self->catfile($dir,$cmd); + } + } + } + # Figure out how to invoke interpreter on this machine. + + my($shb) = ""; + if ($interpreter) { + print STDOUT "Changing sharpbang in $file to $interpreter" if $Verbose; + if ($does_shbang) { + $shb .= "$Config{'sharpbang'}$interpreter"; + $shb .= ' ' . $arg if defined $arg; + $shb .= "\n"; + } + $shb .= qq{ +eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' + if \$running_under_some_shell; +}; + } else { + warn "Can't find $cmd in PATH, $file unchanged" + if $Verbose; + next; + } + + unless ( rename($file, "$file.bak") ) { + warn "Can't modify $file"; + next; + } + unless ( open(FIXOUT,">$file") ) { + warn "Can't create new $file: $!\n"; + next; + } + my($dev,$ino,$mode) = stat FIXIN; + $mode = 0755 unless $dev; + chmod $mode, $file; + + # Print out the new #! line (or equivalent). + local $\; + undef $/; + print FIXOUT $shb, ; + close FIXIN; + close FIXOUT; + unlink "$file.bak"; + } continue { + chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; + system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';; + } +} + =item force (o) Just writes FORCE: @@ -1280,7 +1361,6 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) # my $fh = new FileHandle; local *FH; my($ispod)=0; - # one day test, if $/ can be set to '' safely (is the bug fixed that was in 5.001m?) # if ($fh->open("<$name")) { if (open(FH,"<$name")) { # while (<$fh>) { @@ -1297,7 +1377,9 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) $ispod = 1; } if( $ispod ) { - $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)'); + $manifypods{$name} = + $self->catfile('$(INST_MAN1DIR)', + basename($name).'.$(MAN1EXT)'); } } } @@ -1901,23 +1983,27 @@ sub installbin { $fromto{$from}=$to; } @to = values %fromto; - push(@m, " + push(@m, qq{ EXE_FILES = @{$self->{EXE_FILES}} +FIXIN = \$(PERL) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -MExtUtils::MakeMaker \\ + -e "MY->fixin(shift)" + all :: @to $self->{NOECHO}\$(NOOP) realclean :: $self->{RM_F} @to -"); +}); while (($from,$to) = each %fromto) { last unless defined $from; my $todir = dirname($to); push @m, " -$to: $from $self->{MAKEFILE} ".$self->catfile($todir,'.exists')." +$to: $from $self->{MAKEFILE} " . $self->catdir($todir,'.exists') . " $self->{NOECHO}$self->{RM_F} $to $self->{CP} $from $to + \$(FIXIN) $to "; } join "", @m; @@ -2431,18 +2517,21 @@ sub parse_version { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod; chop; - next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/; + # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/; + next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; my $eval = qq{ package ExtUtils::MakeMaker::_version; no strict; - \$$1=undef; do { + local $1$2; + \$$2=undef; do { $_ - }; \$$1 + }; \$$2 }; local($^W) = 0; - $result = eval($eval) || 0; + $result = eval($eval); die "Could not eval '$eval' in $parsefile: $@" if $@; + $result = "undef" unless defined $result; last; } close FH; diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index da2a763..dc3b4ce 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -96,7 +96,7 @@ sub fixpath { } my($fixedpath,$prefix,$name); - if ($path =~ m#^\$\(.+\)$# || $path =~ m#[/:>\]]#) { + if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])$/) { $fixedpath = vmspath($self->eliminate_macros($path)); } @@ -105,7 +105,9 @@ sub fixpath { } } elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) { - my($vmspre) = vmspath($self->eliminate_macros("\$($prefix)")) || ''; # is it a dir or just a name? + my($vmspre) = $self->eliminate_macros("\$($prefix)"); + # is it a dir or just a name? + $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : ''; $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 6d1746c..5511e3d 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -2,10 +2,10 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib package ExtUtils::MakeMaker; -$Version = $VERSION = "5.4002"; +$Version = $VERSION = "5.42"; $Version_OK = "5.17"; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) -($Revision = substr(q$Revision: 1.211 $, 10)) =~ s/\s+$//; +($Revision = substr(q$Revision: 1.216 $, 10)) =~ s/\s+$//; @@ -1157,6 +1157,11 @@ Ref to array of *.c file names. Initialised from a directory scan and the values portion of the XS attribute hash. This is not currently used by MakeMaker but may be handy in Makefile.PLs. +=item CCFLAGS + +String that will be included in the compiler call command line between +the arguments INC and OPTIMIZE. + =item CONFIG Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from @@ -1257,6 +1262,10 @@ Perl binary able to run this extension. Ref to array of *.h file names. Similar to C. +=item IMPORTS + +IMPORTS is only used on OS/2. + =item INC Include file dirs eg: C<"-I/usr/5include -I/path/to/inc"> @@ -1564,15 +1573,17 @@ routine requires that the file named by VERSION_FROM contains one single line to compute the version number. The first line in the file that contains the regular expression - /\$(([\w\:\']*)\bVERSION)\b.*\=/ + /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ will be evaluated with eval() and the value of the named variable B the eval() will be assigned to the VERSION attribute of the MakeMaker object. The following lines will be parsed o.k.: $VERSION = '1.00'; - ( $VERSION ) = '$Revision: 1.211 $ ' =~ /\$Revision:\s+([^\s]+)/; + *VERSION = \'1.01'; + ( $VERSION ) = '$Revision: 1.216 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; + *FOO::VERSION = \'1.11'; but these will fail: @@ -1580,9 +1591,16 @@ but these will fail: local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; -The file named in VERSION_FROM is added as a dependency to Makefile to -guarantee, that the Makefile contains the correct VERSION macro after -a change of the file. +The file named in VERSION_FROM is not added as a dependency to +Makefile. This is not really correct, but it would be a major pain +during development to have to rewrite the Makefile for any smallish +change in that file. If you want to make sure that the Makefile +contains the correct VERSION macro after any change of the file, you +would have to do something like + + depend => { Makefile => '$(VERSION_FROM)' } + +See attribute C below. =item XS diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index 73dc81d..3501364 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -7,7 +7,7 @@ use Exporter; use vars qw( @ISA @EXPORT $VERSION ); @ISA = 'Exporter'; @EXPORT = '&Mksymlists'; -$VERSION = substr q$Revision: 1.13 $, 10; +$VERSION = substr q$Revision: 1.16 $, 10; sub Mksymlists { my(%spec) = @_; @@ -106,16 +106,28 @@ sub _write_win32 { open(DEF,">$data->{FILE}.def") or croak("Can't create $data->{FILE}.def: $!\n"); - print DEF "LIBRARY $data->{DLBASE}\n"; + # put library name in quotes (it could be a keyword, like 'Alias') + print DEF "LIBRARY \"$data->{DLBASE}\"\n"; print DEF "CODE LOADONCALL\n"; print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; print DEF "EXPORTS\n "; + my @syms; + # Export public symbols both with and without underscores to + # ensure compatibility between DLLs from different compilers + # NOTE: DynaLoader itself only uses the names without underscores, + # so this is only to cover the case when the extension DLL may be + # linked to directly from C. GSAR 97-07-10 if ($Config::Config{'cc'} =~ /^bcc/i) { - for (@{$data->{DL_VARS}}) { $_ = "$_ = _$_" } - for (@{$data->{FUNCLIST}}) { $_ = "$_ = _$_" } + for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { + push @syms, "_$_", "$_ = _$_"; + } } - print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; - print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; + else { + for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { + push @syms, "$_", "_$_ = $_"; + } + } + print DEF join("\n ",@syms, "\n") if @syms; if (%{$data->{IMPORTS}}) { print DEF "IMPORTS\n"; my ($name, $exp); diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 1dc699c..0264b61 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -94,9 +94,9 @@ sub pipe { } # Rebless standard file handles -bless *STDIN{IO}, "FileHandle"; -bless *STDOUT{IO}, "FileHandle"; -bless *STDERR{IO}, "FileHandle"; +bless *STDIN{IO}, "FileHandle" if ref *STDIN{IO} eq "IO::Handle"; +bless *STDOUT{IO}, "FileHandle" if ref *STDOUT{IO} eq "IO::Handle"; +bless *STDERR{IO}, "FileHandle" if ref *STDERR{IO} eq "IO::Handle"; 1; diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 43caa03..f6d45ce 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -20,7 +20,7 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling =head1 SYNOPSIS - $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH + $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'some cmd and args', 'optarg', ...); =head1 DESCRIPTION diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm index cbfd943..d23310a 100644 --- a/lib/Sys/Hostname.pm +++ b/lib/Sys/Hostname.pm @@ -39,8 +39,7 @@ sub hostname { if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name - eval {local $SIG{'__DIE__'}; - ($host) = gethostbyname('me')}; # returns 'me' on most systems + eval { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] }; if ($@) { return $host = $ENV{'SYS$NODE'}; } # method 3 - has someone else done the job already? It's common for the @@ -70,7 +69,7 @@ sub hostname { # method 2 - syscall is preferred since it avoids tainting problems eval { - local $SIG{'__DIE__'}; + local $SIG{__DIE__}; { package main; require "syscall.ph"; @@ -81,19 +80,19 @@ sub hostname { # method 3 - trusty old hostname command || eval { - local $SIG{'__DIE__'}; + local $SIG{__DIE__}; $host = `(hostname) 2>/dev/null`; # bsdish } # method 4 - sysV uname command (may truncate) || eval { - local $SIG{'__DIE__'}; + local $SIG{__DIE__}; $host = `uname -n 2>/dev/null`; ## sysVish } # method 5 - Apollo pre-SR10 || eval { - local $SIG{'__DIE__'}; + local $SIG{__DIE__}; ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); } diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index a9df784..b6923dd 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -240,7 +240,7 @@ sub OUT { shift->[1] } sub MinLine { undef } sub Attribs { {} } -my %features = (tkRunning => 1, ornaments => 1, newTTY => 1); +my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1); sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index 8d3e49a..d2d70da 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -59,9 +59,17 @@ sub timegm { sub timelocal { my $t = &timegm; + my $tt = $t; my (@lt) = localtime($t); my (@gt) = gmtime($t); + if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) { + # Wrap error, too early a date + # Try a safer date + $tt = $DAY; + @lt = localtime($tt); + @gt = gmtime($tt); + } my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; @@ -80,7 +88,7 @@ sub timelocal { $time = $t + $tzsec; return -1 if $cheat<0 and $^O ne 'VMS'; - @test = localtime($time); + @test = localtime($time + ($tt - $t)); $time -= $HR if $test[2] != $_[2]; $time; } diff --git a/lib/UNIVERSAL.pm b/lib/UNIVERSAL.pm index 6d832c4..dc02423 100644 --- a/lib/UNIVERSAL.pm +++ b/lib/UNIVERSAL.pm @@ -1,7 +1,10 @@ package UNIVERSAL; +# UNIVERSAL should not contain any extra subs/methods beyond those +# that it exists to define. The use of Exporter below is a historical +# accident that should be fixed sometime. require Exporter; -@ISA = qw(Exporter); +*import = \&Exporter::import; @EXPORT_OK = qw(isa can); 1; @@ -13,12 +16,11 @@ UNIVERSAL - base class for ALL classes (blessed references) =head1 SYNOPSIS - use UNIVERSAL qw(isa); - - $yes = isa($ref, "HASH"); $io = $fd->isa("IO::Handle"); $sub = $obj->can('print'); + $yes = UNIVERSAL::isa($ref, "HASH"); + =head1 DESCRIPTION C is the base class which all bless references will inherit from, @@ -54,11 +56,11 @@ C can be called as either a static or object method call. =back -C also optionally exports the following subroutines +The C and C methods can also be called as subroutines =over 4 -=item isa ( VAL, TYPE ) +=item UNIVERSAL::isa ( VAL, TYPE ) C returns I if the first argument is a reference and either of the following statements is true. @@ -76,7 +78,7 @@ C is a reference to a C of perl variable (er 'HASH') =back -=item can ( VAL, METHOD ) +=item UNIVERSAL::can ( VAL, METHOD ) If C is a blessed reference which has a method called C, C returns a reference to the subroutine. If C is not @@ -85,4 +87,11 @@ I is returned. =back +These subroutines should I be imported via S>. +If you want simple local access to them you can do + + *isa = \&UNIVERSAL::isa; + +to import isa into your package. + =cut diff --git a/lib/ftp.pl b/lib/ftp.pl index e671348..fd78162 100644 --- a/lib/ftp.pl +++ b/lib/ftp.pl @@ -88,15 +88,9 @@ # Initial revision # -eval { require 'chat2.pl' }; -die qq{$@ -The obsolete and problematic chat2.pl library has been removed from the -Perl distribution at the request of it's author. You can either get a -copy yourself or, preferably, fetch the new and much better Net::FTP -package from a CPAN ftp site. -} if $@ && $@ =~ /locate chat2.pl/; -die $@ if $@; -eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n"; +require 'chat2.pl'; # into main +eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" + || die "socket.ph missing: $!\n"; package ftp; diff --git a/mg.c b/mg.c index eb58886..7c7ea2a 100644 --- a/mg.c +++ b/mg.c @@ -1353,14 +1353,7 @@ MAGIC* mg; osname = Nullch; break; case '\020': /* ^P */ - i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); - if (i != perldb) { - if (perldb) - oldlastpm = curpm; - else - curpm = oldlastpm; - } - perldb = i; + perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; case '\024': /* ^T */ #ifdef BIG_TIME @@ -1664,6 +1657,21 @@ char *sig; return 0; } +static SV* sig_sv; + +static void +unwind_handler_stack(p) + void *p; +{ + U32 flags = *(U32*)p; + + if (flags & 1) + savestack_ix -= 5; /* Unprotect save in progress. */ + /* cxstack_ix-- Not needed, die already unwound it. */ + if (flags & 64) + SvREFCNT_dec(sig_sv); +} + Signal_t sighandler(sig) int sig; @@ -1671,15 +1679,56 @@ int sig; dSP; GV *gv; HV *st; - SV *sv; + SV *sv, *tSv = Sv; CV *cv; AV *oldstack; - + OP *myop = op; + U32 flags = 0; + I32 o_save_i = savestack_ix, type; + CONTEXT *cx; + XPV *tXpv = Xpv; + + if (savestack_ix + 15 <= savestack_max) + flags |= 1; + if (cxstack_ix < cxstack_max - 2) + flags |= 2; + if (markstack_ptr < markstack_max - 2) + flags |= 4; + if (retstack_ix < retstack_max - 2) + flags |= 8; + if (scopestack_ix < scopestack_max - 3) + flags |= 16; + + if (flags & 2) { /* POPBLOCK may decrease cxstack too early. */ + cxstack_ix++; /* Protect from overwrite. */ + cx = &cxstack[cxstack_ix]; + type = cx->cx_type; /* Can be during partial write. */ + cx->cx_type = CXt_NULL; /* Make it safe for unwind. */ + } if (!psig_ptr[sig]) die("Signal SIG%s received, but no signal handler set.\n", sig_name[sig]); - cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE); + /* Max number of items pushed there is 3*n or 4. We cannot fix + infinity, so we fix 4 (in fact 5): */ + if (flags & 1) { + savestack_ix += 5; /* Protect save in progress. */ + o_save_i = savestack_ix; + SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags); + } + if (flags & 4) + markstack_ptr++; /* Protect mark. */ + if (flags & 8) { + retstack_ix++; + retstack[retstack_ix] = NULL; + } + if (flags & 16) + scopestack_ix += 1; + /* sv_2cv is too complicated, try a simpler variant first: */ + if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig])) + || SvTYPE(cv) != SVt_PVCV) + cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE); + if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", @@ -1692,9 +1741,11 @@ int sig; AvFILL(signalstack) = 0; SWITCHSTACK(curstack, signalstack); - if(psig_name[sig]) + if(psig_name[sig]) { sv = SvREFCNT_inc(psig_name[sig]); - else { + flags |= 64; + sig_sv = sv; + } else { sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); } @@ -1705,6 +1756,23 @@ int sig; perl_call_sv((SV*)cv, G_DISCARD); SWITCHSTACK(signalstack, oldstack); - + if (flags & 1) + savestack_ix -= 8; /* Unprotect save in progress. */ + if (flags & 2) { + cxstack[cxstack_ix].cx_type = type; + cxstack_ix -= 1; + } + if (flags & 4) + markstack_ptr--; + if (flags & 8) + retstack_ix--; + if (flags & 16) + scopestack_ix -= 1; + if (flags & 64) + SvREFCNT_dec(sv); + op = myop; /* Apparently not needed... */ + + Sv = tSv; /* Restore global temporaries. */ + Xpv = tXpv; return; } diff --git a/op.c b/op.c index b8f363c..feae588 100644 --- a/op.c +++ b/op.c @@ -1401,7 +1401,7 @@ scope(o) OP *o; { if (o) { - if (o->op_flags & OPf_PARENS || perldb || tainting) { + if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || tainting) { o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); o->op_type = OP_LEAVE; o->op_ppaddr = ppaddr[OP_LEAVE]; @@ -1485,7 +1485,7 @@ OP *op; compcv = 0; /* Register with debugger */ - if (perldb) { + if (PERLDB_INTER) { CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; @@ -2483,7 +2483,7 @@ OP *op; register COP *cop; Newz(1101, cop, 1, COP); - if (perldb && curcop->cop_line && curstash != debstash) { + if (PERLDB_LINE && curcop->cop_line && curstash != debstash) { cop->op_type = OP_DBSTATE; cop->op_ppaddr = ppaddr[ OP_DBSTATE ]; } @@ -2514,7 +2514,7 @@ OP *op; cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv); cop->cop_stash = curstash; - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { (void)SvIOK_on(*svp); @@ -3366,7 +3366,7 @@ OP *block; if (name) { char *s; - if (perldb && curstash != debstash) { + if (PERLDB_SUBLINE && curstash != debstash) { SV *sv = NEWSV(0,0); SV *tmpstr = sv_newmortal(); static GV *db_postponed; @@ -4527,7 +4527,7 @@ OP *op; } } op->op_private |= (hints & HINT_STRICT_REFS); - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; while (o != cvop) { if (proto) { diff --git a/os2/Changes b/os2/Changes index c69fb73..146ce87 100644 --- a/os2/Changes +++ b/os2/Changes @@ -157,3 +157,4 @@ before 5.004_02: perl -S mycmd will work. Perl will also look in the current directory first. Moreover, a bug with \; in PATH being non-separator is fixed. + diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 32af9cc..493aeab 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -19,6 +19,8 @@ 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 +LD_OPT = $optimize + !GROK!THIS! $spitshell >>Makefile <<'!NO!SUBS!' @@ -36,7 +38,7 @@ perl.imp: perl5.def echo 'emx_realloc emxlibcm 403 ?' >> $@ perl.dll: $(obj) perl5.def perl$(OBJ_EXT) - $(LD) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def + $(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def perl5.def: perl.linkexp echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE" > $@ @@ -78,10 +80,13 @@ perl.exports: perl.exp EXTERN.h perl.h perl.linkexp: perl.exports perl.map cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp -perl.map: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) - $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o dummy.exe miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) $(libs) -Zmap -Zlinker /map - awk '{if ($$3 == "") print $$2}' perl.map - rm dummy.exe dummy.map +# We link miniperl statically, since .DLL depends on $(DYNALOADER) + +perl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) + $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) $(libs) -Zmap -Zlinker /map + awk '{if ($$3 == "") print $$2}' perl.map + rm miniperl.map + @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest depend: os2ish.h dlfcn.h @@ -100,12 +105,6 @@ os2ish.h: os2/os2ish.h dlfcn.h: os2/dlfcn.h cp $< $@ -# We link miniperl statically, since .DLL depends on $(DYNALOADER) - -miniperl: $& miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) $(libs) - @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest - # This one is compiled OMF, so cannot fork(): perl___: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs diff --git a/os2/diff.configure b/os2/diff.configure index a649869..39baf3f 100644 --- a/os2/diff.configure +++ b/os2/diff.configure @@ -51,7 +51,7 @@ case "$libs" in '') ;; *) for thislib in $libs; do -@@ -3968,6 +3976,8 @@ +@@ -3972,6 +3980,8 @@ : elif try=`./loc $thislib X $libpth`; $test -f "$try"; then : @@ -60,7 +60,7 @@ elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then : else -@@ -4152,6 +4162,10 @@ +@@ -4156,6 +4166,10 @@ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun @@ -203,7 +203,7 @@ dflt=`./try` case "$dflt" in [1-4][1-4][1-4][1-4]|12345678|87654321) -@@ -8707,18 +8731,18 @@ +@@ -8711,18 +8735,18 @@ $cc $ccflags -c bar1.c >/dev/null 2>&1 $cc $ccflags -c bar2.c >/dev/null 2>&1 $cc $ccflags -c foo.c >/dev/null 2>&1 @@ -227,7 +227,7 @@ else case "$ranlib" in :) ranlib='';; -@@ -8790,7 +8814,7 @@ +@@ -8794,7 +8818,7 @@ '') $echo $n ".$c" if $cc $ccflags \ $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ diff --git a/patchlevel.h b/patchlevel.h index b152f9c..ca94321 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 4 -#define SUBVERSION 1 +#define SUBVERSION 2 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/perl.c b/perl.c index 4eb69e3..891b76b 100644 --- a/perl.c +++ b/perl.c @@ -527,6 +527,7 @@ setuid perl scripts securely.\n"); /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; + FREETMPS; curstash = defstash; if (endav) call_list(oldscope, endav); @@ -848,10 +849,10 @@ PerlInterpreter *sv_interp; /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; + FREETMPS; curstash = defstash; if (endav) call_list(oldscope, endav); - FREETMPS; #ifdef MYMALLOC if (getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); @@ -883,7 +884,7 @@ PerlInterpreter *sv_interp; PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename); my_exit(0); } - if (perldb && DBsingle) + if (PERLDB_SINGLE && DBsingle) sv_setiv(DBsingle, 1); } @@ -1039,7 +1040,7 @@ I32 flags; /* See G_* flags in cop.h */ oldmark = TOPMARK; oldscope = scopestack_ix; - if (perldb && curstash != debstash + if (PERLDB_SUB && curstash != debstash /* Handle first BEGIN of -d. */ && (DBcv || (DBcv = GvCV(DBsub))) /* Try harder, since this may have been a sighandler, thus @@ -1158,7 +1159,8 @@ I32 flags; /* See G_* flags in cop.h */ I32 oldscope; dJMPENV; int ret; - + OP* oldop = op; + if (flags & G_DISCARD) { ENTER; SAVETMPS; @@ -1229,6 +1231,7 @@ I32 flags; /* See G_* flags in cop.h */ FREETMPS; LEAVE; } + op = oldop; return retval; } @@ -1354,7 +1357,7 @@ char *s; s += strlen(s); } if (!perldb) { - perldb = TRUE; + perldb = PERLDB_ALL; init_debugger(); } return s; @@ -1597,6 +1600,8 @@ init_main_stash() defgv = gv_fetchpv("_",TRUE, SVt_PVAV); errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV)); GvMULTI_on(errgv); + (void)form("%240s",""); /* Preallocate temp - for immediate signals. */ + sv_grow(GvSV(errgv), 240); /* Preallocate - for immediate signals. */ sv_setpvn(GvSV(errgv), "", 0); curstash = defstash; compiling.cop_stash = defstash; @@ -1683,7 +1688,7 @@ SV *sv; #ifdef DOSISH if (strEQ(scriptname, "-")) - dosearch = 0; + dosearch = 0; if (dosearch) { /* Look in '.' first. */ char *cur = scriptname; #ifdef SEARCH_EXTS @@ -1700,7 +1705,9 @@ SV *sv; if (Stat(cur,&statbuf) >= 0) { dosearch = 0; scriptname = cur; +#ifdef SEARCH_EXTS break; +#endif } #ifdef SEARCH_EXTS if (cur == scriptname) { @@ -1714,13 +1721,14 @@ SV *sv; #endif } #endif + if (dosearch && !strchr(scriptname, '/') #ifdef DOSISH && !strchr(scriptname, '\\') #endif && (s = getenv("PATH"))) { bool seen_dot = 0; - + bufend = s + strlen(s); while (s < bufend) { #if defined(atarist) || defined(DOSISH) @@ -1734,11 +1742,11 @@ SV *sv; } if (len < sizeof tokenbuf) tokenbuf[len] = '\0'; -#else /* ! (atarist || DOSISH) */ - s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend - ':', - &len); -#endif /* ! (atarist || DOSISH) */ +#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) @@ -1750,7 +1758,7 @@ SV *sv; #endif ) tokenbuf[len++] = '/'; - if (len == 2 && tokenbuf[0] == '.') + if (len == 2 && tokenbuf[0] == '.') seen_dot = 1; (void)strcpy(tokenbuf + len, scriptname); #endif /* !VMS */ @@ -1786,10 +1794,10 @@ SV *sv; } #ifndef DOSISH if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0)) -#endif - seen_dot = 1; /* Disable message. */ +#endif + seen_dot = 1; /* Disable message. */ if (!xfound) - croak("Can't %s %s%s%s", + croak("Can't %s %s%s%s", (xfailed ? "execute" : "find"), (xfailed ? xfailed : scriptname), (xfailed ? "" : " on PATH"), @@ -2647,10 +2655,10 @@ AV* list; /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; + FREETMPS; curstash = defstash; if (endav) call_list(oldscope, endav); - FREETMPS; JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; diff --git a/perl.h b/perl.h index 8108f03..e33122a 100644 --- a/perl.h +++ b/perl.h @@ -361,8 +361,14 @@ # include #endif +#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) +/* defines SF_APPEND and might define SF_APPEND + * (the neo-BSD seem to do this). */ +# undef SF_APPEND +#endif + #ifdef I_SYS_STAT -#include +# include #endif /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives @@ -1277,11 +1283,6 @@ typedef Sighandler_t Sigsave_t; # ifndef register # define register # endif -# ifdef MYMALLOC -# ifndef DEBUGGING_MSTATS -# define DEBUGGING_MSTATS -# endif -# endif # define PAD_SV(po) pad_sv(po) #else # define PAD_SV(po) curpad[po] @@ -2159,6 +2160,22 @@ enum { #endif /* OVERLOAD */ +#define PERLDB_ALL 0xff +#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ +#define PERLDBf_LINE 0x02 /* Keep line #. */ +#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */ +#define PERLDBf_INTER 0x08 /* Preserve more data for + later inspections. */ +#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */ +#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */ + +#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB)) +#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE)) +#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT)) +#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) +#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) +#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) + #ifdef USE_LOCALE_COLLATE EXT U32 collation_ix; /* Collation generation index */ EXT char * collation_name; /* Name of current collation */ diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 7d8d84f..a02fd5c 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -14,7 +14,8 @@ as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs." ---Maurice Wilkes, 1949 + +I< --Maurice Wilkes, 1949> If you invoke Perl with the B<-d> switch, your script runs under the Perl source debugger. This works like an interactive Perl @@ -941,7 +942,7 @@ package DB, Perl sets the array @DB::args to contain the arguments the corresponding stack frame was called with. If perl is run with B<-d> option, the following additional features -are enabled: +are enabled (cf. L): =over @@ -1016,16 +1017,13 @@ in the package C.) =back -Note that no subroutine call is possible until C<&DB::sub> is defined -(for subroutines outside of package C). (This restriction is -recently lifted.) - -(In fact, for the standard debugger the same is true if C<$DB::deep> -(how many levels of recursion deep into the debugger you can go before -a mandatory break) is not defined.) +Note that if C<&DB::sub> needs some external data to be setup for it +to work, no subroutine call is possible until this is done. For the +standard debugger C<$DB::deep> (how many levels of recursion deep into +the debugger you can go before a mandatory break) gives an example of +such a dependency. -With the recent updates the minimal possible debugger consists of one -line +The minimal working debugger consists of one line sub DB::DB {} diff --git a/pod/perldelta.pod b/pod/perldelta.pod index bfa57c0..0679822 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -147,6 +147,13 @@ because at least two widely-used modules depend on the old meaning of old (broken) way inside strings; but it generates this message as a warning. And in Perl 5.005, this special treatment will cease. +=head2 Fixed localization of $, $&, etc. + +Perl versions before 5.004 did not always properly localize the +regex-related special variables. Perl 5.004 does localize them, as +the documentation has always said it should. This may result in $1, +$2, etc. no longer being set where existing programs use them. + =head2 No resetting of $. on implicit close The documentation for Perl 5.0 has always stated that C<$.> is I @@ -285,7 +292,7 @@ there is no C long name for this variable. By default, running out of memory it is not trappable. However, if compiled for this, Perl may use the contents of C<$^M> as an emergency pool after die()ing with this message. Suppose that your Perl were -compiled with -DEMERGENCY_SBRK and used Perl's malloc. Then +compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then $^M = 'a' x (1<<16); @@ -495,6 +502,21 @@ before (printed only zeros), but is fine now: $i . +However, it still fails (without a warning) if the foreach is within a +subroutine: + + my $i; + sub foo { + foreach $i ( 1 .. 10 ) { + write; + } + } + foo; + format = + my i is @# + $i + . + =back =head2 New builtin methods @@ -631,24 +653,23 @@ possibly for cleaning up. =head2 Malloc enhancements -Four new compilation flags are recognized by malloc.c. (They have no -effect if perl is compiled with system malloc().) - -=over - -=item -DDEBUGGING_MSTATS - -If perl is compiled with C defined, you can print +If perl is compiled with the malloc included with the perl distribution +(that is, if C is 'define') then you can print memory statistics at runtime by running Perl thusly: env PERL_DEBUG_MSTATS=2 perl your_script_here The value of 2 means to print statistics after compilation and on -exit; with a value of 1, the statistics ares printed only on exit. +exit; with a value of 1, the statistics are printed only on exit. (If you want the statistics at an arbitrary time, you'll need to install the optional module Devel::Peek.) -=item -DEMERGENCY_SBRK +Three new compilation flags are recognized by malloc.c. (They have no +effect if perl is compiled with system malloc().) + +=over + +=item -DPERL_EMERGENCY_SBRK If this macro is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special diff --git a/pod/perldiag.pod b/pod/perldiag.pod index c0eb857..0d9ee55 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -277,6 +277,15 @@ could indicate that SvREFCNT_dec() was called too many times, or that SvREFCNT_inc() was called too few times, or that the SV was mortalized when it shouldn't have been, or that memory has been corrupted. +=item Attempt to pack pointer to temporary value + +(W) You tried to pass a temporary value (like the result of a +function, or a computed expression) to the "p" pack() template. This +means the result contains a pointer to a location that could become +invalid anytime, even before the end of the current statement. Use +literals or global values as arguments to the "p" pack() template to +avoid this warning. + =item Attempt to use reference as lvalue in substr (W) You supplied a reference as the first argument to substr() used @@ -386,6 +395,11 @@ like a block, except that it isn't a proper block. This usually occurs if you tried to jump out of a sort() block or subroutine, which is a no-no. See L. +=item Can't "goto" into the middle of a foreach loop + +(F) A "goto" statement was executed to jump into the middle of a +foreach loop. You can't get there from here. See L. + =item Can't "last" outside a block (F) A "last" statement was executed to break out of the current block, diff --git a/pod/perlembed.pod b/pod/perlembed.pod index e1ab91e..c43ed55 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -1010,7 +1010,7 @@ Dov Grobgeld, and Ilya Zakharevich. Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl Journal. Info about TPJ is available from http://tpj.com. -April 14, 1997 +July 17, 1997 Some of this material is excerpted from Jon Orwant's book: I, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index cc9fa00..4bf1fda 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2156,8 +2156,11 @@ types gobble just one value, but pack it as a string of length count, padding with nulls or spaces as necessary. (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.) Likewise, the "b" and "B" fields pack a string that many bits long. The "h" and "H" fields pack a -string that many nybbles long. The "P" packs a pointer to a structure of -the size indicated by the length. Real numbers (floats and doubles) are +string that many nybbles long. The "p" type packs a pointer to a null- +terminated string. You are responsible for ensuring the string is not a +temporary value (which can potentially get deallocated before you get +around to using the packed result). The "P" packs a pointer to a structure +of the size indicated by the length. Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard "network" representation, no facility for interchange has been made. This means that packed floating @@ -2377,6 +2380,16 @@ chdir() there, it would have been testing the wrong file. @dots = grep { /^\./ && -f "$some_dir/$_" } readdir(DIR); closedir DIR; +=item readline EXPR + +Reads from the file handle EXPR. In scalar context, a single line +is read and returned. In list context, reads until end-of-file is +reached and returns a list of lines (however you've defined lines +with $/ or $INPUT_RECORD_SEPARATOR). +This is the internal function implementing the CEXPRE> +operator, but you can use it directly. The CEXPRE> +operator is discussed in more detail in L. + =item readlink EXPR =item readlink @@ -2386,6 +2399,17 @@ implemented. If not, gives a fatal error. If there is some system error, returns the undefined value and sets C<$!> (errno). If EXPR is omitted, uses $_. +=item readpipe EXPR + +EXPR is interpolated and then executed as a system command. +The collected standard output of the command is returned. +In scalar context, it comes back as a single (potentially +multi-line) string. In list context, returns a list of lines +(however you've defined lines with $/ or $INPUT_RECORD_SEPARATOR). +This is the internal function implementing the C +operator, but you can use it directly. The C +operator is discussed in more detail in L. + =item recv SOCKET,SCALAR,LEN,FLAGS Receives a message on a socket. Attempts to receive LENGTH bytes of @@ -3342,11 +3366,15 @@ L for details. Extracts a substring out of EXPR and returns it. First character is at offset 0, or whatever you've set C<$[> to (but don't do that). -If OFFSET is negative, starts +If OFFSET is negative (or more precisely, less than C<$[>), starts that far from the end of the string. If LEN is omitted, returns everything to the end of the string. If LEN is negative, leaves that many characters off the end of the string. +If you specify a substring which is partly outside the string, the part +within the string is returned. If the substring is totally outside +the string a warning is produced. + You can use the substr() function as an lvalue, in which case EXPR must be an lvalue. If you assign something shorter than LEN, the string will shrink, and if you assign diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 989c1ef..74b0029 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -911,7 +911,7 @@ LIST, READLINE this, GETC this, DESTROY this =item Malloc enhancements --DDEBUGGING_MSTATS, -DEMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE +-DDEBUGGING_MSTATS, -DPERL_EMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE =item Miscellaneous efficiency enhancements diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 198e5c1..6487fdd 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -619,9 +619,39 @@ is identical to C<$Config{'osname'}>. =item $^P -The internal flag that the debugger clears so that it doesn't debug -itself. You could conceivably disable debugging yourself by clearing -it. +The internal variable for debugging support. Different bits mean the +following (subject to change): + +=over 6 + +=item 0x01 + +Debug subroutine enter/exit. + +=item 0x02 + +Line-by-line debugging. + +=item 0x04 + +Switch off optimizations. + +=item 0x08 + +Preserve more data for future interactive inspections. + +=item 0x10 + +Keep info about source lines on which a subroutine is defined. + +=item 0x20 + +Start with single-step on. + +=back + +Note that some bits may be relevent at compile-time only, some at +run-time only. This is a new mechanism and the details may change. =item $BASETIME @@ -753,7 +783,7 @@ L, L and L. By default, running out of memory it is not trappable. However, if compiled for this, Perl may use the contents of C<$^M> as an emergency pool after die()ing with this message. Suppose that your Perl were -compiled with -DEMERGENCY_SBRK and used Perl's malloc. Then +compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then $^M = 'a' x (1<<16); diff --git a/pp.c b/pp.c index a0b337a..8a31fff 100644 --- a/pp.c +++ b/pp.c @@ -1630,34 +1630,56 @@ PP(pp_substr) STRLEN curlen; I32 pos; I32 rem; + I32 fail; I32 lvalue = op->op_flags & OPf_MOD; char *tmps; I32 arybase = curcop->cop_arybase; if (MAXARG > 2) len = POPi; - pos = POPi - arybase; + pos = POPi; sv = POPs; tmps = SvPV(sv, curlen); - if (pos < 0) - pos += curlen + arybase; - if (pos < 0 || pos > curlen) { - if (dowarn || lvalue) + if (pos >= arybase) { + pos -= arybase; + rem = curlen-pos; + fail = rem; + if (MAXARG > 2) { + if (len < 0) { + rem += len; + if (rem < 0) + rem = 0; + } + else if (rem > len) + rem = len; + } + } + else { + pos += curlen; + if (MAXARG < 3) + rem = curlen; + else if (len >= 0) { + rem = pos+len; + if (rem > (I32)curlen) + rem = curlen; + } + else { + rem = curlen+len; + if (rem < pos) + rem = pos; + } + if (pos < 0) + pos = 0; + fail = rem; + rem -= pos; + } + if (fail < 0) { + if (dowarn || lvalue) warn("substr outside of string"); RETPUSHUNDEF; } else { - if (MAXARG < 3) - len = curlen; - else if (len < 0) { - len += curlen - pos; - if (len < 0) - len = 0; - } tmps += pos; - rem = curlen - pos; /* rem=how many bytes left*/ - if (rem > len) - rem = len; sv_setpvn(TARG, tmps, rem); if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { @@ -2328,11 +2350,13 @@ PP(pp_splice) SP++; if (++MARK < SP) { - offset = SvIVx(*MARK); + offset = i = SvIVx(*MARK); if (offset < 0) offset += AvFILL(ary) + 1; else offset -= curcop->cop_arybase; + if (offset < 0) + DIE(no_aelem, i); if (++MARK < SP) { length = SvIVx(*MARK++); if (length < 0) @@ -2345,12 +2369,6 @@ PP(pp_splice) offset = 0; length = AvMAX(ary) + 1; } - if (offset < 0) { - length += offset; - offset = 0; - if (length < 0) - length = 0; - } if (offset > AvFILL(ary) + 1) offset = AvFILL(ary) + 1; after = AvFILL(ary) + 1 - (offset + length); @@ -3847,12 +3865,19 @@ PP(pp_pack) while (len-- > 0) { fromstr = NEXTFROM; if (fromstr == &sv_undef) - aptr = NULL; + aptr = NULL; else { - if (SvREADONLY(fromstr) && curcop != &compiling) { - fromstr = sv_mortalcopy(fromstr); - } - aptr = SvPV_force(fromstr, na); + /* XXX better yet, could spirit away the string to + * a safe spot and hang on to it until the result + * of pack() (and all copies of the result) are + * gone. + */ + if (dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr))) + warn("Attempt to pack pointer to temporary value"); + if (SvPOK(fromstr) || SvNIOK(fromstr)) + aptr = SvPV(fromstr,na); + else + aptr = SvPV_force(fromstr,na); } sv_catpvn(cat, (char*)&aptr, sizeof(char*)); } diff --git a/pp_ctl.c b/pp_ctl.c index df28463..5489d9c 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1852,7 +1852,7 @@ PP(pp_goto) mark++; } } - if (perldb && curstash != debstash) { + if (PERLDB_SUB && curstash != debstash) { /* * We do not care about using sv to call CV; * it's for informational purposes only. @@ -1940,6 +1940,11 @@ PP(pp_goto) OP *oldop = op; for (ix = 1; enterops[ix]; ix++) { op = enterops[ix]; + /* Eventually we may want to stack the needed arguments + * for each op. For now, we punt on the hard ones. */ + if (op->op_type == OP_ENTERITER) + DIE("Can't \"goto\" into the middle of a foreach loop", + label); (*op->op_ppaddr)(); } op = oldop; @@ -2205,7 +2210,7 @@ int gimme; DEBUG_x(dump_eval()); /* Register with debugger: */ - if (perldb && saveop->op_type == OP_REQUIRE) { + if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) { CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; @@ -2461,6 +2466,36 @@ PP(pp_leaveeval) } curpm = newpm; /* Don't pop $1 et al till now */ + /* + * Closures mentioned at top level of eval cannot be referenced + * again, and their presence indirectly causes a memory leak. + * (Note that the fact that compcv and friends are still set here + * is, AFAIK, an accident.) --Chip + */ + if (AvFILL(comppad_name) >= 0) { + SV **svp = AvARRAY(comppad_name); + I32 ix; + for (ix = AvFILL(comppad_name); ix >= 0; ix--) { + SV *sv = svp[ix]; + if (sv && sv != &sv_undef && *SvPVX(sv) == '&') { + SvREFCNT_dec(sv); + svp[ix] = &sv_undef; + + sv = curpad[ix]; + if (CvCLONE(sv)) { + SvREFCNT_dec(CvOUTSIDE(sv)); + CvOUTSIDE(sv) = Nullcv; + } + else { + SvREFCNT_dec(sv); + sv = NEWSV(0,0); + SvPADTMP_on(sv); + curpad[ix] = sv; + } + } + } + } + #ifdef DEBUGGING assert(CvDEPTH(compcv) == 1); #endif diff --git a/pp_hot.c b/pp_hot.c index f8f4362..82372d0 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1913,7 +1913,7 @@ PP(pp_entersub) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ if (CvDEPTH(cv) == 100 && dowarn - && !(perldb && cv == GvCV(DBsub))) + && !(PERLDB_SUB && cv == GvCV(DBsub))) sub_crush_depth(cv); if (CvDEPTH(cv) > AvFILL(padlist)) { AV *av; diff --git a/pp_sys.c b/pp_sys.c index 6e25a54..d952403 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -535,7 +535,7 @@ PP(pp_tie) ENTER; SAVESPTR(op); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; XPUSHs((SV*)GvCV(gv)); @@ -646,7 +646,7 @@ PP(pp_dbmopen) ENTER; SAVESPTR(op); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; PUTBACK; pp_pushmark(); @@ -4374,6 +4374,16 @@ int fd; int operation; { int i; + int save_errno; + Off_t pos; + + /* flock locks entire file so for lockf we need to do the same */ + save_errno = errno; + pos = lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */ + if (pos > 0) /* is seekable and needs to be repositioned */ + lseek(fd, (Off_t)0, SEEK_SET); + errno = save_errno; + switch (operation) { /* LOCK_SH - get a shared lock */ @@ -4405,6 +4415,11 @@ int operation; errno = EINVAL; break; } + + if (pos > 0) /* need to restore position of the handle */ + if (lseek(fd, pos, SEEK_SET) == -1) + i = -1; + return (i); } diff --git a/proto.h b/proto.h index 67c201e..84b8f06 100644 --- a/proto.h +++ b/proto.h @@ -489,6 +489,7 @@ void sv_report_used _((void)); void sv_reset _((char* s, HV* stash)); void sv_setpvf _((SV* sv, const char* pat, ...)); void sv_setiv _((SV* sv, IV num)); +void sv_setpviv _((SV* sv, IV num)); void sv_setuv _((SV* sv, UV num)); void sv_setnv _((SV* sv, double num)); SV* sv_setref_iv _((SV* rv, char* classname, IV iv)); diff --git a/regexec.c b/regexec.c index 19fdbfa..271dc4d 100644 --- a/regexec.c +++ b/regexec.c @@ -134,21 +134,25 @@ regcppop() return input; } +/* After a successful match in WHILEM, we want to restore paren matches + * that have been overwritten by a failed match attempt in the process + * of reaching this success. We do this by restoring regstartp[i] + * wherever regendp[i] has not changed; if OPEN is changed to modify + * regendp[], the '== endp' test below should be changed to match. + * This corrects the error of: + * 0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1] + */ static void regcppartblow() { I32 i = SSPOPINT; - U32 paren = 0; - char *input; + U32 paren; char *startp; char *endp; - int lastparen; - int size; assert(i == SAVEt_REGCONTEXT); i = SSPOPINT; - input = (char *) SSPOPPTR; - lastparen = SSPOPINT; - size = SSPOPINT; + /* input, lastparen, size */ + SSPOPPTR; SSPOPINT; SSPOPINT; for (i -= 3; i > 0; i -= 3) { paren = (U32)SSPOPINT; startp = (char *) SSPOPPTR; @@ -888,7 +892,6 @@ char *prog; case OPEN: n = ARG1(scan); /* which paren pair */ regstartp[n] = locinput; - regendp[n] = 0; if (n > regsize) regsize = n; break; diff --git a/sv.c b/sv.c index 166dc07..6e40732 100644 --- a/sv.c +++ b/sv.c @@ -1497,8 +1497,10 @@ SV *sv; { I32 numtype = looks_like_number(sv); +#ifdef HAS_STRTOUL if (numtype == 1) - return atol(SvPVX(sv)); + return strtoul(SvPVX(sv), Null(char**), 10); +#endif if (!numtype && dowarn) not_a_number(sv); SET_NUMERIC_STANDARD(); @@ -1714,7 +1716,7 @@ STRLEN *lp; if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); olderrno = errno; /* some Xenix systems wipe out errno here */ - sv_setpvf(sv, "%Vd", SvIVX(sv)); + sv_setpviv(sv, SvIVX(sv)); errno = olderrno; s = SvEND(sv); if (oldIOK) @@ -2705,21 +2707,10 @@ register SV *sv; --sv_objcount; /* XXX Might want something more general */ } if (SvREFCNT(sv)) { - SV *ret; - if ( perldb - && (ret = perl_get_sv("DB::ret", FALSE)) - && SvROK(ret) && SvRV(ret) == sv && SvREFCNT(sv) == 1) { - /* Debugger is prone to dangling references. */ - SvRV(ret) = 0; - SvROK_off(ret); - SvREFCNT(sv) = 0; - } - else { if (in_clean_objs) croak("DESTROY created new reference to dead object"); /* DESTROY gave object new lease on life */ return; - } } } if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) @@ -4120,6 +4111,42 @@ SV *sv; return FALSE; } +void +sv_setpviv(sv, iv) +SV *sv; +IV iv; +{ + STRLEN len; + char buf[TYPE_DIGITS(UV)]; + char *ptr = buf + sizeof(buf); + int sign; + UV uv; + char *p; + int i; + + sv_setpvn(sv, "", 0); + if (iv >= 0) { + uv = iv; + sign = 0; + } else { + uv = -iv; + sign = 1; + } + do { + *--ptr = '0' + (uv % 10); + } while (uv /= 10); + len = (buf + sizeof(buf)) - ptr; + /* taking advantage of SvCUR(sv) == 0 */ + SvGROW(sv, sign + len + 1); + p = SvPVX(sv); + if (sign) + *p++ = '-'; + memcpy(p, ptr, len); + p += len; + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); +} + #ifdef I_STDARG void sv_setpvf(SV *sv, const char* pat, ...) @@ -4565,6 +4592,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) } if (fill == '0') *--eptr = fill; + if (left) + *--eptr = '-'; if (plus) *--eptr = plus; if (alt) diff --git a/t/TEST b/t/TEST index a6cca53..ae43666 100755 --- a/t/TEST +++ b/t/TEST @@ -101,7 +101,7 @@ while ($test = shift) { } } else { $next += 1; - print "FAILED on test $next\n"; + print "FAILED at test $next\n"; $bad = $bad + 1; $_ = $test; if (/^base/) { @@ -113,6 +113,7 @@ while ($test = shift) { if ($bad == 0) { if ($ok) { print "All tests successful.\n"; + # XXX add mention of 'perlbug -ok' ? } else { die "FAILED--no tests were run for some reason.\n"; } diff --git a/t/lib/filehand.t b/t/lib/filehand.t index c23a7e0..cedc2eb 100755 --- a/t/lib/filehand.t +++ b/t/lib/filehand.t @@ -43,7 +43,7 @@ print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer); print "ok 5\n"; $fh->seek(0,0); -print "not " unless (<$fh> eq $buffer); +print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer); print "ok 6\n"; $fh->seek(0,2); diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t index 2d5e897..37660c2 100755 --- a/t/lib/gdbm.t +++ b/t/lib/gdbm.t @@ -201,6 +201,6 @@ EOM main::ok(19, $@ eq "") ; main::ok(20, $ret eq "[[5]]") ; - unlink "SubDB.pm", "dbhash.tmp" ; + unlink "SubDB.pm", ; } diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index 5fed98d..27f3ec5 100755 --- a/t/lib/ndbm.t +++ b/t/lib/ndbm.t @@ -200,6 +200,6 @@ EOM main::ok(17, $@ eq "") ; main::ok(18, $ret eq "[[5]]") ; - unlink "SubDB.pm", "dbhash.tmp" ; + unlink "SubDB.pm", ; } diff --git a/t/lib/odbm.t b/t/lib/odbm.t index a7a4e69..6cfefda 100755 --- a/t/lib/odbm.t +++ b/t/lib/odbm.t @@ -200,6 +200,6 @@ EOM main::ok(17, $@ eq "") ; main::ok(18, $ret eq "[[5]]") ; - unlink "SubDB.pm", "dbhash.tmp" ; + unlink "SubDB.pm", ; } diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t index 576d0fe..c8ae092 100755 --- a/t/lib/sdbm.t +++ b/t/lib/sdbm.t @@ -200,6 +200,6 @@ EOM main::ok(17, $@ eq "") ; main::ok(18, $ret eq "[[5]]") ; - unlink "SubDB.pm", "dbhash.tmp" ; + unlink "SubDB.pm", ; } diff --git a/t/op/pack.t b/t/op/pack.t index 223b9d1..f9a89a3 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..25\n"; +print "1..29\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 @@ -76,3 +76,27 @@ print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++; eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff}; print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++; +# +# test the "p" template + +# literals +print((unpack("p",pack("p","foo")) eq "foo" ? "ok " : "not ok "),$test++,"\n"); + +# scalars +print((unpack("p",pack("p",$test)) == $test ? "ok " : "not ok "),$test++,"\n"); + +# temps +sub foo { my $a = "a"; return $a . $a++ . $a++ } +{ + local $^W = 1; + my $last = $test; + local $SIG{__WARN__} = sub { + print "ok ",$test++,"\n" if $_[0] =~ /temporary val/ + }; + my $junk = pack("p", &foo); + print "not ok ", $test++, "\n" if $last == $test; +} + +# undef should give null pointer +print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n"); + diff --git a/t/op/re_tests b/t/op/re_tests index 1f035c7..ce4c5a5 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -304,4 +304,5 @@ a(?:b|(c|e){1,2}?|d)+?(.) ace y $1$2 ce '([a-z]+)\s\1'i Aa aa y $&-$1 Aa aa-Aa '([a-z]+)\s\1'i Ab ab y $&-$1 Ab ab-Ab foo\w*\d{4}baz foobar1234baz y $& foobar1234baz +((foo)|(bar))* foobar y $1-$2-$3 bar-foo-bar :(?: - c - Sequence (? incomplete diff --git a/t/op/substr.t b/t/op/substr.t index e34216f..bb655f5 100755 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -2,25 +2,40 @@ # $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $ -print "1..25\n"; +print "1..97\n"; + +#P = start of string Q = start of substr R = end of substr S = end of string $a = 'abcdefxyz'; +BEGIN { $^W = 1 }; + +$SIG{__WARN__} = sub { + if ($_[0] =~ /^substr outside of string/) { + $w++; + } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) { + $w += 2; + } else { + warn @_; + } +}; -print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n"); -print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n"); -print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); -print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n"); -print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); -print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); +sub fail { !defined(shift) && $w-- }; + +print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n"); # P=Q R S +print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n"); # P Q R S +print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R +print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n"); # P R Q S +print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); # P=Q R S +print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); # P Q R S $[ = 1; -print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n"); -print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n"); -print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); -print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n"); -print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n"); -print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); +print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n"); # P=Q R S +print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n"); # P Q R S +print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R +print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S +print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S +print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); # P Q R S $[ = 0; @@ -28,7 +43,6 @@ substr($a,3,3) = 'XYZ'; print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n"; substr($a,0,2) = ''; print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n"; -y/a/a/; substr($a,0,0) = 'ab'; print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n"; substr($a,0,0) = '12345678'; @@ -42,9 +56,103 @@ print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n"; $a = 'abcdefxyz'; -print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n"); -print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n"); -print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n"); +print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n"); # P Q R=S +print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n"); # P Q R=S +print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n"); # P R=S Q +print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S +print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n"); # P Q=R=S +print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S +print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n"); # P=Q R=S + +$a = '54321'; + +print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n"); # Q R P S +print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n"); # Q R P S +print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n"); # R P=Q S +print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n"); # R P Q S +print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n"); # R P Q S +print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n"); # P=R Q S +print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n"); # P=R Q S +print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n"); # P R Q S +print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n"); # P R Q S +print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n"); # R P Q=S +print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n"); # P=R Q S +print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n"); # P R Q=S +print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n"); # R P S Q +print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n"); # P=R S Q +print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n"); # P R S Q +print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n"); # P S Q=R + +print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n"); # Q P=R S +print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S +print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S +print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R +print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n"); # P=Q=R S +print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S +print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S +print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R +print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n"); # P Q=R S +print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S +print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R +print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n"); # P=Q=R S +print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n"); # P Q=R S +print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n"); # P=Q=R S +print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S +print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R +print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n"); # P Q=R S +print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S +print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n"); # P Q=R=S +print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n"); # P Q=S R +print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n"); # Q P=R S +print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S +print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n"); # P=Q=R S +print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S +print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n"); # P Q=R S +print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S + +$a = ''; + +print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n"); # Q P=R=S +print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n"); # P=Q=R=S +print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n"); # P=Q=S R +print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n"); # Q P=S R +print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n"); # Q P=R=S +print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n"); # P=Q=R=S + + +print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n"); # R P=Q=S +print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n"); # Q=R P=S +print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n"); # Q R P=S +print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n"); # Q R P=S +print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n"); # Q=R P=S +print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n"); # R P=S Q +print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n"); # P=S Q R +print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n"); # P=S Q=R +print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n"); # P=R=S Q + + +my $a = 'zxcvbnm'; +substr($a,2,0) = ''; +print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n"; +substr($a,7,0) = ''; +print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n"; +substr($a,5,0) = ''; +print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n"; +substr($a,0,2) = 'pq'; +print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n"; +substr($a,2,0) = 'r'; +print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n"; +substr($a,8,0) = 'asd'; +print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n"; +substr($a,0,2) = 'iop'; +print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n"; +substr($a,0,5) = 'fgh'; +print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n"; +substr($a,3,5) = 'jkl'; +print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n"; +substr($a,3,2) = '1234'; +print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n"; + # with lexicals (and in re-entered scopes) for (0,1) { @@ -52,17 +160,21 @@ for (0,1) { unless ($_) { $txt = "Foo"; substr($txt, -1) = "X"; - print $txt eq "FoX" ? "ok 23\n" : "not ok 23\n"; + print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n"; } else { + local $^W = 0; # because of (spurious?) "uninitialised value" substr($txt, 0, 1) = "X"; - print $txt eq "X" ? "ok 24\n" : "not ok 24\n"; + print $txt eq "X" ? "ok 95\n" : "not ok 95\n"; } } -# coersion of references +# coercion of references { my $s = []; substr($s, 0, 1) = 'Foo'; - print substr($s,0,7) eq "FooRRAY" ? "ok 25\n" : "not ok 25\n"; + print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n"; } + +# check no spurious warnings +print $w ? "not ok 97\n" : "ok 97\n"; diff --git a/t/op/universal.t b/t/op/universal.t index a68e2b4..bd6c73a 100755 --- a/t/op/universal.t +++ b/t/op/universal.t @@ -8,7 +8,7 @@ BEGIN { @INC = '../lib' if -d '../lib'; } -print "1..70\n"; +print "1..72\n"; $a = {}; bless $a, "Bob"; @@ -65,6 +65,7 @@ test ! UNIVERSAL::can(23, "can"); test $a->can("VERSION"); test $a->can("can"); +test ! $a->can("export_tags"); # a method in Exporter test (eval { $a->VERSION }) == 2.718; @@ -78,14 +79,18 @@ test $subs eq "VERSION can isa"; test $a->isa("UNIVERSAL"); +# now use UNIVERSAL.pm and see what changes eval "use UNIVERSAL"; test $a->isa("UNIVERSAL"); my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; +# XXX import being here is really a bug test $sub2 eq "VERSION can import isa"; eval 'sub UNIVERSAL::sleep {}'; test $a->can("sleep"); test ! UNIVERSAL::can($b, "can"); + +test ! $a->can("export_tags"); # a method in Exporter diff --git a/toke.c b/toke.c index 9221bf1..819e0b6 100644 --- a/toke.c +++ b/toke.c @@ -392,7 +392,7 @@ register char *s; bufend = s + SvCUR(linestr); s = bufptr; incline(s); - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV *sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); @@ -1526,7 +1526,7 @@ yylex() sv_catpv(linestr, "\n"); oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); bufend = SvPVX(linestr) + SvCUR(linestr); - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV *sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); @@ -1574,7 +1574,7 @@ yylex() incline(s); } while (doextract); oldoldbufptr = oldbufptr = bufptr = linestart = s; - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV *sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); @@ -1699,7 +1699,7 @@ yylex() } d = moreswitches(d); } while (d); - if (perldb && !oldpdb || + if (PERLDB_LINE && !oldpdb || ( minus_n || minus_p ) && !(oldn || oldp) ) /* if we have already added "LINE: while (<>) {", we must not do it again */ @@ -1708,7 +1708,7 @@ yylex() oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); bufend = SvPVX(linestr) + SvCUR(linestr); preambled = FALSE; - if (perldb) + if (PERLDB_LINE) (void)gv_fetchfile(origfilename); goto retry; } @@ -2316,8 +2316,23 @@ yylex() else if (isIDFIRST(*s)) { char tmpbuf[sizeof tokenbuf]; scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); - if (keyword(tmpbuf, len)) - expect = XTERM; /* e.g. print $fh length() */ + if (tmp = keyword(tmpbuf, len)) { + /* binary operators exclude handle interpretations */ + switch (tmp) { + case -KEY_x: + case -KEY_eq: + case -KEY_ne: + case -KEY_gt: + case -KEY_lt: + case -KEY_ge: + case -KEY_le: + case -KEY_cmp: + break; + default: + expect = XTERM; /* e.g. print $fh length() */ + break; + } + } else { GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV); if (gv && GvCVu(gv)) @@ -4515,7 +4530,7 @@ I32 ck_uni; lex_state = LEX_INTERPEND; if (funny == '#') funny = '@'; - if (dowarn && + if (dowarn && lex_state == LEX_NORMAL && (keyword(dest, d - dest) || perl_get_cv(dest, FALSE))) warn("Ambiguous use of %c{%s} resolved to %c%s", funny, dest, funny, dest); @@ -4831,7 +4846,7 @@ register char *s; missingterm(tokenbuf); } curcop->cop_line++; - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV *sv = NEWSV(88,0); sv_upgrade(sv, SVt_PVMG); @@ -4931,8 +4946,13 @@ char *start; register char *to; I32 brackets = 1; - if (isSPACE(*s)) - s = skipspace(s); + if (isSPACE(*s)) { + /* "#" is allowed as delimiter if on same line */ + while (*s == ' ' || *s == '\t') + s++; + if (isSPACE(*s)) + s = skipspace(s); + } CLINE; term = *s; multi_start = curcop->cop_line; @@ -4953,8 +4973,8 @@ char *start; for (; s < bufend; s++,to++) { if (*s == '\n' && !rsfp) curcop->cop_line++; - if (*s == '\\' && s+1 < bufend) { - if ((s[1] == multi_open) || (s[1] == term)) + if (*s == '\\' && s+1 < bufend && term != '\\') { + if (s[1] == term) s++; else *to++ = *s++; @@ -4993,7 +5013,7 @@ char *start; return Nullch; } curcop->cop_line++; - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV *sv = NEWSV(88,0); sv_upgrade(sv, SVt_PVMG); diff --git a/util.c b/util.c index fc5cd5d..2f222fa 100644 --- a/util.c +++ b/util.c @@ -279,9 +279,7 @@ xstat() #endif /* LEAKTEST */ -/* copy a string up to some (non-backslashed) delimiter, if any; - If the delimiter is ';', then do not consider backslashes - - used only for PATH on DOSISH systems. */ +/* copy a string up to some (non-backslashed) delimiter, if any */ char * delimcpy(to, toend, from, fromend, delim, retlen) @@ -294,7 +292,7 @@ I32 *retlen; { register I32 tolen; for (tolen = 0; from < fromend; from++, tolen++) { - if (*from == '\\' && delim != ';') { + if (*from == '\\') { if (from[1] == delim) from++; else { diff --git a/utils/Makefile b/utils/Makefile index 9dd2464..3c343c8 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -12,19 +12,19 @@ all: $(plextract) $(plextract): $(PERL) -I../lib $@.PL -c2ph: c2ph.PL +c2ph: c2ph.PL ../config.sh -h2ph: h2ph.PL +h2ph: h2ph.PL ../config.sh -h2xs: h2xs.PL +h2xs: h2xs.PL ../config.sh -perlbug: perlbug.PL +perlbug: perlbug.PL ../config.sh ../patchlevel.h -perldoc: perldoc.PL +perldoc: perldoc.PL ../config.sh -pl2pm: pl2pm.PL +pl2pm: pl2pm.PL ../config.sh -splain: splain.PL ../lib/diagnostics.pm +splain: splain.PL ../config.sh ../lib/diagnostics.pm clean: diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 2b11012..43b6bfc 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -9,6 +9,7 @@ use File::Basename qw(&basename &dirname); # %Config entries. Thus you write # $startperl # to ensure Configure will look for $Config{startperl}. +# $perlpath # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. @@ -18,6 +19,29 @@ $file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; +# extract patchlevel.h information + +open PATCH_LEVEL, "<../patchlevel.h" or die "Can't open patchlevel.h: $!"; + +my $patchlevel_date = (stat PATCH_LEVEL)[9]; + +while () { + last if index($_, "static\tchar\t*local_patches[] = {") >= 0; +}; + +my $patches; +while () { + last if /^}/; + chomp; + s/^\s+,?"?//; + s/"?,?$//; + s/(['\\])/\\$1/g; + $patches .= "'$_',\n" unless $_ eq 'NULL'; +}; + +close PATCH_LEVEL; + + print "Extracting $file (with variable substitutions)\n"; # In this section, perl variables will be expanded during extraction. @@ -27,6 +51,9 @@ print OUT <<"!GROK!THIS!"; $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' if \$running_under_some_shell; + +my \$patchlevel_date = $patchlevel_date; +my \@patches = ( $patches ); !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -49,7 +76,7 @@ use strict; sub paraprint; -my($Version) = "1.18"; +my($Version) = "1.19"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -70,6 +97,9 @@ my($Version) = "1.18"; # Changed in 1.16 to include @INC, and allow user to re-edit if no changes. # Changed in 1.17 Win32 support added. GSAR 97-04-12 # Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18 +# Changed in 1.19 '-ok' default not '-v' +# add local patch information +# warn on '-ok' if this is an old system; add '-okay' # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -153,15 +183,25 @@ sub Init { # OK - send "OK" report for build on this system $ok = 0; if ( $::opt_o ) { - if ( $::opt_o eq 'k' ) { + if ( $::opt_o eq 'k' or $::opt_o eq 'kay' ) { + my $age = time - $patchlevel_date; + if ( $::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) { + my $date = localtime $patchlevel_date; + print <<"EOF"; +\"perlbug -ok\" does not report on Perl versions which are more than +60 days old. This Perl version was constructed on $date. +If you really want to report this, use \"perlbug -okay\". +EOF + exit(); + }; # force these options $::opt_S = 1; # don't prompt for send $::opt_C = 1; # don't send a copy to the local admin - $::opt_v = 1; $verbose = 1; - $::opt_s = 1; $subject = "OK: perl $] on " - . $::Config{'osname'} . ' ' - . $::Config{'osvers'}; - $::opt_b = 1; $body = "Perl reported to build OK on this system\n"; + $::opt_s = 1; + $subject = "OK: perl $] on" + ." $::Config{'osname'} $::Config{'osvers'} $subject"; + $::opt_b = 1; + $body = "Perl reported to build OK on this system.\n"; $ok = 1; } else { @@ -390,7 +430,7 @@ EOF { my($dir) = ($Is_VMS ? 'sys$scratch:' : - ($Is_MSWin32 && $ENV{'TEMP'} ? $ENV{'TEMP'} : '/tmp/')); + (($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'} : '/tmp/')); $filename = "bugrep0$$"; $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|; $filename++ while -e "$dir$filename"; @@ -441,8 +481,10 @@ EOF open(REP,">$filename"); + my $reptype = $ok ? "success" : "bug"; + print REP < I | B<-f> I ]> S<[ B<-r> I ]> S<[ B<-e> I ]> S<[ B<-c> I | B<-C> ]> S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]> -B S<[ B<-r> I ]> B<-ok> +B S<[ B<-v> ]> S<[ B<-r> I ]> S<[ B<-ok> | B ]> =head1 DESCRIPTION @@ -966,8 +1015,8 @@ produced by running C (note the uppercase V). Having done your bit, please be prepared to wait, to be told the bug is in your code, or even to get no reply at all. The perl maintainers -are busy folks, so if your problem is a small one or if it is -difficult to understand, they may not respond with a personal reply. +are busy folks, so if your problem is a small one or if it is difficult +to understand or already known, they may not respond with a personal reply. If it is important to you that your bug be fixed, do monitor the C file in any development releases since the time you submitted the bug, and encourage the maintainers with kind words (but never any @@ -1017,10 +1066,16 @@ Prints a brief summary of the options. =item B<-ok> -Report successful build on this system to perl porters. Forces B<-S>, -B<-C>, and B<-v>. Forces and supplies values for B<-s> and B<-b>. Only +Report successful build on this system to perl porters. Forces B<-S> +and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only prompts for a return address if it cannot guess it (for use with -B). Honors return address specified with B<-r>. +B). Honors return address specified with B<-r>. You can use this +with B<-v> to get more complete data. Only makes a report if this +system is less than 60 days old. + +=item B<-okay> + +As B<-ok> except it will report on older systems. =item B<-r> @@ -1051,7 +1106,8 @@ Include verbose configuration data in the report. Kenneth Albanowski (Ekjahds@kjahds.comE), subsequently Itored by Gurusamy Sarathy (Egsar@umich.eduE), Tom Christiansen (Etchrist@perl.comE), Nathan Torkington (Egnat@frii.comE), -and Charles F. Randall (Ecfr@pobox.comE). +Charles F. Randall (Ecfr@pobox.comE) and +Mike Guy (Emjtg@cam.a.ukE). =head1 SEE ALSO diff --git a/utils/perldoc.PL b/utils/perldoc.PL index a17cca9..38ea9ee 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -134,21 +134,16 @@ sub containspod { return 0; } - sub minus_f_nocase { +sub minus_f_nocase { my($file) = @_; + # on a case-forgiving file system we can simply use -f $file + if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') { + return ( -f $file ) ? $file : ''; + } local *DIR; local($")="/"; my(@p,$p,$cip); - $file =~ tr|\\|/| if $Is_MSWin32 or $^O eq 'os2'; - if ( $Is_MSWin32 and $file =~ s|^(//[^/]+)/|| ) { # UNC path? - push(@p,$1); - } foreach $p (split(/\//, $file)){ - if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) { - # VMSish filesystems don't begin at '/' - push(@p,$p); - next; - } if (-d ("@p/$p")){ push @p, $p; } elsif (-f ("@p/$p")) { @@ -158,7 +153,6 @@ sub containspod { my $lcp = lc $p; opendir DIR, "@p"; while ($cip=readdir(DIR)) { - $cip =~ s/\.dir$// if $Is_VMS; if (lc $cip eq $lcp){ $found++; last; diff --git a/vms/config.vms b/vms/config.vms index cba3361..d6453ba 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -112,7 +112,11 @@ * This symbol is defined if the bcmp() routine is available to * compare blocks of memory. */ -#undef HAS_BCMP /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_BCMP /**/ +#else +#undef HAS_BCMP /*config-skip*/ +#endif #include /* Check whether new DECC has #defined bcopy and bzero */ /* HAS_BCOPY: @@ -233,7 +237,11 @@ * needs to be included (see I_SYS_RESOURCE). * The type "Timeval" should be used to refer to "struct timeval". */ -#undef HAS_GETTIMEOFDAY /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_GETTIMEOFDAY /**/ +#else +#undef HAS_GETTIMEOFDAY /*config-skip*/ +#endif #ifdef HAS_GETTIMEOFDAY # define Timeval struct timeval /*config-skip*/ #endif @@ -256,7 +264,11 @@ * uname() routine to derive the host name. See also HAS_GETHOSTNAME * and PHOSTNAME. */ -#undef HAS_UNAME /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_UNAME /**/ +#else +#undef HAS_UNAME /*config-skip*/ +#endif /* HAS_GETPRIORITY: * This symbol, if defined, indicates that the getpriority routine is @@ -492,7 +504,11 @@ * This symbol, if defined, indicates that Vr4's sigaction() routine * is available. */ -#undef HAS_SIGACTION /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_SIGACTION /**/ +#else +#undef HAS_SIGACTION /*config-skip*/ +#endif /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring @@ -622,7 +638,11 @@ * This symbol, if defined, indicates that the truncate routine is * available to truncate files. */ -#undef HAS_TRUNCATE /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_TRUNCATE /**/ +#else +#undef HAS_TRUNCATE /*config-skip*/ +#endif /* HAS_VFORK: @@ -664,7 +684,11 @@ /* HAS_WAIT4: * This symbol, if defined, indicates that wait4() exists. */ -#undef HAS_WAIT4 /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_WAIT4 /**/ +#else +#undef HAS_WAIT4 /*config-skip*/ +#endif /* HAS_WAITPID: * This symbol, if defined, indicates that the waitpid routine is @@ -962,10 +986,10 @@ * is defined, and 'int *' otherwise. This is only useful if you * have select(), of course. */ -#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) -#define Select_fd_set_t fd_set * /* config-skip */ +#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) && defined(DECCRTL_SOCKETS) +#define Select_fd_set_t fd_set * /**/ #else -#define Select_fd_set_t int * /**/ +#define Select_fd_set_t int * /* config-skip */ #endif /* STDCHAR: @@ -1161,7 +1185,11 @@ * functions are available for string searching. */ #define HAS_STRCHR /**/ -#undef HAS_INDEX /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_INDEX /**/ +#else +#undef HAS_INDEX /*config-skip*/ +#endif /* HAS_STRCOLL: * This symbol, if defined, indicates that the strcoll routine is @@ -1347,9 +1375,17 @@ * corresponds to the 0 at the end of the sig_num list. * See SIG_NUM and SIG_MAX. */ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\ + "KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM",\ + "ABRT","USR1","USR2","SPARE18","SPARE19","CHLD","CONT",\ + "STOP","TSTP","TTIN","TTOU","DEBUG","SPARE27","SPARE28",\ + "SPARE29","SPARE30","SPARE31","SPARE32","RTMIN","RTMAX",0 /**/ +#else #define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\ "KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM",\ - "ABRT","USR1","USR2",0 + "ABRT","USR1","USR2",0 /*config-skip*/ +#endif /* SIG_NUM: * This symbol contains a list of signal number, in the same order as the @@ -1364,7 +1400,11 @@ * The last element is 0, corresponding to the 0 at the end of * the sig_name list. */ -#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0 /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,64,0 /**/ +#else +#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0 /*config-skip*/ +#endif /* Mode_t: * This symbol holds the type used to declare file modes @@ -1598,8 +1638,13 @@ * to determine file-system related limits and options associated * with a given open file descriptor. */ -#undef HAS_PATHCONF /**/ -#undef HAS_FPATHCONF /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_PATHCONF /**/ +#define HAS_FPATHCONF /**/ +#else +#undef HAS_PATHCONF /*config-skip*/ +#undef HAS_FPATHCONF /*config-skip*/ +#endif /* HAS_SAFE_BCOPY: * This symbol, if defined, indicates that the bcopy routine is available @@ -1658,7 +1703,11 @@ * This symbol, if defined, indicates that sysconf() is available * to determine system related limits and options. */ -#undef HAS_SYSCONF /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_SYSCONF /**/ +#else +#undef HAS_SYSCONF /*config-skip*/ +#endif /* Gconvert: * This preprocessor macro is defined to convert a floating point @@ -1718,7 +1767,11 @@ * This macro is used in the same way as siglongjmp(), but will invoke * traditional longjmp() if siglongjmp isn't available. */ -#undef HAS_SIGSETJMP /**/ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#define HAS_SIGSETJMP /**/ +#else +#undef HAS_SIGSETJMP /*config-skip*/ +#endif #ifdef HAS_SIGSETJMP #define Sigjmp_buf sigjmp_buf /* config-skip */ #define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask) /* config-skip */ diff --git a/vms/descrip.mms b/vms/descrip.mms index 6c65317..7681f21 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -167,7 +167,7 @@ DBGLINKFLAGS = /Trace/Debug/Map/Full/Cross DBG = DBG .else DBGCCFLAGS = /NoList -DBGLINKFLAGS = /NoMap +DBGLINKFLAGS = /NoTrace/NoMap DBG = .endif @@ -365,7 +365,7 @@ $(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) .endif $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts - Link /NoTrace$(LINKFLAGS)/Share=$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option + Link $(LINKFLAGS)/Share=$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option # The following files are built in one go by gen_shrfls.pl: # perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 62b06fe..6201a42 100755 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t @@ -25,11 +25,33 @@ foreach $test (@tests) { } } -print +(rmsexpand('[]') eq "\U$ENV{DEFAULT}" ? 'ok ' : 'not ok '),++$idx,"\n"; -print +(rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here" ? - 'ok ' : 'not ok '),++$idx,"\n"; -print +(rmsexpand('from.here','cant:[get.there];2') eq - 'cant:[get.there]from.here;2' ? 'ok ' : 'not ok '),++$idx,"\n"; +if (rmsexpand('[]') eq "\U$ENV{DEFAULT}") { print 'ok ',++$idx,"\n"; } +else { + print 'not ok ', ++$idx, ": rmsexpand('[]') = |", rmsexpand('[]'), + "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n"; + print "# Note: This failure may have occurred because your default device\n"; + print "# was set using a non-concealed logical name. If this is the case,\n"; + print "# you will need to determine by inspection that the two resultant\n"; + print "# file specifications shwn above are in fact equivalent.\n"; +} +if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") { + print 'ok ', ++$idx, "\n"; +} +else { + print 'not ok ', ++$idx, ": rmsexpand('from.here') = |", + rmsexpand('from.here'), + "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n"; + print "# Note: This failure may have occurred because your default device\n"; + print "# was set using a non-concealed logical name. If this is the case,\n"; + print "# you will need to determine by inspection that the two resultant\n"; + print "# file specifications shwn above are in fact equivalent.\n"; +} +if (rmsexpand('from.here','cant:[get.there];2') eq + 'cant:[get.there]from.here;2') { print 'ok ',++$idx,"\n"; } +else { + print 'not ok ', ++$idx, ': expected |cant:[get.there]from.here;2|, got |', + rmsexpand('from.here','cant:[get.there];2'),"|\n"; +} __DATA__ diff --git a/vms/sockadapt.c b/vms/sockadapt.c index e4c3dad..b63e4c9 100644 --- a/vms/sockadapt.c +++ b/vms/sockadapt.c @@ -29,18 +29,25 @@ # define __sockadapt_my_name_t char * #endif +/* We have these on VMS 7.0 and above, or on Dec C 5.6 if it's providing */ +/* the 7.0 DECC RTL */ +#if ((((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)) && defined(DECCRTL_SOCKETS)) +#else void setnetent(int stayopen) { croak("Function \"setnetent\" not implemented in this version of perl"); } void endnetent() { croak("Function \"endnetent\" not implemented in this version of perl"); } +#endif #if defined(DECCRTL_SOCKETS) /* Use builtin socket interface in DECCRTL and * UCX emulation in whatever TCP/IP stack is present. */ +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#else void sethostent(int stayopen) { croak("Function \"sethostent\" not implemented in this version of perl"); } @@ -67,6 +74,7 @@ void endnetent() { croak("Function \"getservent\" not implemented in this version of perl"); return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ } +#endif #else /* Work around things missing/broken in SOCKETSHR. */ diff --git a/vms/sockadapt.h b/vms/sockadapt.h index f24faea..7f9150a 100644 --- a/vms/sockadapt.h +++ b/vms/sockadapt.h @@ -24,6 +24,8 @@ # include # include # include +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +#else void sethostent(int); void endhostent(void); void setnetent(int); @@ -32,6 +34,7 @@ void endprotoent(void); void setservent(int); void endservent(void); +#endif # if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) # define Sock_size_t unsigned int # endif diff --git a/vms/test.com b/vms/test.com index 50a98ca..114cb24 100644 --- a/vms/test.com +++ b/vms/test.com @@ -6,6 +6,7 @@ $ $! A little basic setup $ On Error Then Goto wrapup $ olddef = F$Environment("Default") +$ oldmsg = F$Environment("Message") $ If F$Search("t.dir").nes."" $ Then $ Set Default [.t] @@ -18,6 +19,7 @@ $ Write Sys$Error "Can't find test directory" $ Exit 44 $ EndIf $ EndIf +$ Set Message /Facility/Severity/Identification/Text $ $ exe = ".Exe" $ If p1.nes."" Then exe = p1 @@ -87,12 +89,12 @@ $ Deck/Dollar=$$END-OF-TEST$$ # but the tests may use other operators which don't.) use Config; -@compexcl=('cpp.t','script.t'); +@compexcl=('cpp.t'); @ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t'); @libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t', 'gdbm.t','io_dup.t', 'io_pipe.t', 'io_sel.t', 'io_sock.t', 'ndbm.t','odbm.t','open2.t','open3.t','posix.t', - 'sdbm.t','soundex.t'); + 'sdbm.t'); # Note: POSIX is not part of basic build, but can be built # separately if you're using DECC @@ -218,4 +220,5 @@ $$END-OF-TEST$$ $ wrapup: $ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* $ Set Default &olddef +$ Set Message 'oldmsg' $ Exit diff --git a/vms/vms.c b/vms/vms.c index 6ff1110..32f734b 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -456,9 +456,9 @@ kill_file(char *name) /*}}}*/ -/*{{{int my_mkdir(char *,mode_t)*/ +/*{{{int my_mkdir(char *,Mode_t)*/ int -my_mkdir(char *dir, mode_t mode) +my_mkdir(char *dir, Mode_t mode) { STRLEN dirlen = strlen(dir); @@ -1759,7 +1759,7 @@ static int background_process(int argc, char **argv); static void pipe_and_fork(char **cmargv); /*{{{ void getredirection(int *ac, char ***av)*/ -void +static void getredirection(int *ac, char ***av) /* * Process vms redirection arg's. Exit if any error is seen. @@ -2221,6 +2221,34 @@ unsigned long int flags = 17, one = 1, retsts; /*}}}*/ /***** End of code taken from Mark Pizzolato's argproc.c package *****/ + +/* OS-specific initialization at image activation (not thread startup) */ +/*{{{void vms_image_init(int *, char ***)*/ +void +vms_image_init(int *argcp, char ***argvp) +{ + unsigned long int *mask, iosb[2], i; + unsigned short int dummy; + union prvdef iprv; + struct itmlst_3 jpilist[2] = { {sizeof iprv, JPI$_IMAGPRIV, &iprv, &dummy}, + { 0, 0, 0, 0} }; + + _ckvmssts(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL)); + _ckvmssts(iosb[0]); + mask = (unsigned long int *) &iprv; /* Quick change of view */; + for (i = 0; i < (sizeof iprv + sizeof(unsigned long int) - 1) / sizeof(unsigned long int); i++) { + if (mask[i]) { /* Running image installed with privs? */ + _ckvmssts(sys$setprv(0,&iprv,0,NULL)); /* Turn 'em off. */ + tainting = TRUE; + break; + } + } + getredirection(argcp,argvp); + return; +} +/*}}}*/ + + /* trim_unixpath() * Trim Unix-style prefix off filespec, so it looks like what a shell * glob expansion would return (i.e. from specified prefix on, not diff --git a/vms/vmsish.h b/vms/vmsish.h index 841b119..81e3764 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -104,14 +104,13 @@ # define tounixpath_ts Perl_tounixpath_ts # define tovmspath Perl_tovmspath # define tovmspath_ts Perl_tovmspath_ts -# define getredirection Perl_getredirection +# define vms_image_init Perl_vms_image_init # define opendir Perl_opendir # define readdir Perl_readdir # define telldir Perl_telldir # define seekdir Perl_seekdir # define closedir Perl_closedir # define vmsreaddirversions Perl_vmsreaddirversions -# define getredirection Perl_getredirection # define my_gmtime Perl_my_gmtime # define my_localtime Perl_my_localtime # define my_time Perl_my_time @@ -226,7 +225,7 @@ #endif #define BIT_BUCKET "_NLA0:" -#define PERL_SYS_INIT(c,v) getredirection((c),(v)) +#define PERL_SYS_INIT(c,v) vms_image_init((c),(v)) #define PERL_SYS_TERM() #define dXSUB_SYS #define HAS_KILL @@ -500,7 +499,6 @@ typedef unsigned myino_t; #endif void prime_env_iter _((void)); -void getredirection _((int *, char ***)); void init_os_extras _(()); /* prototype section start marker; `typedef' passes through cpp */ typedef char __VMS_PROTOTYPES__; @@ -511,7 +509,7 @@ Pid_t my_waitpid _((Pid_t, int *, int)); char * my_gconvert _((double, int, int, char *)); int do_rmdir _((char *)); int kill_file _((char *)); -int my_mkdir _((char *, mode_t)); +int my_mkdir _((char *, Mode_t)); int my_utime _((char *, struct utimbuf *)); char * rmsexpand _((char *, char *, char *, unsigned)); char * rmsexpand_ts _((char *, char *, char *, unsigned)); @@ -527,7 +525,7 @@ char * tounixpath _((char *, char *)); char * tounixpath_ts _((char *, char *)); char * tovmspath _((char *, char *)); char * tovmspath_ts _((char *, char *)); -void getredirection _(()); +void vms_image_init _((int *, char ***)); DIR * opendir _((char *)); struct dirent * readdir _((DIR *)); long telldir _((DIR *)); diff --git a/win32/Makefile b/win32/Makefile index bc5ec50..880cb88 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -403,6 +403,11 @@ $(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) cd ..\..\win32 doc: $(PERLEXE) + cd ..\pod + $(MAKE) -f ..\win32\pod.mak checkpods pod2html pod2latex \ + pod2man pod2text + $(XCOPY) *.bat ..\win32\bin\*.* + cd ..\win32 copy ..\README.win32 ..\pod\perlwin32.pod $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \ --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML::=|)" \ diff --git a/win32/bin/pl2bat.bat b/win32/bin/pl2bat.bat index 7345653..0b7bf32 100644 --- a/win32/bin/pl2bat.bat +++ b/win32/bin/pl2bat.bat @@ -50,4 +50,54 @@ sub process { } } __END__ + +=head1 NAME + +pl2bat.bat - a batch file to wrap perl code into a batch file + +=head1 SYNOPSIS + + C:\> pl2bat foo.pl bar + [..creates foo.bat, bar.bat..] + + C:\> pl2bat < somefile > another.bat + + C:\> pl2bat > another.bat + print scalar reverse "rekcah lrep rehtona tsuj\n"; + ^Z + [..another.bat is now a certified japh application..] + +=head1 DESCRIPTION + +This utility converts a perl script into a batch file that can be +executed on DOS-like operating systems. + +Note that the ".pl" suffix will be stripped before adding a +".bat" suffix to the supplied file names. + +The batch file created makes use of the C<%*> construct to refer +to all the command line arguments that were given to the batch file, +so you'll need to make sure that works on your variant of the +command shell. It is known to work in the cmd.exe shell under +WindowsNT. 4DOS/NT users will want to put a C +line in their initialization file, or execute C in +the shell startup file. + +=head1 BUGS + +C<$0> will contain the full name, including the ".bat" suffix. +If you don't like this, see runperl.bat for an alternative way to +invoke perl scripts. + +Perl is invoked with the -S flag, so it will search the PATH to find +the script. This may have undesirable effects. + +=head1 SEE ALSO + +perl, perlwin32, runperl.bat + +=cut + +__END__ :endofperl + diff --git a/win32/bin/runperl.bat b/win32/bin/runperl.bat index 84f758d..cca69e8 100644 --- a/win32/bin/runperl.bat +++ b/win32/bin/runperl.bat @@ -17,4 +17,60 @@ unless (-f $0) { doit: exec "perl", "-x", $0, @ARGV; die "Failed to exec `$0': $!"; __END__ + +=head1 NAME + +runperl.bat - an "universal" batch file to run perl scripts + +=head1 SYNOPSIS + + C:\> copy runperl.bat foo.bat + C:\> foo + [..runs the perl script `foo'..] + + C:\> foo.bat + [..runs the perl script `foo'..] + + +=head1 DESCRIPTION + +This file can be copied to any file name ending in the ".bat" suffix. +When executed on a DOS-like operating system, it will invoke the perl +script of the same name, but without the ".bat" suffix. It will +look for the script in the same directory as itself, and then in +the current directory, and then search the directories in your PATH. + +It relies on the C operator, so you will need to make sure +that works in your perl. + +This method of invoking perl scripts has some advantages over +batch-file wrappers like C: it avoids duplication +of all the code; it ensures C<$0> contains the same name as the +executing file, without any egregious ".bat" suffix; it allows +you to separate your perl scripts from the wrapper used to +run them; since the wrapper is generic, you can use symbolic +links to simply link to C, if you are serving your +files on a filesystem that supports that. + +On the other hand, if the batch file is invoked with the ".bat" +suffix, it does an extra C. This may be a performance +issue. You can avoid this by running it without specifying +the ".bat" suffix. + +Perl is invoked with the -x flag, so the script must contain +a C<#!perl> line. Any flags found on that line will be honored. + +=head1 BUGS + +Perl is invoked with the -S flag, so it will search the PATH to find +the script. This may have undesirable effects. + +=head1 SEE ALSO + +perl, perlwin32, pl2bat.bat + +=cut + +__END__ :endofperl + diff --git a/win32/makedef.pl b/win32/makedef.pl index 038c150..b4883cc 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -12,7 +12,7 @@ # There is some symbol defined in global.sym and interp.sym # that does not present in the WIN32 port but there is no easy -# way to find them so I just put a exeception list here +# way to find them so I just put a exception list here my $CCTYPE = shift || "MSVC"; @@ -191,12 +191,17 @@ sub emit_symbol { chomp $symbol; if ($CCTYPE eq "BORLAND") { # workaround Borland quirk by exporting both the straight - # name and a name with leading underscore - #print "\t$symbol = _$symbol\n"; + # name and a name with leading underscore. Note the + # alias *must* come after the symbol itself, if both + # are to be exported. (Linker bug?) print "\t_$symbol\n"; + print "\t$symbol = _$symbol\n"; } else { + # for binary coexistence, export both the symbol and + # alias with leading underscore print "\t$symbol\n"; + print "\t_$symbol = $symbol\n"; } } @@ -319,5 +324,24 @@ win32_setnetent win32_setprotoent win32_setservent win32_getenv -win32_stdio +win32_perror +win32_setbuf +win32_setvbuf +win32_flushall +win32_fcloseall +win32_fgets +win32_gets +win32_fgetc +win32_putc +win32_puts +win32_getchar +win32_putchar +win32_malloc +win32_calloc +win32_realloc +win32_free +win32stdio Perl_win32_init +RunPerl +SetIOSubSystem +GetIOSubSystem diff --git a/win32/makefile.mk b/win32/makefile.mk index 5ee58bb..62b2b11 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -498,6 +498,9 @@ $(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) cd $(EXTDIR)\$(*B) && $(MAKE) doc: $(PERLEXE) + cd ..\pod && $(MAKE) -f ..\win32\pod.mak checkpods \ + pod2html pod2latex pod2man pod2text + cd ..\pod && $(XCOPY) *.bat ..\win32\bin\*.* copy ..\README.win32 ..\pod\perlwin32.pod $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \ --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML:s,:,|,)" \ diff --git a/win32/win32.c b/win32/win32.c index ceaca7e..f615bdc 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -60,7 +60,7 @@ IsWinNT(void) { return (IdOS() == VER_PLATFORM_WIN32_NT); } -void * +DllExport PWIN32_IOSUBSYSTEM SetIOSubSystem(void *p) { PWIN32_IOSUBSYSTEM old = pIOSubSystem; @@ -77,6 +77,12 @@ SetIOSubSystem(void *p) return old; } +DllExport PWIN32_IOSUBSYSTEM +GetIOSubSystem(void) +{ + return pIOSubSystem; +} + char * win32PerlLibPath(void) { @@ -1204,6 +1210,102 @@ win32_execvp(const char *cmdname, const char *const *argv) return pIOSubSystem->pfnexecvp(cmdname, argv); } +DllExport void +win32_perror(const char *str) +{ + pIOSubSystem->pfnperror(str); +} + +DllExport void +win32_setbuf(FILE *pf, char *buf) +{ + pIOSubSystem->pfnsetbuf(pf, buf); +} + +DllExport int +win32_setvbuf(FILE *pf, char *buf, int type, size_t size) +{ + return pIOSubSystem->pfnsetvbuf(pf, buf, type, size); +} + +DllExport int +win32_flushall(void) +{ + return pIOSubSystem->pfnflushall(); +} + +DllExport int +win32_fcloseall(void) +{ + return pIOSubSystem->pfnfcloseall(); +} + +DllExport char* +win32_fgets(char *s, int n, FILE *pf) +{ + return pIOSubSystem->pfnfgets(s, n, pf); +} + +DllExport char* +win32_gets(char *s) +{ + return pIOSubSystem->pfngets(s); +} + +DllExport int +win32_fgetc(FILE *pf) +{ + return pIOSubSystem->pfnfgetc(pf); +} + +DllExport int +win32_putc(int c, FILE *pf) +{ + return pIOSubSystem->pfnputc(c,pf); +} + +DllExport int +win32_puts(const char *s) +{ + return pIOSubSystem->pfnputs(s); +} + +DllExport int +win32_getchar(void) +{ + return pIOSubSystem->pfngetchar(); +} + +DllExport int +win32_putchar(int c) +{ + return pIOSubSystem->pfnputchar(c); +} + +DllExport void* +win32_malloc(size_t size) +{ + return pIOSubSystem->pfnmalloc(size); +} + +DllExport void* +win32_calloc(size_t numitems, size_t size) +{ + return pIOSubSystem->pfncalloc(numitems,size); +} + +DllExport void* +win32_realloc(void *block, size_t size) +{ + return pIOSubSystem->pfnrealloc(block,size); +} + +DllExport void +win32_free(void *block) +{ + pIOSubSystem->pfnfree(block); +} + int stolen_open_osfhandle(long handle, int flags) { diff --git a/win32/win32.h b/win32/win32.h index 8cf8b7c..dc069ba 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -31,6 +31,10 @@ #define _chdir chdir #include +#ifndef DllMain +#define DllMain DllEntryPoint +#endif + #pragma warn -ccc #pragma warn -rch #pragma warn -sig @@ -75,6 +79,8 @@ extern char *staticlinkmodules[]; EXT char *win32_getenv(const char *name); #endif +EXT void Perl_win32_init(int *argcp, char ***argvp); + #define USE_SOCKETS_AS_HANDLES #ifndef USE_SOCKETS_AS_HANDLES extern FILE *myfdopen(int, char *); diff --git a/win32/win32io.c b/win32/win32io.c index 96ceb3e..12bc645 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -293,11 +293,29 @@ WIN32_IOSUBSYSTEM win32stdio = { my_open_osfhandle, my_get_osfhandle, spawnvp, - _mkdir, - _rmdir, - _chdir, + mkdir, + rmdir, + chdir, my_flock, /* (*pfunc_flock)(int fd, int oper) */ execvp, + perror, + setbuf, + setvbuf, + flushall, + fcloseall, + fgets, + gets, + fgetc, + putc, + puts, + getchar, + putchar, + fscanf, + scanf, + malloc, + calloc, + realloc, + free, 87654321L, /* end of structure */ }; diff --git a/win32/win32io.h b/win32/win32io.h index 98ee874..ba4080c 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -61,6 +61,24 @@ int (*pfnrmdir)(const char *path); int (*pfnchdir)(const char *path); int (*pfnflock)(int fd, int oper); int (*pfnexecvp)(const char *cmdname, const char *const *argv); +void (*pfnperror)(const char *str); +void (*pfnsetbuf)(FILE *pf, char *buf); +int (*pfnsetvbuf)(FILE *pf, char *buf, int type, size_t size); +int (*pfnflushall)(void); +int (*pfnfcloseall)(void); +char* (*pfnfgets)(char *s, int n, FILE *pf); +char* (*pfngets)(char *s); +int (*pfnfgetc)(FILE *pf); +int (*pfnputc)(int c, FILE *pf); +int (*pfnputs)(const char *s); +int (*pfngetchar)(void); +int (*pfnputchar)(int c); +int (*pfnfscanf)(FILE *pf, const char *format, ...); +int (*pfnscanf)(const char *format, ...); +void* (*pfnmalloc)(size_t size); +void* (*pfncalloc)(size_t numitems, size_t size); +void* (*pfnrealloc)(void *block, size_t size); +void (*pfnfree)(void *block); int signature_end; } WIN32_IOSUBSYSTEM; diff --git a/win32/win32iop.h b/win32/win32iop.h index 56ed402..4606563 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -64,6 +64,22 @@ EXT int win32_rmdir(const char *dir); EXT int win32_chdir(const char *dir); EXT int win32_flock(int fd, int oper); EXT int win32_execvp(const char *cmdname, const char *const *argv); +EXT void win32_perror(const char *str); +EXT void win32_setbuf(FILE *pf, char *buf); +EXT int win32_setvbuf(FILE *pf, char *buf, int type, size_t size); +EXT int win32_flushall(void); +EXT int win32_fcloseall(void); +EXT char* win32_fgets(char *s, int n, FILE *pf); +EXT char* win32_gets(char *s); +EXT int win32_fgetc(FILE *pf); +EXT int win32_putc(int c, FILE *pf); +EXT int win32_puts(const char *s); +EXT int win32_getchar(void); +EXT int win32_putchar(int c); +EXT void* win32_malloc(size_t size); +EXT void* win32_calloc(size_t numitems, size_t size); +EXT void* win32_realloc(void *block, size_t size); +EXT void win32_free(void *block); /* * these two are win32 specific but still io related @@ -81,7 +97,8 @@ long stolen_get_osfhandle(int fd); #include /* pull in the io sub system structure */ -void * SetIOSubSystem(void *piosubsystem); +EXT PWIN32_IOSUBSYSTEM SetIOSubSystem(void *piosubsystem); +EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void); /* * the following six(6) is #define in stdio.h @@ -98,6 +115,9 @@ void * SetIOSubSystem(void *piosubsystem); #ifdef __BORLANDC__ #undef ungetc #undef getc +#undef putc +#undef getchar +#undef putchar #undef fileno #endif @@ -157,6 +177,24 @@ void * SetIOSubSystem(void *piosubsystem); #define chdir win32_chdir #define flock(fd,o) win32_flock(fd,o) #define execvp win32_execvp +#define perror win32_perror +#define setbuf win32_setbuf +#define setvbuf win32_setvbuf +#define flushall win32_flushall +#define fcloseall win32_fcloseall +#define fgets win32_fgets +#define gets win32_gets +#define fgetc win32_fgetc +#define putc win32_putc +#define puts win32_puts +#define getchar win32_getchar +#define putchar win32_putchar +#define fscanf (GetIOSubSystem()->pfnfscanf) +#define scanf (GetIOSubSystem()->pfnscanf) +#define malloc win32_malloc +#define calloc win32_calloc +#define realloc win32_realloc +#define free win32_free #endif /* WIN32IO_IS_STDIO */ #endif /* WIN32IOP_H */