----------------
+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 <jhi@iki.fi>
+ Msg-ID: <199708061827.VAA09623@alpha.hut.fi>
+ Files: Configure
+
+ Title: "Configure can't find open3 on NeXTstep"
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, 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" <k@sissy.in-berlin.de>, Chip Salzenberg
+ <salzench@nielsenmedia.com>
+ 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 <okamoto@hpcc123.corp.hp.com>
+ 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 <doughera@newton.phys.lafayette.edu>
+ Files: INSTALL
+
+ ------ CORE LANGUAGE ------
+
+ Title: "[PATCH] Additional patch for "Can't execute ...""
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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 <alias@mcs.com>
+ Msg-ID: <m0wsb7J-000EYPC@alias-2.pr.mcs.net>
+ 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" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0wtbhv-0005Mm-00@ursa.cus.cam.ac.uk>
+ 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 <gsar@engin.umich.edu>
+ 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<use
+ locale>"
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID: <199707210519.BAA13785@nielsenmedia.com>
+ Files: op.c
+
+ Title: "Eval fails in certain situations (eval "{'...")"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ 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 <chip@rio.atlantic.net>
+ Files: pp_ctl.c
+
+ Title: "stringify looses integerness"
+ From: Gisle Aas <aas@bergen.sn.no>
+ Msg-ID: <hbu4l96z2.fsf@bergen.sn.no>
+ Files: sv.c
+
+ Title: "Fix intolerance of a space between "print" and opening paren"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ Msg-ID: <199706301842.OAA05569@aatma.engin.umich.edu>
+ Files: perl.c
+
+ Title: "UNIVERSAL.pm and import methods (tests)"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0whfHh-0007bW-00@ursa.cus.cam.ac.uk>
+ 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 <hv@crypt.compulink.co.uk>
+ 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" <allen@gateway.grumman.com>, Chip Salzenberg
+ <chip@rio.atlantic.net>
+ Msg-ID: <Pine.SOL.3.91.970625111744.19300A-100000@gateway>
+ Files: pp.c
+
+ Title: "Forbid "goto" into middle of foreach loop"
+ From: Chip Salzenberg <chip@rio.atlantic.net>
+ Files: pod/perldiag.pod pp_ctl.c
+
+ Title: "Fix C<qq #hi#>"
+ From: Chip Salzenberg <chip@rio.atlantic.net>
+ Files: toke.c
+
+ Title: "bless file handles as FileHandle if loaded else IO::Handle"
+ From: Gisle Aas <aas@bergen.sn.no>
+ Msg-ID: <hyb80drrz.fsf@bergen.sn.no>
+ Files: gv.c lib/FileHandle.pm
+
+ Title: "infinite recursion in malloc() with some compile flags"
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Msg-ID: <199706240050.CAA10550@xs2.xs4all.nl>
+ Files: malloc.c
+
+ Title: "sv_vcatpvfn hogs memory [Patch included]"
+ From: Matthias Neeracher <neeri@iis.ee.ethz.ch>
+ Msg-ID: <199706211521.RAA12778@solar.ethz.ch>
+ Files: sv.c
+
+ Title: "Fix '-' flag on sprintf() of floats"
+ From: Chip Salzenberg <chip@rio.atlantic.net>, Jarkko Hietaniemi
+ <jhi@iki.fi>
+ Msg-ID: <199705270646.JAA02510@alpha.hut.fi>
+ Files: sv.c
+
+ Title: "Free temps before calling END blocks", "Too late destruction"
+ From: Chip Salzenberg <chip@rio.atlantic.net>
+ Msg-ID: <m33erfv5hx.fsf@chany-p100.emwp.com>
+ Files: perl.c
+
+ Title: "Fix C<print $foo x 2> parsing"
+ From: "Chuck D. Phillips (NON-HP Employee)" <cdp@hpescdp.fc.hp.com>, Chip
+ Salzenberg <chip@rio.atlantic.net>
+ Msg-ID: <199706121737.KAA00503@palrel3.hp.com>
+ Files: toke.c
+
+ Title: "Fix lockf_emulate_flock() positioning"
+ From: Chip Salzenberg <chip@rio.atlantic.net>, 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 <chip@rio.atlantic.net>, Roger Espel Llima
+ <espel@llaic.univ-bpclermont.fr>
+ 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 <chip@rio.atlantic.net>
+ Files: toke.c
+
+ Title: "[PATCH] -p does not check for failure of implicit print"
+ From: Dominic Dunlop <domo@slipper.ip.lu>
+ Msg-ID: <v0311070aafea3fa83061@[194.51.248.75]>
+ Files: pod/perldiag.pod pod/perlrun.pod toke.c
+
+ Title: "Fix double form() in XS version check"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199707150010.UAA00816@monk.mps.ohio-state.edu>
+ Files: XSUB.h
+
+ Title: "Constant-fold sprintf()"
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Files: opcode.pl
+
+ Title: "[PATCH] Fix double form() in XS version check"
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID: <199707210518.BAA13771@nielsenmedia.com>
+ Files: XSUB.h
+
+ Title: "[PATCH] Make DEBUGGING_MSTATS info consistent"
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.970731131529.3740A-100000@newton.phys>
+ Files: INSTALL pod/perldelta.pod perl.h
+
+ Title: "Minor Win32 glitch with -S flag"
+ From: Warren Jones <wjones@tc.fluke.com>
+ Msg-ID: <97Jun19.150511pdt.35717-2@gateway.fluke.com>
+ Files: perl.c
+
+ Title: "Slightly safer signals"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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 <alias@mcs.com>
+ Msg-ID: <m0wsEMU-000EYLC@alias-2.pr.mcs.net>,
+ <m0wsf7Y-000EYPC@alias-2.pr.mcs.net>
+ Files: sv.c
+
+ Title: "Win32 UNC path causes autoload to fail"
+ From: Warren Jones <wjones@tc.fluke.com>
+ Msg-ID: <97Jun18.163826pdt.35714-1@gateway.fluke.com>
+ Files: pp_ctl.c
+
+ Title: "[PATCH]: reduced malloc patch"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu>
+ Files: av.c
+
+ Title: "[PATCH] $\1 and serious bug in evalling"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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 <chip@rio.atlantic.net>, Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <ilya@math.ohio-state.edu>
+ 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 <gsar@engin.umich.edu>, Kenneth Albanowski
+ <kjahds@kjahds.com>
+ Msg-ID: <199707280516.BAA14055@aatma.engin.umich.edu>,
+ <Pine.LNX.3.93.970727172201.350K-100000@kjahds.com>,
+ <Pine.LNX.3.93.970728013540.350U-100000@kjahds.com>
+ Files: t/base/lex.t toke.c
+
+ Title: "Enable PERL_DEBUG_MSTATS without -DDEBUGGING_MSTATS"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu>
+ Files: malloc.c perl.c
+
+ Title: "semctl broken under Linux"
+ From: Andreas Schwab <schwab@LS5.informatik.uni-dortmund.de>, Andreas
+ Schwab <schwab@issan.informatik.uni-dortmund.de>, Graham
+ Barr <gbarr@ti.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ 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 <jhi@iki.fi>
+ 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" <mjtg@cus.cam.ac.uk>, Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>, Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>,
+ <199707302228.BAA18032@alpha.hut.fi>,
+ <199707310929.KAA06515@crypt.compulink.co.uk>,
+ <E0wtruH-0002JM-00@ursa.cus.cam.ac.uk>
+ Files: pp.c
+
+ Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't
+ intersect original at all"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199707100655.JAA14924@alpha.hut.fi>,
+ <E0wm1JG-0000UY-00@taurus.cus.cam.ac.uk>
+ 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 <dougm@opengroup.org>
+ Msg-ID: <199707170355.XAA21370@postman.opengroup.org>
+ Files: pod/perlembed.pod
+
+ Title: "Document bug fix in localization of $1 etc."
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Files: pod/perldelta.pod
+
+ Title: "[PATCH] Major goof in XS Tutorial regarding subdirs"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199707260920.FAA12453@monk.mps.ohio-state.edu>
+ Files: pod/perlxstut.pod
+
+ Title: "[PATCH] Magic info in perlguts, take 2"
+ From: Stephen McCamant <alias@mcs.com>
+ Msg-ID: <m0wr6P8-000EYLC@alias-2.pr.mcs.net>
+ Files: pod/perlguts.pod
+
+ Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0welEn-0002vT-00@taurus.cus.cam.ac.uk>,
+ <E0wfRJU-0006Aw-00@taurus.cus.cam.ac.uk>
+ Files: pod/perldiag.pod
+
+ Title: "[PATCH] Updates to perlguts (repost)"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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 <dougm@opengroup.org>
+ Msg-ID: <199707181344.JAA10565@postman.opengroup.org>
+ Files: pod/perlembed.pod
+
+ Title: "[PATCH] arguments swapped in perlapio.pod"
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Msg-ID: <199706240049.CAA10534@xs2.xs4all.nl>
+ Files: pod/perlapio.pod
+
+ Title: "[PATCH] cool quote for perldebug"
+ From: Greg Bacon <gbacon@adtrn-srv4.adtran.com>
+ Msg-ID: <199707292140.QAA28579@adtrn-srv4.adtran.com>
+ Files: pod/perldebug.pod
+
+ Title: "[PATCH] multiline commands in qx//"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ 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" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0wdKJY-00010w-00@taurus.cus.cam.ac.uk>
+ Files: pod/perltrap.pod
+
+ Title: "done3/perlbook.pod"
+ From: Randal Schwartz <merlyn@gadget.cscaper.com>
+ Files: pod/perlbook.pod
+
+ Title: "[PATCH] readline and readpipe are undocumented"
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Files: pod/perlfunc.pod
+
+ Title: "Document use of - in a regex char class."
+ From: Dominic Dunlop <domo@slipper.ip.lu>
+ Msg-ID: <v03102804afd578bcef2c@[194.51.248.88]>
+ Files: pod/perlre.pod
+
+ Title: "[PATCH] splitpod broken in 5.004_01"
+ From: Hans Mulder <hansmu@xs4all.nl>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ 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 <pimlott@abel.math.harvard.edu>
+ Msg-ID: <Pine.SOL.3.91.970806173903.7320H-100000@abel>
+ Files: lib/Shell.pm
+
+ Title: "confessing a carp"
+ From: Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>, Nick Ing-Simmons
+ <nick@ni-s.u-net.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ 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" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0wwAjQ-0004l6-00@ursa.cus.cam.ac.uk>
+ Files: lib/dumpvar.pl
+
+ Title: "[PATCH] m2t3: minor doc patch (to obsolete I18N::Collate)"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199708060732.KAA02675@alpha.hut.fi>
+ Files: lib/I18N/Collate.pm
+
+ Title: "[PATCH] Binary installers for Perl modules"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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" <k@anna.in-berlin.de>, Ilya Zakharevich
+ <ilya@math.ohio-state.edu>
+ 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 <ilya@math.ohio-state.edu>
+ 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" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0wdJra-0000n8-00@taurus.cus.cam.ac.uk>
+ 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" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0whaZJ-0007BA-00@ursa.cus.cam.ac.uk>
+ Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm
+
+ Title: "perl5.004 Time::Local still broken"
+ From: Mathias Koerber <mathias@dnssec1.singnet.com.sg>
+ Msg-ID: <199706260452.MAA22647@dnssec1.singnet.com.sg>
+ Files: lib/Time/Local.pm
+
+ Title: "Sys::Hostname should localize $SIG{__DIE__}"
+ From: Ken Shan <ken@digitas.harvard.edu>
+ Msg-ID: <199707070357.XAA18065@digitas.harvard.edu>
+ Files: lib/Sys/Hostname.pm
+
+ Title: "xsubpp patch"
+ From: John Tobey <jtobey@user1.channel1.com>
+ 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 <ilya@math.ohio-state.edu>
+ Msg-ID: <199707250040.UAA11000@monk.mps.ohio-state.edu>
+ Files: ext/IO/IO.xs
+
+ Title: "[PATCH] Repost of fork() debugger patch"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ 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 <aas@bergen.sn.no>
+ Msg-ID: <h205qyijy.fsf@bergen.sn.no>
+ Files: ext/IO/lib/IO/File.pm
+
+ Title: "[MM] [PATCH] Re: Liblist problems for MSWin32"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ 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 <robinson_s@sc.maricopa.edu>
+ Msg-ID: <33B31342.7EB16A44@sc.maricopa.edu>
+ Files: lib/Sys/Syslog.pm
+
+ Title: "'use UNIVERSAL;' deprecated, do C<UNIVERSAL::isa()> instead",
+ "UNIVERSAL.pm and import methods"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Gisle Aas <aas@bergen.sn.no>,
+ Graham Barr <gbarr@ti.com>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>, Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>
+ 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>,
+ <E0wf5TN-0006ps-00@taurus.cus.cam.ac.uk>,
+ <E0wguTR-0005bs-00@ursa.cus.cam.ac.uk>,
+ <E0whaZJ-0007BA-00@ursa.cus.cam.ac.uk>,
+ <E0whfHh-0007bW-00@ursa.cus.cam.ac.uk>,
+ <E0wiyUG-00073j-00@taurus.cus.cam.ac.uk>,
+ <hiuyv6q9k.fsf@bergen.sn.no>
+ 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" <k@anna.in-berlin.de>
+ 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 <dougm@opengroup.org>
+ 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 <jay@rgrs.com>
+ Msg-ID: <199707311759.NAA13276@crooked-i.mitre.org>
+ Files: lib/perl5db.pl
+
+ Title: "[PATCH] pod2html mangles C<&foo(42);>"
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Msg-ID: <199706250057.CAA10162@xs1.xs4all.nl>
+ Files: lib/Pod/Html.pm
+
+ Title: "[PATCH] posix.xs broken on VMS 7.1"
+ From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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" <cek@tblv021.ca.boeing.com>
+ Msg-ID: <199707040045.RAA24459@mailgate2.boeing.com>
+ Files: lib/File/Find.pm
+
+ ------ OTHER CHANGES ------
+
+ Title: "EMERGENCY_SBRK or PERL_EMERGENCY_SBRK ?"
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>,
+ ilya@math.ohio-state.edu (Ilya Zakharevich)
+ Msg-ID: <1997Aug1.191631.2167470@hmivax.humgen.upenn.edu>,
+ <Pine.SUN.3.96.970801134400.4393F-100000@newton.phys>
+ Files:
+ Files:
+
+ ------ PORTABILITY - WIN32 ------
+
+ Title: "[PATCH] Embedding threaded apps in perl.dll"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>, Warren Jones
+ <wjones@tc.fluke.com>
+ 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 <chrisw@netinfo.com.au>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ Msg-ID: <199706231654.MAA23276@aatma.engin.umich.edu>
+ Files: win32/win32sck.c
+
+ Title: "[PATCH] minor win32 scribbles"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>
+ 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 <gsar@engin.umich.edu>, Ilya Zakharevich
+ <ilya@math.ohio-state.edu>
+ 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 <ilya@math.ohio-state.edu>
+ 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 <bailey@HMIVAX.HUMGEN.UPENN.EDU>, Dan Sugalski
+ <sugalsd@lbcc.cc.or.us>
+ 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 <sugalsd@lbcc.cc.or.us>
+ Msg-ID: <3.0.1.32.19970624151939.00994490@stargate.lbcc.cc.or.us>
+ Files: vms/descrip.mms
+
+ Title: "Minor VMS patches"
+ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+ 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 <sugalsd@lbcc.cc.or.us>
+ 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 <john@titanic.atlantech.com>
+ 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 <hv@crypt.compulink.co.uk>
+ Msg-ID: <199706250730.IAA06097@crypt.compulink.co.uk>
+ Files: t/comp/cmdopt.t
+
+ Title: "[PATCH] enable some tests on Win32"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199707250029.UAA02351@aatma.engin.umich.edu>
+ Files: t/op/magic.t
+
+ Title: "Fix up problems with *DBM tests"
+ From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
+ 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 <jhi@iki.fi>
+ Msg-ID: <199708071022.NAA13008@alpha.hut.fi>
+ Files: utils/perlbug.PL
+
+ Title: "perlbug - check sendmail and fix win32 tmp path"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199708060349.XAA15895@aatma.engin.umich.edu>
+ Files: utils/perlbug.PL
+
+ Title: "OK: perl <some_version> on <some_system> (corrected)", "enhancements
+ to perlbug -ok"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Stephen McCamant <alias@mcs.com>
+ Msg-ID: <E0wukVt-0006Da-00@ursa.cus.cam.ac.uk>,
+ <E0wvMQl-00055y-00@ursa.cus.cam.ac.uk>,
+ <m0wv81x-000EYPC@alias-2.pr.mcs.net>
+ Files: utils/Makefile utils/perlbug.PL
+
+ Title: "perlbug -ok [PATCH]"
+ From: "Charles F. Randall" <crandall@free.click-n-call.com>
+ Msg-ID: <199706181824.MAA04082@free.click-n-call.com>
+ Files: utils/perlbug.PL
+
+ Title: "perlbug broken"
+ From: Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+ Msg-ID: <9707040912.AA03466@issan.informatik.uni-dortmund.de>
+ Files: utils/perlbug.PL
+
+ Title: "[PATCH] perlbug under OS/2"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199707180333.XAA03102@monk.mps.ohio-state.edu>
+ Files: utils/perlbug.PL
+
+ Title: "perldoc doesn't grok Win32 UNC paths"
+ From: Warren Jones <wjones@tc.fluke.com>
+ 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 <ilya@math.ohio-state.edu>
+ Msg-ID: <199707180340.XAA03114@monk.mps.ohio-state.edu>
+ Files: utils/perldoc.PL
+
+ Title: "h2ph corrections to avoid redefined sub warnings"
+ From: wdconsta <wdconsta@cs.adelaide.edu.au>
+ Msg-ID: <Pine.SV4.3.93.970708143446.23808A-100000@florence.teaching.cs.adelaide.edu.au>
+ Files: utils/h2ph.PL
+
+
+
+----------------
Version 5.004_01 Maintenance release 1 for 5.004
----------------
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"
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 "<sys/file.h> defines the O_* constants..." >&4
if ./open3; then
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 "<fcntl.h> defines the O_* constants..." >&4
if ./open3; then
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
=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.
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,
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
=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
=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 $
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
# 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
- 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 </dev/tty
+# handy way to run perlbug -ok without having to install and run the
+# installed perlbug. We don't re-run the tests here - we trust the user.
+ok:
+ ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
+
clist: $(c)
echo $(c) | tr ' ' '\012' >.clist
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.
}
}
$::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;
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;
$a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
} values %ls;
+if ($::opt_f) { # filter out patches based on -f <regexp>
+ 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};
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);
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;
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;
sub my_wrap {
- return expand(wrap(@_));
+ my $txt = eval { expand(wrap(@_)) }; # die's on long lines!
+ return $txt unless $@;
+ return expand("@_");
}
$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;
}
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
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
{
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
#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
#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
sv_setnv
sv_setptrobj
sv_setpv
+sv_setpviv
sv_setpvn
sv_setref_iv
sv_setref_nv
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;
}
ENTER;
SAVESPTR(op);
op = (OP *) &myop;
- if (perldb && curstash != debstash)
+ if (PERLDB_SUB && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
pp_pushmark();
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
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"
# 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'
# 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
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
}
}
+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);
}
+
# Utility functions
sub _push_tags {
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
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
=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
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 ();
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';
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));
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 ;
=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 = <FIXIN>);
+ 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, <FIXIN>;
+ 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:
# 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>) {
$ispod = 1;
}
if( $ispod ) {
- $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)');
+ $manifypods{$name} =
+ $self->catfile('$(INST_MAN1DIR)',
+ basename($name).'.$(MAN1EXT)');
}
}
}
$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;
$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;
}
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));
}
}
}
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;
}
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+$//;
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
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">
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<after> 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:
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<depend> below.
=item XS
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) = @_;
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);
}
# 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;
=head1 SYNOPSIS
- $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH
+ $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH,
'some cmd and args', 'optarg', ...);
=head1 DESCRIPTION
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
# method 2 - syscall is preferred since it avoids tainting problems
eval {
- local $SIG{'__DIE__'};
+ local $SIG{__DIE__};
{
package main;
require "syscall.ph";
# 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);
}
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?
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;
$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;
}
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;
=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<UNIVERSAL> is the base class which all bless references will inherit from,
=back
-C<UNIVERSAL> also optionally exports the following subroutines
+The C<isa> and C<can> methods can also be called as subroutines
=over 4
-=item isa ( VAL, TYPE )
+=item UNIVERSAL::isa ( VAL, TYPE )
C<isa> returns I<true> if the first argument is a reference and either
of the following statements is true.
=back
-=item can ( VAL, METHOD )
+=item UNIVERSAL::can ( VAL, METHOD )
If C<VAL> is a blessed reference which has a method called C<METHOD>,
C<can> returns a reference to the subroutine. If C<VAL> is not
=back
+These subroutines should I<not> be imported via S<C<use UNIVERSAL qw(...)>>.
+If you want simple local access to them you can do
+
+ *isa = \&UNIVERSAL::isa;
+
+to import isa into your package.
+
=cut
# 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;
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
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;
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",
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]);
}
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;
}
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];
compcv = 0;
/* Register with debugger */
- if (perldb) {
+ if (PERLDB_INTER) {
CV *cv = perl_get_cv("DB::postponed", FALSE);
if (cv) {
dSP;
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 ];
}
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);
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;
}
}
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) {
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.
+
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!'
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" > $@
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}' <dummy.map | sort | uniq > 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}' <miniperl.map | sort | uniq > perl.map
+ rm miniperl.map
+ @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
depend: os2ish.h dlfcn.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
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
:
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
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
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 \
#define PATCHLEVEL 4
-#define SUBVERSION 1
+#define SUBVERSION 2
/*
local_patches -- list of locally applied less-than-subversion patches.
/* my_exit() was called */
while (scopestack_ix > oldscope)
LEAVE;
+ FREETMPS;
curstash = defstash;
if (endav)
call_list(oldscope, endav);
/* 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: ");
PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename);
my_exit(0);
}
- if (perldb && DBsingle)
+ if (PERLDB_SINGLE && DBsingle)
sv_setiv(DBsingle, 1);
}
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
I32 oldscope;
dJMPENV;
int ret;
-
+ OP* oldop = op;
+
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
FREETMPS;
LEAVE;
}
+ op = oldop;
return retval;
}
s += strlen(s);
}
if (!perldb) {
- perldb = TRUE;
+ perldb = PERLDB_ALL;
init_debugger();
}
return s;
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;
#ifdef DOSISH
if (strEQ(scriptname, "-"))
- dosearch = 0;
+ dosearch = 0;
if (dosearch) { /* Look in '.' first. */
char *cur = scriptname;
#ifdef SEARCH_EXTS
if (Stat(cur,&statbuf) >= 0) {
dosearch = 0;
scriptname = cur;
+#ifdef SEARCH_EXTS
break;
+#endif
}
#ifdef SEARCH_EXTS
if (cur == scriptname) {
#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)
}
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)
#endif
)
tokenbuf[len++] = '/';
- if (len == 2 && tokenbuf[0] == '.')
+ if (len == 2 && tokenbuf[0] == '.')
seen_dot = 1;
(void)strcpy(tokenbuf + len, scriptname);
#endif /* !VMS */
}
#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"),
/* 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;
# include <netinet/in.h>
#endif
+#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
+/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
+ * (the neo-BSD seem to do this). */
+# undef SF_APPEND
+#endif
+
#ifdef I_SYS_STAT
-#include <sys/stat.h>
+# include <sys/stat.h>
#endif
/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
# 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]
#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 */
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
corresponding stack frame was called with.
If perl is run with B<-d> option, the following additional features
-are enabled:
+are enabled (cf. L<perlvar/$^P>):
=over
=back
-Note that no subroutine call is possible until C<&DB::sub> is defined
-(for subroutines outside of package C<DB>). (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 {}
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 $<digit>, $&, 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<not>
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);
$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
=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<DEBUGGING_MSTATS> defined, you can print
+If perl is compiled with the malloc included with the perl distribution
+(that is, if C<perl -V:d_mymalloc> 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
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
occurs if you tried to jump out of a sort() block or subroutine, which
is a no-no. See L<perlfunc/goto>.
+=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<perlfunc/goto>.
+
=item Can't "last" outside a block
(F) A "last" statement was executed to break out of the current block,
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<Perl 5
Interactive>, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
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
@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 C<E<lt>EXPRE<gt>>
+operator, but you can use it directly. The C<E<lt>EXPRE<gt>>
+operator is discussed in more detail in L<perlop/"I/O Operators">.
+
=item readlink EXPR
=item readlink
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<qx/EXPR/>
+operator, but you can use it directly. The C<qx/EXPR/>
+operator is discussed in more detail in L<perlop/"I/O Operators">.
+
=item recv SOCKET,SCALAR,LEN,FLAGS
Receives a message on a socket. Attempts to receive LENGTH bytes of
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
=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
=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
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);
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)) {
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)
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);
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*));
}
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.
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;
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;
}
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
(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;
ENTER;
SAVESPTR(op);
op = (OP *) &myop;
- if (perldb && curstash != debstash)
+ if (PERLDB_SUB && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
XPUSHs((SV*)GvCV(gv));
ENTER;
SAVESPTR(op);
op = (OP *) &myop;
- if (perldb && curstash != debstash)
+ if (PERLDB_SUB && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
pp_pushmark();
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 */
errno = EINVAL;
break;
}
+
+ if (pos > 0) /* need to restore position of the handle */
+ if (lseek(fd, pos, SEEK_SET) == -1)
+ i = -1;
+
return (i);
}
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));
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;
case OPEN:
n = ARG1(scan); /* which paren pair */
regstartp[n] = locinput;
- regendp[n] = 0;
if (n > regsize)
regsize = n;
break;
{
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();
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)
--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))
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, ...)
}
if (fill == '0')
*--eptr = fill;
+ if (left)
+ *--eptr = '-';
if (plus)
*--eptr = plus;
if (alt)
}
} else {
$next += 1;
- print "FAILED on test $next\n";
+ print "FAILED at test $next\n";
$bad = $bad + 1;
$_ = $test;
if (/^base/) {
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";
}
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);
main::ok(19, $@ eq "") ;
main::ok(20, $ret eq "[[5]]") ;
- unlink "SubDB.pm", "dbhash.tmp" ;
+ unlink "SubDB.pm", <dbhash.tmp*> ;
}
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
- unlink "SubDB.pm", "dbhash.tmp" ;
+ unlink "SubDB.pm", <dbhash.tmp*> ;
}
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
- unlink "SubDB.pm", "dbhash.tmp" ;
+ unlink "SubDB.pm", <dbhash.tmp*> ;
}
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
- unlink "SubDB.pm", "dbhash.tmp" ;
+ unlink "SubDB.pm", <dbhash.tmp*> ;
}
# $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
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");
+
'([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
# $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;
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';
$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) {
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";
@INC = '../lib' if -d '../lib';
}
-print "1..70\n";
+print "1..72\n";
$a = {};
bless $a, "Bob";
test $a->can("VERSION");
test $a->can("can");
+test ! $a->can("export_tags"); # a method in Exporter
test (eval { $a->VERSION }) == 2.718;
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
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);
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);
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);
}
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 */
oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
bufend = SvPVX(linestr) + SvCUR(linestr);
preambled = FALSE;
- if (perldb)
+ if (PERLDB_LINE)
(void)gv_fetchfile(origfilename);
goto retry;
}
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))
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);
missingterm(tokenbuf);
}
curcop->cop_line++;
- if (perldb && curstash != debstash) {
+ if (PERLDB_LINE && curstash != debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
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;
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++;
return Nullch;
}
curcop->cop_line++;
- if (perldb && curstash != debstash) {
+ if (PERLDB_LINE && curstash != debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
#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)
{
register I32 tolen;
for (tolen = 0; from < fromend; from++, tolen++) {
- if (*from == '\\' && delim != ';') {
+ if (*from == '\\') {
if (from[1] == delim)
from++;
else {
$(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:
# %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.
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 (<PATCH_LEVEL>) {
+ last if index($_, "static\tchar\t*local_patches[] = {") >= 0;
+};
+
+my $patches;
+while (<PATCH_LEVEL>) {
+ 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.
$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.
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.
# 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
# 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 {
{
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";
open(REP,">$filename");
+ my $reptype = $ok ? "success" : "bug";
+
print REP <<EOF;
-This is a bug report for perl from $from,
+This is a $reptype report for perl from $from,
generated with the help of perlbug $Version running under perl $].
EOF
print OUT Config::myconfig;
- if($verbose) {
- print OUT "\nComplete configuration data for perl $]:\n\n";
- my($value);
- foreach (sort keys %::Config) {
- $value = $::Config{$_};
- $value =~ s/'/\\'/g;
- print OUT "$_='$value'\n";
- }
- }
+ if (@patches) {
+ print OUT join "\n\t", "\nLocally applied patches:", @patches;
+ print OUT "\n";
+ };
+
print OUT <<EOF;
---
exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
"\n";
}
+ if($verbose) {
+ print OUT "\nComplete configuration data for perl $]:\n\n";
+ my($value);
+ foreach (sort keys %::Config) {
+ $value = $::Config{$_};
+ $value =~ s/'/\\'/g;
+ print OUT "$_='$value'\n";
+ }
+ }
}
sub Edit {
}
}
- paraprint <<"EOF", die "\n" if $sendmail eq "";
+ paraprint(<<"EOF"), die "\n" if $sendmail eq "";
I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
the perl package Mail::Send has not been installed, so I can't send your bug
EOF
- open(SENDMAIL,"|$sendmail -t");
+ open(SENDMAIL,"|$sendmail -t") || die "'|$sendmail -t' failed: $|";
print SENDMAIL "To: $address\n";
print SENDMAIL "Subject: $subject\n";
print SENDMAIL "Cc: $cc\n" if $cc;
-d Data mode (the default if you redirect or pipe output.)
This prints out your configuration data, without mailing
anything. You can use this with -v to get more complete data.
- -ok Report successful build on this sytem to perl porters (use alone).
+ -ok Report successful build on this system to perl porters
+ (use alone or with -v).
+ -okay As -ok but also report on older systems.
-h Print this help message.
EOF
S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]>
-B<perlbug> S<[ B<-r> I<returnaddress> ]> B<-ok>
+B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]> S<[ B<-ok> | B<okay> ]>
=head1 DESCRIPTION
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<Changes> file in any development releases since the time you submitted
the bug, and encourage the maintainers with kind words (but never any
=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<make>). Honors return address specified with B<-r>.
+B<make>). 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>
Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
-and Charles F. Randall (E<lt>cfr@pobox.comE<gt>).
+Charles F. Randall (E<lt>cfr@pobox.comE<gt>) and
+Mike Guy (E<lt>mjtg@cam.a.ukE<gt>).
=head1 SEE ALSO
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")) {
my $lcp = lc $p;
opendir DIR, "@p";
while ($cip=readdir(DIR)) {
- $cip =~ s/\.dir$// if $Is_VMS;
if (lc $cip eq $lcp){
$found++;
last;
* 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 <string.h> /* Check whether new DECC has #defined bcopy and bzero */
/* HAS_BCOPY:
* <sys/resource.h> 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
* 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
* 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
* 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:
/* 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
* 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:
* 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
* 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
* 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
* 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
* 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
* 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 */
DBG = DBG
.else
DBGCCFLAGS = /NoList
-DBGLINKFLAGS = /NoMap
+DBGLINKFLAGS = /NoTrace/NoMap
DBG =
.endif
.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
}
}
-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__
# 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");
}
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. */
# include <inet.h>
# include <in.h>
# include <netdb.h>
+#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
+#else
void sethostent(int);
void endhostent(void);
void setnetent(int);
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
$! 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]
$ Exit 44
$ EndIf
$ EndIf
+$ Set Message /Facility/Severity/Identification/Text
$
$ exe = ".Exe"
$ If p1.nes."" Then exe = p1
# 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
$ wrapup:
$ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
$ Set Default &olddef
+$ Set Message 'oldmsg'
$ Exit
/*}}}*/
-/*{{{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);
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.
/*}}}*/
/***** 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
# 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
#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
#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__;
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));
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 *));
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::=|)" \
}
}
__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<ParameterChar = *>
+line in their initialization file, or execute C<setdos /p*> 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
+
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<exec()> 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<pl2bat.bat>: 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<runperl.bat>, 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<exec()>. 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
+
# 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";
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";
}
}
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
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,:,|,)" \
return (IdOS() == VER_PLATFORM_WIN32_NT);
}
-void *
+DllExport PWIN32_IOSUBSYSTEM
SetIOSubSystem(void *p)
{
PWIN32_IOSUBSYSTEM old = pIOSubSystem;
return old;
}
+DllExport PWIN32_IOSUBSYSTEM
+GetIOSubSystem(void)
+{
+ return pIOSubSystem;
+}
+
char *
win32PerlLibPath(void)
{
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)
{
#define _chdir chdir
#include <sys/types.h>
+#ifndef DllMain
+#define DllMain DllEntryPoint
+#endif
+
#pragma warn -ccc
#pragma warn -rch
#pragma warn -sig
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 *);
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 */
};
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;
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
#include <win32io.h> /* 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
#ifdef __BORLANDC__
#undef ungetc
#undef getc
+#undef putc
+#undef getchar
+#undef putchar
#undef fileno
#endif
#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 */
projects / p5sagit/p5-mst-13.2.git / commitdiff