perl 5.002 perl-5.002
authorAndy Dougherty <doughera@lafcol.lafayette.edu>
Thu, 29 Feb 1996 00:49:33 +0000 (16:49 -0800)
committerAndy Dougherty <doughera@lafcol.lafayette.edu>
Thu, 29 Feb 1996 00:49:33 +0000 (16:49 -0800)
[editor's note: changes seem to be mostly module updates,
documentation changes and some perl API macro additions]

83 files changed:
Changes
Configure
INSTALL
MANIFEST
README.vms
config_h.SH [changed mode: 0644->0755]
configpm
configure [changed mode: 0755->0644]
cv.h
doio.c
dosish.h
ext/FileHandle/FileHandle.pm
ext/NDBM_File/NDBM_File.pm
ext/NDBM_File/hints/svr4.pl [new file with mode: 0644]
ext/ODBM_File/ODBM_File.pm
ext/SDBM_File/SDBM_File.pm
ext/Safe/Safe.xs
gv.c
gv.h
hints/aix.sh
hints/hpux.sh
hints/linux.sh
hints/os2.sh
hints/sco.sh
hints/svr4.sh
installman [changed mode: 0755->0644]
lib/ExtUtils/MM_OS2.pm
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/MM_VMS.pm
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/Mksymlists.pm
lib/File/Copy.pm
lib/File/Path.pm
lib/I18N/Collate.pm
lib/Math/BigFloat.pm
lib/Math/BigInt.pm
lib/Math/Complex.pm
lib/Shell.pm
lib/Text/ParseWords.pm
lib/lib.pm
makeaperl.SH [changed mode: 0755->0644]
mg.c
op.c
opcode.h
opcode.pl
os2/diff.Makefile
os2/diff.exec [deleted file]
os2/os2ish.h
patchlevel.h
perl.c
perl.h
perl_exp.SH
perly.c
perly.c.diff
perly.y
pod/perldiag.pod
pod/perlfunc.pod
pod/perlop.pod
pod/perlre.pod
pod/perlrun.pod
pod/perlxs.pod
pp.c
pp_ctl.c
pp_hot.c
pp_sys.c
sv.c
sv.h
t/comp/cpp.aux [changed mode: 0755->0644]
t/harness [new file with mode: 0644]
t/lib/dirhand.t [changed mode: 0755->0644]
t/lib/filehand.t [changed mode: 0755->0644]
toke.c
unixish.h
util.c
utils/perlbug.PL
vms/descrip.mms
vms/ext/Filespec.pm
vms/gen_shrfls.pl
vms/genconfig.pl
vms/perlvms.pod
vms/perly_c.vms
vms/vms.c
vms/vmsish.h

diff --git a/Changes b/Changes
index 8ae3615..72a7603 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,9 +2,13 @@
 Version 5.002
 -------------
 
-Nearly all the changes for 5.001 were bug fixes of one variety or another,
-so here's the bug list, along with the "resolution" for each of them.  If
-you wish to correspond about any of them, please include the bug number.
+The main enhancement to the Perl core was the addition of prototypes.
+Many of the modules that come with Perl have been extensively upgraded.
+
+Other than that, nearly all the changes for 5.002 were bug fixes of one
+variety or another, so here's the bug list, along with the "resolution"
+for each of them.  If you wish to correspond about any of them, please
+include the bug number (if any).
 
 Added APPLLIB_EXP for embedded perl library support.
 Files patched: perl.c
@@ -12,88 +16,21 @@ Files patched: perl.c
 Couldn't define autoloaded routine by assignment to typeglob.
 Files patched: pp_hot.c sv.c
 
-NETaa13399: Andy patches.
+NETaa13525: Tiny patch to fix installman -n
 From: Larry Wall
-Files patched: MANIFEST
+Files patched: installman
 
-NETaa13399: Andy's patch 1m
-Files patched: Configure MANIFEST Makefile.SH embed.h embed.pl
-    ext/GDBM_File/GDBM_File.xs global.sym hints/freebsd.sh installman
-    installperl interp.sym keywords.h keywords.pl lib/Exporter.pm
-    lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp op.c perl.c perl.h perldoc.SH
-    pod/perl.pod pod/pod2html.SH pp.c pp_ctl.c pp_ctl.c pp_hot.c proto.h
-    regcomp.c regcomp.h regexec.c toke.c x2p/util.c x2p/util.h
-
-NETaa13399: Andy's patch.1l
-Files patched: Changes.Conf Configure Makefile.SH README README.vms c2ph.SH
-    config_H config_h.SH configpm configure doio.c embed.h
-    ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DynaLoader/DynaLoader.pm
-    ext/DynaLoader/Makefile.PL ext/DynaLoader/README ext/DynaLoader/dl_dlopen.xs
-    ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs ext/GDBM_File/GDBM_File.pm
-    ext/GDBM_File/GDBM_File.xs ext/NDBM_File/hints/solaris.pl
-    ext/ODBM_File/Makefile.PL ext/ODBM_File/hints/sco.pl
-    ext/ODBM_File/hints/solaris.pl ext/ODBM_File/hints/svr4.pl
-    ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/sdbm.c
-    ext/Socket/Socket.pm global.sym h2ph.SH h2xs.SH handy.h hints/README.hints
-    hints/apollo.sh hints/aux.sh hints/cxux.sh hints/dynix.sh hints/epix.sh
-    hints/freebsd.sh hints/hpux_9.sh hints/irix_4.sh hints/irix_5.sh
-    hints/irix_6.sh hints/isc.sh hints/linux.sh hints/netbsd.sh hints/next_3.sh
-    hints/next_3_0.sh hints/powerunix.sh hints/sco_3.sh hints/titanos.sh
-    installman installperl lib/AnyDBM_File.pm lib/AutoLoader.pm lib/AutoSplit.pm
-    lib/Benchmark.pm lib/Carp.pm lib/Cwd.pm lib/English.pm lib/Exporter.pm
-    lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
-    lib/ExtUtils/Mkbootstrap.pm lib/ExtUtils/xsubpp lib/File/Basename.pm
-    lib/File/CheckTree.pm lib/File/Find.pm lib/FileHandle.pm lib/Getopt/Long.pm
-    lib/Getopt/Std.pm lib/I18N/Collate.pm lib/IPC/Open2.pm lib/IPC/Open3.pm
-    lib/Net/Ping.pm lib/Term/Complete.pm lib/Text/Abbrev.pm lib/Text/Tabs.pm
-    lib/ftp.pl lib/getcwd.pl lib/integer.pm lib/less.pm lib/sigtrap.pm
-    lib/strict.pm lib/subs.pm makeaperl.SH makedepend.SH myconfig perl.c perl.h
-    perldoc.SH pod/Makefile pod/perl.pod pod/perlbot.pod pod/perlcall.pod
-    pod/perlfunc.pod pod/perlguts.pod pod/perlop.pod pod/perlre.pod
-    pod/perlxs.pod pod/pod2html.SH pod/pod2latex.SH pod/pod2man.SH pp_ctl.c
-    pp_hot.c pp_sys.c proto.h scope.c sv.c sv.h t/comp/cpp.aux t/comp/cpp.t
-    t/op/misc.t toke.c unixish.h util.c vms/config.vms vms/ext/MM_VMS.pm
-    vms/ext/VMS/stdio/stdio.xs vms/perlvms.pod vms/vms.c x2p/Makefile.SH
-    x2p/find2perl.SH x2p/s2p.SH x2p/str.c
-
-NETaa13399: Jumbo Configure patch (and patch 1)
-Files patched: Changes.Conf
-
-NETaa13399: Jumbo Configure patch (and patch 1)    
-Files patched: Configure INSTALL MANIFEST Makefile.SH README config_H
-    config_h.SH configure embed.h ext/Fcntl/Fcntl.xs ext/ODBM_File/ODBM_File.xs
-    h2xs.SH hints/aix.sh hints/hpux_9.sh hints/isc.sh hints/isc_2.sh
-    hints/solaris_2.sh hints/unicos.sh hints/utekv.sh lib/ExtUtils/MakeMaker.pm
-    makedepend.SH t/README x2p/a2p.h
-
-NETaa13399: Jumbo Configure patch (patches 2 and 3)
-Files patched: Configure INSTALL config_h.SH embed.h ext/Fcntl/Fcntl.xs
-    ext/POSIX/POSIX.xs global.sym mg.c perl.h proto.h
+NETaa13525: de-documented \v
+Files patched: pod/perlop.pod pod/perlre.pod
 
 NETaa13525: doc changes
-From: Larry Wall
 Files patched: pod/perlop.pod pod/perltrap.pod
 
-NETaa13525: random cleanup
-Files patched: Configure MANIFEST Makefile.SH cop.h embed.h global.sym
-    hints/dec_osf.sh hv.c lib/dotsh.pl mg.c op.c op.c op.h perl.c perl.c perly.c
-    perly.c perly.c.diff perly.c.diff perly.h perly.y pod/perl.pod
-    pod/perldiag.pod pod/perlfunc.pod pod/perlfunc.pod pod/perlfunc.pod
-    pod/perlfunc.pod pod/perlop.pod pod/perlre.pod pod/perltrap.pod
-    pod/perlxs.pod pod/perlxs.pod pp_ctl.c pp_ctl.c pp_hot.c pp_sys.c proto.h
-    regcomp.c regexec.c sv.c sv.c sv.c toke.c vms/perly_c.vms vms/perly_h.vms
-
-NETaa13540: VMS stuff
-From: Larry Wall
-Files patched: EXTERN.h INTERN.h MANIFEST Makefile.SH README.vms av.c embed.h
-    ext/Socket/Socket.pm ext/Socket/Socket.xs global.sym gv.c lib/AutoSplit.pm
-    lib/ExtUtils/MakeMaker.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
-    lib/ExtUtils/xsubpp lib/File/Find.pm lib/File/Path.pm lib/lib.pm perl.c
-    perl.h pp_ctl.c pp_sys.c proto.h run.c sv.c vms/Makefile vms/Makefile
-    vms/config.vms vms/descrip.mms vms/descrip.mms vms/ext/MM_VMS.pm
-    vms/gen_shrfls.pl vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms
-    vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c vms/vms_yfix.pl
-    vms/vmsish.h
+NETaa13525: perlxs update from Dean Roehrich
+Files patched: pod/perlxs.pod
+
+NETaa13525: rename powerunix to powerux
+Files patched: MANIFEST hints/powerux.sh
 
 NETaa13540: VMS uses CLK_TCK for HZ
 Files patched: pp_sys.c
@@ -116,6 +53,11 @@ Files patched: x2p/walk.c
  Consolidated the various declarations and made them consistent with
  the actual definitions.
 
+NETaa13724: -MPackage=args patch
+From: Tim Bunce
+Files patched: perl.c pod/perlrun.pod
+ Added in the -MPackage=args patch too.
+
 NETaa13729: order-of-evaluation dependency in scope.c on leaving REGCONTEXT
 From: "Jason Shirk"
 Files patched: scope.c
@@ -378,11 +320,6 @@ Files patched: embed.h global.sym op.h pp_ctl.c proto.h
  The expression inside the return was taking its context from the immediately
  surrounding block rather than the innermost surrounding subroutine call.
 
-NETaa13794: TieHash produces ${pack} warnings
-From: Stanley Donald Capelik x74321 24-5200 021876
-Files patched: lib/TieHash.pm
- Changed $pack to $pkg.
-
 NETaa13797: could modify sv_undef through auto-vivification
 From: Ilya Zakharevich
 Files patched: pp.c
@@ -429,6 +366,11 @@ Files patched: pod/perlop.pod
  returning FALSE.
  
 
+NETaa13986: split ignored /m pattern modifier
+From: Winfried Koenig
+Files patched: pp.c
+ Fixed to work like m// and s///.
+
 NETaa13992: regexp comments not seen after + in non-extended regexp
 From: Mark Knutsen
 Files patched: regcomp.c
@@ -710,6 +652,15 @@ Files patched: Makefile.SH op.c op.c perly.c perly.c.diff perly.h perly.y proto.
  
  Larry
 
+NETaa14422: couldn't take reference of a prototyped function
+Files patched: op.c
+ (same)
+
+NETaa14423: use didn't allow expressions involving the scratch pad
+From: Graham Barr
+Files patched: op.c perly.c perly.c.diff perly.y proto.h vms/perly_c.vms
+ Applied suggested patch.
+
 NETaa14444: lexical scalar didn't autovivify
 From: Gurusamy Sarathy
 Files patched: op.c pp_hot.c
@@ -763,6 +714,11 @@ From: Gurusamy Sarathy
 Files patched: op.c pp.c pp_hot.c regexec.c sv.c toke.c
  Applied most recent suggested patches.
 
+NETaa14537: select() can return too soon
+From: Matt Kimball
+Also: Andreas Gustafsson
+Files patched: pp_sys.c
+
 NETaa14538: method calls were treated like do {} under loop modifiers
 From: Ilya Zakharevich
 Files patched: perly.c perly.y
@@ -776,6 +732,15 @@ Files patched: Todo op.c pp_ctl.c pp_hot.c
  directly through the array, and can detect the implicit shift from
  referencing <>.
 
+NETaa14541: new version of perlbug
+From: Kenneth Albanowski
+Files patched: README pod/perl.pod utils/perlbug.PL
+ Brought it up to version 1.09.
+
+NETaa14541: perlbug 1.11
+Files patched: utils/perlbug.PL
+ (same)
+
 NETaa14548: magic sets didn't check private OK bits
 From: W. Bradley Rubenstein
 Files patched: mg.c
@@ -819,17 +784,31 @@ NETaa14582: sort was letting unsortable values through to comparison routine
 Files patched: pp_ctl.c
  (same)
 
+NETaa14585: globs in pad space weren't properly cleaned up
+From: Gurusamy Sarathy
+Files patched: op.c pp.c pp_hot.c sv.c
+ Applied suggested patch.
+
 NETaa14614: now does dbmopen with perl_eval_sv()
 From: The Man
 Files patched: perl.c pp_sys.c proto.h
  dbmopen now invokes perl_eval_sv(), which should handle error conditions
  better.
 
+NETaa14618: exists doesn't work in GDBM_File
+From: Andrew Wilcox
+Files patched: ext/GDBM_File/GDBM_File.xs
+ Applied suggested patch.
+
+NETaa14619: tied()
+From: Larry Wall
+Also: Paul Marquess
+Files patched: embed.h global.sym keywords.h keywords.pl opcode.h opcode.pl pp_sys.c toke.c
+ Applied suggested patch.
+
 NETaa14636: Jumbo Dynaloader patch
 From: Tim Bunce
-Files patched: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_dld.xs
-    ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs
-    ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c
+Files patched: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c
  Applied suggested patches.
 
 NETaa14637: checkcomma routine was stupid about bareword sub calls
@@ -855,11 +834,6 @@ Also: Stephen D. Lee
 Files patched: pp_sys.c
  Applied suggested patch.
 
-NETaa14658: infinite loop in c2ph
-From: Nick Gianniotis
-Files patched: c2ph.SH
- Applied suggested patch.
-
 NETaa14668: {2,} could match once
 From: Hugo van der Sanden
 Files patched: regexec.c
@@ -926,6 +900,12 @@ From: Gerd Knops
 Files patched: sv.c
  Now modifies address to copy if it was reallocated.
 
+NETaa14709: Chip's FileHandle stuff
+From: Larry Wall
+Also: Chip Salzenberg
+Files patched: MANIFEST ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs ext/FileHandle/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs lib/FileCache.pm lib/Symbol.pm t/lib/filehand.t t/lib/posix.t
+ Applied suggested patches.
+
 NETaa14711: added (&) and (*) prototypes for blocks and symbols
 From: Kenneth Albanowski
 Files patched: Makefile.SH op.c perly.c perly.h perly.y toke.c
@@ -951,6 +931,11 @@ Files patched: sv.c sv.c
  magic of that type.  Ordinarily it would have, but it was called during
  mg_get(), which forces the magic flags off temporarily.
 
+NETaa14721: sub defined during erroneous do-FILE caused core dump
+From: David Campbell
+Files patched: op.c
+ Fixed the seg fault.  I couldn't reproduce the return problem.
+
 NETaa14734: ref should never return undef
 From: Dale Amon
 Files patched: pp.c t/op/overload.t
@@ -1016,15 +1001,397 @@ NETaa14893: /m modifier was sticky
 Files patched: cop.h pp_hot.c
  (same)
 
+NETaa14916: complete.pl retained old return value
+From: Martyn Pearce
+Files patched: lib/complete.pl
+ Applied suggested patch.
+
+NETaa14928: non-const 3rd arg to split assigned to list could coredump
+From: Hans de Graaff
+Files patched: op.c
+ The optimizer was assuming the OP was an OP_CONST.
+
+NETaa14942: substr as lvalue could disable magic
+From: Darrell Kindred <dkindred+@cmu.edu>
+Files patched: pp.c
+ The substr was disabling the magic of $1.
+
+NETaa14990: "not" not parseable when expecting term
+From: "Randal L. Schwartz"
+Files patched: perly.c perly.c.diff perly.y vms/perly_c.vms
+ The NOTOP production needed to be moved down into the terms.
+
+NETaa14993: Bizarre copy of formline
+From: Tom Christiansen
+Also: Charles Bailey
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa14998: sv_add_arena() no longer leaks memory
+From: Andreas Koenig
+Files patched: av.c hv.c perl.h sv.c
+ Now keeps one potential arena "on tap", but doesn't use it unless there's
+ demand for SV headers.  When an AV or HV is extended, its old memory
+ becomes the next potential arena unless there already is one, in which
+ case it is simply freed.  This will have the desired property of not
+ stranding medium-sized chunks of memory when extending a single array
+ repeatedly, but will not degrade when there's no SV demand beyond keeping
+ one chunk of memory on tap, which generally will be about 250 bytes big,
+ since it prefers the earlier freed chunk over the later.  See the nice_chunk
+ variable.
+
+NETaa14999: $a and $b now protected from use strict and lexical declaration
+From: Tom Christiansen
+Files patched: gv.c pod/perldiag.pod toke.c
+ Bare $a and $b are now allowed during "use strict".  In addition,
+ the following diag was added:
+ =item Can't use "my %s" in sort comparison
+ (F) The global variables $a and $b are reserved for sort comparisons.
+ You mentioned $a or $b in the same line as the <=> or cmp operator,
+ and the variable had earlier been declared as a lexical variable.
+ Either qualify the sort variable with the package name, or rename the
+ lexical variable.
+
+NETaa15034: use strict refs should allow calls to prototyped functions
+From: Roderick Schertler
+Files patched: perly.c perly.c.diff perly.y toke.c vms/perly_c.vms
+ Applied patch suggested by Chip.
+
+NETaa15083: forced $AUTOLOAD to be untainted
+From: Tim Bunce
+Files patched: gv.c pp_hot.c
+ Stripped any taintmagic from $AUTOLOAD after setting it.
+
+NETaa15084: patch for Term::Cap
+From: Mark Kaehny
+Also: Hugo van der Sanden
+Files patched: lib/Term/Cap.pm
+ Applied suggested patch.
+
+NETaa15086: null pattern could cause coredump in s//_$1_/
+From: "Paul E. Maisano"
+Files patched: cop.h pp_ctl.c
+ If the replacement pattern was complicated enough to cause pp_substcont
+ to be called, then it lost track of which REGEXP* it was supposed to
+ be using.
+
+NETaa15087: t/io/pipe.t didn't work on AIX
+From: Andy Dougherty
+Files patched: t/io/pipe.t
+ Applied suggested patch.
+
+NETaa15088: study was busted
+From: Hugo van der Sanden
+Files patched: opcode.h opcode.pl pp.c
+ It was studying its scratch pad target rather than the argument supplied.
+
+NETaa15090: MSTATS patch
+From: Tim Bunce
+Files patched: global.sym malloc.c perl.c perl.h proto.h
+ Applied suggested patch.
+
+NETaa15098: longjmp out of magic leaks memory
+From: Chip Salzenberg
+Files patched: mg.c sv.c
+ Applied suggested patch.
+
+NETaa15102: getpgrp() is broken if getpgrp2() is available
+From: Roderick Schertler
+Files patched: perl.h pp_sys.c
+ Applied suggested patch.
+
+NETaa15103: prototypes leaked opcodes
+From: Chip Salzenberg
+Files patched: op.c
+ Applied suggested patch.
+
+NETaa15107: quotameta memory bug on all metacharacters
+From: Chip Salzenberg
+Files patched: pp.c
+ Applied suggested patch.
+
+NETaa15108: Fix for incomplete string leak
+From: Chip Salzenberg
+Files patched: toke.c
+ Applied suggested patch.
+
+NETaa15110: couldn't use $/ with 8th bit set on some architectures
+From: Chip Salzenberg
+Files patched: doop.c interp.sym mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c util.c
+ Applied suggested patches.
+
+NETaa15112: { a_1 => 2 } didn't parse as expected
+From: Stuart M. Weinstein
+Files patched: toke.c
+ The little dwimmer was only skipping ALPHA rather than ALNUM chars.
+
+NETaa15123: bitwise ops produce spurious warnings
+From: Hugo van der Sanden
+Also: Chip Salzenberg
+Also: Andreas Gustafsson
+Files patched: sv.c
+ Decided to suppress the warning in the conversion routines if merely converting
+ a temporary, which can never be a user-supplied value anyway.
+
+NETaa15129: #if defined (foo) misparsed in h2ph
+From: Roderick Schertler <roderick@gate.net>
+Files patched: utils/h2ph.PL
+ Applied suggested patch.
+
+NETaa15131: some POSIX functions assumed valid filehandles
+From: Chip Salzenberg
+Files patched: ext/POSIX/POSIX.xs
+ Applied suggested patch.
+
+NETaa15151: don't optimize split on OPpASSIGN_COMMON
+From: Huw Rogers
+Files patched: op.c
+ Had to swap the optimization down to after the assignment op is generated
+ and COMMON is calculated, and then clean up the resultant tree differently.
+
+NETaa15154: MakeMaker-5.18
+From: Andreas Koenig
+Files patched: MANIFEST lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
+ Brought it up to 5.18.
+
+NETaa15156: some Exporter tweaks
+From: Roderick Schertler
+Also: Tim Bunce
+Files patched: lib/Exporter.pm
+ Also did Tim's Tiny Trivial patch.
+
+NETaa15157: new version of Test::Harness
+From: Andreas Koenig
+Files patched: lib/Test/Harness.pm
+ Applied suggested patch.
+
+NETaa15175: overloaded nomethod has garbage 4th op
+From: Ilya Zakharevich
+Files patched: gv.c
+ Applied suggested patch.
+
+NETaa15179: SvPOK_only shouldn't back off on offset pointer
+From: Gutorm.Hogasen@oslo.teamco.telenor.no
+Files patched: sv.h
+ SvPOK_only() was calling SvOOK_off(), which adjusted the string pointer
+ after tr/// has already acquired it.  It shouldn't really be necessary
+ for SvPOK_only() to undo an offset string pointer, since there's no
+ conflict with a possible integer value where the offset is stored.
+
+NETaa15193: & now always bypasses prototype checking
+From: Larry Wall
+Files patched: dump.c op.c op.h perly.c perly.c.diff perly.y pod/perlsub.pod pp_hot.c proto.h toke.c vms/perly_c.vms vms/perly_h.vms
+ Turned out to be a big hairy deal because the lexer turns foo() into &foo().
+ But it works consistently now.  Also fixed pod.
+
+NETaa15197: 5.002b2 is 'appending' to $@
+From: Gurusamy Sarathy
+Files patched: pp_ctl.c
+ Applied suggested patch.
+
+NETaa15201: working around Linux DBL_DIG problems
+From: Kenneth Albanowski
+Files patched: hints/linux.sh sv.c
+ Applied suggested patch.
+
+NETaa15208: SelectSaver
+From: Chip Salzenberg
+Files patched: MANIFEST lib/SelectSaver.pm
+ Applied suggested patch.
+
+NETaa15209: DirHandle
+From: Chip Salzenberg
+Files patched: MANIFEST lib/DirHandle.pm t/lib/dirhand.t
+
+NETaa15210: sysopen()
+From: Chip Salzenberg
+Files patched: doio.c keywords.pl lib/ExtUtils/typemap opcode.pl pod/perlfunc.pod pp_hot.c pp_sys.c proto.h toke.c
+ Applied suggested patch.  Hope it works...
+
+NETaa15211: use mnemonic names in Safe setup
+From: Chip Salzenberg
+Files patched: ext/Safe/Safe.pm
+ Applied suggested patch, more or less.
+
+NETaa15214: prototype()
+From: Chip Salzenberg
+Files patched: ext/Safe/Safe.pm global.sym keywords.pl opcode.pl pp.c toke.c
+ Applied suggested patch.
+
+NETaa15217: -w problem with -d:foo
+From: Tim Bunce
+Files patched: perl.c
+ Applied suggested patch.
+
+NETaa15218: *GLOB{ELEMENT}
+From: Larry Wall
+Files patched: Makefile.SH embed.h ext/Safe/Safe.pm keywords.h opcode.h opcode.h opcode.pl perly.c perly.c.diff perly.y pp_hot.c t/lib/safe.t vms/perly_c.vms
+
+NETaa15219: Make *x=\*y do like *x=*y
+From: Chip Salzenberg
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa15221: Indigestion with Carp::longmess and big eval '...'s
+From: Tim Bunce
+Files patched: lib/Carp.pm
+ Applied suggested patch.
+
+NETaa15222: VERSION patch for standard extensions
+From: Paul Marquess
+Files patched: ext/DB_File/Makefile.PL ext/DynaLoader/DynaLoader.pm ext/DynaLoader/Makefile.PL ext/Fcntl/Fcntl.pm ext/Fcntl/Makefile.PL ext/GDBM_File/GDBM_File.pm ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/NDBM_File/NDBM_File.pm ext/ODBM_File/Makefile.PL ext/ODBM_File/ODBM_File.pm ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/SDBM_File/Makefile.PL ext/SDBM_File/SDBM_File.pm ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Socket/Makefile.PL
+ Applied suggested patch.
+
+NETaa15222: VERSION patch for standard extensions (reprise)
+Files patched: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm ext/POSIX/POSIX.pm ext/SDBM_File/SDBM_File.pm ext/Safe/Safe.pm ext/Socket/Socket.pm
+ (same)
+
+NETaa15227: $i < 10000 should optimize to integer op
+From: Larry Wall
+Files patched: op.c op.c
+ The program
+     for ($i = 0; $i < 100000; $i++) {
+       push @foo, $i;
+     }
+ takes about one quarter the memory if the optimizer decides that it can
+ use an integer < comparison rather than floating point.  It now does so
+ if one side is an integer constant and the other side a simple variable.
+ This should really help some of our benchmarks.  You can still force a
+ floating point comparison by using 100000.0 instead.
+
+NETaa15228: CPerl-mode patch
+From: Ilya Zakharevich
+Files patched: emacs/cperl-mode.el
+ Applied suggested patch.
+
+NETaa15231: Symbol::qualify()
+From: Chip Salzenberg
+Files patched: ext/FileHandle/FileHandle.pm gv.c lib/SelectSaver.pm lib/Symbol.pm pp_hot.c
+ Applied suggested patch.
+
+NETaa15236: select select broke under use strict
+From: Chip Salzenberg
+Files patched: op.c
+ Instead of inventing a new bit, I just turned off the HINT_STRICT_REFS bit.
+ I don't think it's worthwhile distinguishing between qualified or unqualified
+ names to select.
+
+NETaa15237: use vars
+From: Larry Wall
+Files patched: MANIFEST gv.c lib/subs.pm lib/vars.pm sv.c
+
+NETaa15240: keep op names _and_ descriptions
+From: Chip Salzenberg
+Files patched: doio.c embed.h ext/Safe/Safe.pm ext/Safe/Safe.xs global.sym op.c opcode.h opcode.pl scope.c sv.c
+ Applied suggested patch.
+
+NETaa15259: study doesn't unset on string modification
+From: Larry Wall
+Files patched: mg.c pp.c
+ Piggybacked on m//g unset magic to unset the study too.
+
+NETaa15276: pick a better initial cxstack_max
+From: Chip Salzenberg
+Files patched: perl.c
+ Added fudge in, and made it calculate how many it could fit into (most of) 8K,
+ to avoid getting 16K of Kingsley malloc.
+
+NETaa15287: numeric comparison optimization adjustments
+From: Clark Cooper
+Files patched: op.c
+ Applied patch suggested by Chip, with liberalization to >= and <=.
+
+NETaa15299: couldn't eval string containing pod or __DATA__     
+From: Andreas Koenig
+Also: Gisle Aas
+Files patched: toke.c
+ Basically, eval didn't know how to bypass pods correctly.
+
+NETaa15300: sv_backoff problems
+From: Paul Marquess
+Also: mtr
+Also: Chip Salzenberg
+Files patched: op.c sv.c sv.h
+ Applied suggested patch.
+
+NETaa15312: Avoid fclose(NULL)
+From: Chip Salzenberg
+Files patched: toke.c
+ Applied suggested patch.
+
+NETaa15318: didn't set up perl_init_i18nl14n for export
+From: Ilya Zakharevich
+Files patched: perl_exp.SH
+ Applied suggested patch.
+
+NETaa15331: File::Path::rmtree followed symlinks
+From: Andreas Koenig
+Files patched: lib/File/Path.pm
+ Added suggested patch, except I did
+        if (not -l $root and -d _) {
+ for efficiency, since if -d is true, the -l already called lstat on it.
+
+NETaa15339: sv_gets() didn't reset count
+From: alanburlison@unn.unisys.com
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa15341: differentiated importation of different types
+From: Chip Salzenberg
+Files patched: gv.c gv.h op.c perl.c pp.c pp_ctl.c sv.c sv.h toke.c
+ Applied suggested patch.
+
+NETaa15342: Consistent handling of e_{fp,tmpname}
+From: Chip Salzenberg
+Files patched: perl.c pp_ctl.c util.c
+ Applied suggested patch.
+
+NETaa15344: Safe gets confused about malloc on AIX
+From: Tim Bunce
+Files patched: ext/Safe/Safe.xs
+ Applied suggested patch.
+
+NETaa15348: -M upgrade
+From: Tim Bunce
+Files patched: perl.c pod/perlrun.pod
+ Applied suggested patch.
+
+NETaa15369: change in split optimization broke scalar context
+From: Ulrich Pfeifer
+Files patched: op.c
+ The earlier patch to make the split optimization pay attention to
+ OPpASSIGN_COMMON rearranged how the syntax tree is constructed, but kept
+ the wrong context flags.  This causes pp_split() do do the wrong thing.
+
+NETaa15423: can't do subversion numbering because of %5.3f assumptions
+From: Andy Dougherty
+Files patched: configpm patchlevel.h perl.c perl.h pp_ctl.c
+ Removed the %5.3f assumptions where appropriate.  patchlevel.h now
+ defines SUBVERSION, which if greater than 0 indicates a development version.
+
+NETaa15424: Sigsetjmp patch
+From: Kenneth Albanowski
+Files patched: Configure config_h.SH op.c perl.c perl.h pp_ctl.c util.c
+ Applied suggested patch.
+
 Needed to make install paths absolute.
 Files patched: installperl
 
-derived it
-Files patched: perly.h
+h2xs 1.14
+Files patched: utils/h2xs.PL
 
 makedir() looped on a symlink to a directory.
 Files patched: installperl
 
+xsubpp 1.932
+Files patched: lib/ExtUtils/xsubpp
 
 -------------
 Version 5.001
index 96b9376..d5ea551 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $
 #
-# Generated on Fri Feb  9 14:09:07 EST 1996 [metaconfig 3.0 PL60]
+# Generated on Wed Feb 21 14:26:18 EST 1996 [metaconfig 3.0 PL60]
 
 cat >/tmp/c1$$ <<EOF
 ARGGGHHHH!!!!!
@@ -362,6 +362,7 @@ shmattype=''
 d_shmctl=''
 d_shmdt=''
 d_shmget=''
+d_sigsetjmp=''
 d_sigaction=''
 d_sigintrp=''
 d_sigvec=''
@@ -1011,7 +1012,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE.
 You have the option of continuing the configuration process, despite the
 distinct possibility that your kit is damaged, by typing 'y'es.  If you
 do, don't blame me if something goes wrong.  I advise you to type 'n'o
-and contact the author (lwall@sems.com).
+and contact the author (doughera@lafcol.lafayette.edu).
 
 EOM
                echo $n "Continue? [n] $c" >&4
@@ -1208,7 +1209,7 @@ Much effort has been expended to ensure that this shell script will run on any
 Unix system.  If despite that it blows up on yours, your best bet is to edit
 Configure and run it again.  If you can't run Configure for some reason,
 you'll have to generate a config.sh file by hand.  Whatever problems you
-have, let me (lwall@sems.com) know how I blew it.
+have, let me (doughera@lafcol.lafayette.edu) know how I blew it.
 
 This installation script affects things in two ways:
 
@@ -1552,7 +1553,7 @@ EOM
        cd hints; ls -C *.sh | $sed 's/\.sh/   /g' >&4
        dflt=''
        : Half the following guesses are probably wrong... If you have better
-       : tests or hints, please send them to lwall@sems.com
+       : tests or hints, please send them to doughera@lafcol.lafayette.edu
        : The metaconfig authors would also appreciate a copy...
        $test -f /irix && osname=irix
        $test -f /xenix && osname=sco_xenix
@@ -6619,6 +6620,50 @@ fi
 set sigaction d_sigaction
 eval $inlibc
 
+
+: see if sigsetjmp exists
+echo " "
+case "$d_sigsetjmp" in
+'')
+       $cat >set.c <<EOP
+#include <setjmp.h>
+sigjmp_buf env;
+int set = 1;
+main()
+{
+       if (sigsetjmp(env,1))
+               exit(set);
+       set = 0;
+       siglongjmp(env, 1);
+       exit(1);
+}
+EOP
+       if $cc $ccflags $ldflags set.c -o set $libs >/dev/null 2>&1; then
+               if ./set >/dev/null 2>&1; then
+                       echo "POSIX sigsetjmp found." >&4
+                       val="$define"
+               else
+                       $cat <<EOM
+Uh-Oh! You have POSIX sigsetjmp and siglongjmp, but they do not work properly!!
+EOM
+                       val="$undef"
+               fi
+       else
+               echo "Sigsetjmp not found." >&4
+               val="$undef"
+       fi
+       ;;
+*) val="$d_sigsetjmp"
+       case "$d_sigsetjmp" in
+       $define) echo "POSIX sigsetjmp found." >&4;;
+       $undef) echo "Sigsetjmp not found." >&4;;
+       esac
+       ;;
+esac
+set d_sigsetjmp
+eval $setvar
+$rm -f set.c set
+
 socketlib=''
 sockethdr=''
 : see whether socket exists
@@ -9053,6 +9098,7 @@ d_shmget='$d_shmget'
 d_shrplib='$d_shrplib'
 d_sigaction='$d_sigaction'
 d_sigintrp='$d_sigintrp'
+d_sigsetjmp='$d_sigsetjmp'
 d_sigvec='$d_sigvec'
 d_sigvectr='$d_sigvectr'
 d_socket='$d_socket'
diff --git a/INSTALL b/INSTALL
index a5adde2..f99a807 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -549,6 +549,11 @@ page, however.  You may need to be root to run B<make install>.  If you
 are not root, you must own the directories in question and you should
 ignore any messages about chown not working.
 
+B<Note:>  In the 5.002 release, you will see some harmless error
+messages and warnings from pod2man.  You may safely ignore them.  (Yes,
+they should be fixed, but they didn't seem important enough to warrant
+holding up the entire 5.002 release.)
+
 If you want to see exactly what will happen without installing
 anything, you can run
 
@@ -675,6 +680,6 @@ is sometimes useful for finding things in the library modules.
 Andy Dougherty <doughera@lafcol.lafayette.edu>, borrowing I<very> heavily
 from the original README by Larry Wall.
 
-=head 2 LAST MODIFIED
+=head1 LAST MODIFIED
 
 04 January 1996
index 4aec3cb..f49cdd3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -104,6 +104,7 @@ ext/NDBM_File/Makefile.PL   NDBM extension makefile writer
 ext/NDBM_File/NDBM_File.pm     NDBM extension Perl module
 ext/NDBM_File/NDBM_File.xs     NDBM extension external subroutines
 ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture
+ext/NDBM_File/hints/svr4.pl    Hint for NDBM_File for named architecture
 ext/NDBM_File/typemap          NDBM extension interface types
 ext/ODBM_File/Makefile.PL      ODBM extension makefile writer
 ext/ODBM_File/ODBM_File.pm     ODBM extension Perl module
@@ -368,7 +369,6 @@ os2/diff.Makefile   Patches to Makefile.SH
 os2/diff.c2ph          c2ph patch
 os2/diff.configure     Patches to Configure
 os2/diff.db_file       patch to DB_File
-os2/diff.exec          patch to #ifdef lines to exec with sh
 os2/diff.installman    Patches to installman
 os2/diff.installperl   Patches to installperl
 os2/diff.mkdep         Patches to makedepend.SH
@@ -465,6 +465,7 @@ t/comp/multiline.t  See if multiline strings work
 t/comp/package.t       See if packages work
 t/comp/script.t                See if script invokation works
 t/comp/term.t          See if more terms work
+t/harness              Finer diagnostics from test suite
 t/io/argv.t            See if ARGV stuff works
 t/io/dup.t             See if >& works right
 t/io/fs.t              See if directory manipulations work
index a530103..fd64ce3 100644 (file)
@@ -172,15 +172,16 @@ you omit this step, you risk ending up with a copy of Perl which
 composed partially of old files and partially of new ones, which may lead
 to strange effects when you try to run Perl.
 
-Note for sites using DECC:  A bug in some early versions of the DECC RTL on the
-AXP causes newlines to be lost when writing to a pipe.  This causes
-Gen_ShrFls.pl to fail, since it can't read the preprocessor output to identify
-global variables and routines.  A different bug in the DECC preprocessor itself
-for some patched versions of DECC 4.0 on the VAX also makes it impossible for
-Gen_ShrFls.pl to parse the preprocessor output.  In either case, the problem is
-generally manifested as missing global symbols when linking PerlShr.Exe or
-Perl.Exe.  You can work around this problem by defining the macro
-DECC_PIPES_BROKEN when you invoke MMS or MMK.
+A bug in some early versions of the DECC RTL on the AXP causes newlines
+to be lost when writing to a pipe.  A different bug in some patched versions
+of DECC 4.0 for VAX can also scramble preprocessor output.  Finally, gcc 2.7.2
+has yet another preprocessor bug, which causes line breaks to be inserted
+into the output at inopportune times.  Each of these bugs causes Gen_ShrFls.pl
+to fail, since it can't parse the preprocessor output to identify global
+variables and routines.  This problem is generally manifested as missing
+global symbols when linking PerlShr.Exe or Perl.Exe.  You can work around
+it by defining the macro PIPES_BROKEN when you invoke MMS or MMK.
+
 
 This will build the following files:
   Miniperl.Exe        - a stand-alone version of without any extensions.
old mode 100644 (file)
new mode 100755 (executable)
index 5d82302..ad7a69f
@@ -1389,6 +1389,28 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!'
  */
 #define Gconvert(x,n,t,b) $d_Gconvert
 
+/* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ */
+/* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ */
+#$d_sigsetjmp HAS_SIGSETJMP    /**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask)
+#define Siglongjmp(buf,retval) siglongjmp(buf,retval)
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp(buf)
+#define Siglongjmp(buf,retval) longjmp(buf,retval)
+#endif
+
 /* USE_DYNAMIC_LOADING:
  *     This symbol, if defined, indicates that dynamic loading of
  *     some sort is available.
index 9bfeab5..af1e716 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -16,7 +16,7 @@ $config_pm = $ARGV[0] || 'lib/Config.pm';
 
 
 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
-$myver = sprintf("%.3f", $]);
+$myver = $];
 
 print CONFIG <<"ENDOFBEG";
 package Config;
@@ -25,8 +25,8 @@ use Exporter ();
 \@EXPORT = qw(%Config);
 \@EXPORT_OK = qw(myconfig config_sh config_vars);
 
-\$] == $myver or die sprintf
-    "Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$];
+\$] == $myver
+  or die "Perl lib version ($myver) doesn't match executable version (\$])\\n";
 
 # This file was created by configpm when Perl was built. Any changes
 # made to this file will be lost the next time perl is built.
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/cv.h b/cv.h
index dbeb6d6..b08cf5c 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -26,10 +26,11 @@ struct xpvcv {
     long       xcv_depth;              /* >= 2 indicates recursive call */
     AV *       xcv_padlist;
     CV *       xcv_outside;
-    bool       xcv_oldstyle;
+    U8         xcv_flags;
 };
 
 #define Nullcv Null(CV*)
+
 #define CvSTASH(sv)    ((XPVCV*)SvANY(sv))->xcv_stash
 #define CvSTART(sv)    ((XPVCV*)SvANY(sv))->xcv_start
 #define CvROOT(sv)     ((XPVCV*)SvANY(sv))->xcv_root
@@ -40,5 +41,25 @@ struct xpvcv {
 #define CvDEPTH(sv)    ((XPVCV*)SvANY(sv))->xcv_depth
 #define CvPADLIST(sv)  ((XPVCV*)SvANY(sv))->xcv_padlist
 #define CvOUTSIDE(sv)  ((XPVCV*)SvANY(sv))->xcv_outside
-#define CvOLDSTYLE(sv) ((XPVCV*)SvANY(sv))->xcv_oldstyle
+#define CvFLAGS(sv)    ((XPVCV*)SvANY(sv))->xcv_flags
+
+#define CVf_CLONE      0x01    /* anon CV uses external lexicals */
+#define CVf_CLONED     0x02    /* a clone of one of those */
+#define CVf_ANON       0x04    /* CvGV() can't be trusted */
+#define CVf_OLDSTYLE   0x08
+
+#define CvCLONE(cv)            (CvFLAGS(cv) & CVf_CLONE)
+#define CvCLONE_on(cv)         (CvFLAGS(cv) |= CVf_CLONE)
+#define CvCLONE_off(cv)                (CvFLAGS(cv) &= ~CVf_CLONE)
+
+#define CvCLONED(cv)           (CvFLAGS(cv) & CVf_CLONED)
+#define CvCLONED_on(cv)                (CvFLAGS(cv) |= CVf_CLONED)
+#define CvCLONED_off(cv)       (CvFLAGS(cv) &= ~CVf_CLONED)
+
+#define CvANON(cv)             (CvFLAGS(cv) & CVf_ANON)
+#define CvANON_on(cv)          (CvFLAGS(cv) |= CVf_ANON)
+#define CvANON_off(cv)         (CvFLAGS(cv) &= ~CVf_ANON)
 
+#define CvOLDSTYLE(cv)         (CvFLAGS(cv) & CVf_OLDSTYLE)
+#define CvOLDSTYLE_on(cv)      (CvFLAGS(cv) |= CVf_OLDSTYLE)
+#define CvOLDSTYLE_off(cv)     (CvFLAGS(cv) &= ~CVf_OLDSTYLE)
diff --git a/doio.c b/doio.c
index 9284259..f28da95 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -278,7 +278,7 @@ FILE *supplied_fp;
     if (saveifp) {             /* must use old fp? */
        fd = fileno(saveifp);
        if (saveofp) {
-           fflush(saveofp);            /* emulate fclose() */
+           Fflush(saveofp);            /* emulate fclose() */
            if (saveofp != saveifp) {   /* was a socket? */
                fclose(saveofp);
                if (fd > 2)
@@ -344,7 +344,7 @@ register GV *gv;
     if (!argvoutgv)
        argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
     if (filemode & (S_ISUID|S_ISGID)) {
-       fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
+       Fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
        (void)fchmod(lastfd,filemode);
 #else
index a3a4acc..76761e3 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -14,5 +14,6 @@
 
 #define Stat(fname,bufptr) stat((fname),(bufptr))
 #define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
 
 #define my_getenv(var)  getenv(var)
index d6832db..1d1fe18 100644 (file)
@@ -32,6 +32,11 @@ FileHandle - supply object methods for filehandles
         undef $fh;       # automatically closes the file
     }
 
+    $pos = $fh->getpos;
+    $fh->setpos $pos;
+
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
     ($readfh, $writefh) = FileHandle::pipe;
 
     autoflush STDOUT 1;
@@ -60,6 +65,21 @@ C<FileHandle::fdopen> is like C<open> except that its first parameter
 is not a filename but rather a file handle name, a FileHandle object,
 or a file descriptor number.
 
+If the C functions fgetpos() and fsetpos() are available, then
+C<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+sets the buffering policy for the FileHandle.  The calling sequence
+for the Perl function is the same as its C counterpart, including the
+macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
+parameter specifies a scalar variable to use as a buffer.  WARNING: A
+variable used as a buffer by C<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
 See L<perlfunc> for complete descriptions of each of the following
 supported C<FileHandle> methods, which are just front ends for the
 corresponding built-in functions:
index 339439c..601a3c2 100644 (file)
@@ -15,3 +15,21 @@ bootstrap NDBM_File $VERSION;
 1;
 
 __END__
+
+=head1 NAME
+
+NDBM_File - Tied access to ndbm files
+
+=head1 SYNOPSIS
+
+ use NDBM_File;
+
+ tie(%h,NDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
diff --git a/ext/NDBM_File/hints/svr4.pl b/ext/NDBM_File/hints/svr4.pl
new file mode 100644 (file)
index 0000000..3285d9a
--- /dev/null
@@ -0,0 +1,4 @@
+# Some SVR4 systems may need to link against routines in -lucb for
+# odbm.  Some may also need to link against -lc to pick up things like
+# ecvt.
+$self->{LIBS} = ['-ldbm -lucb -lc'];
index a96916b..e5386e8 100644 (file)
@@ -15,3 +15,21 @@ bootstrap ODBM_File $VERSION;
 1;
 
 __END__
+
+=head1 NAME
+
+ODBM_File - Tied access to odbm files
+
+=head1 SYNOPSIS
+
+ use ODBM_File;
+
+ tie(%h,ODBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
index deb72f1..9b7acc1 100644 (file)
@@ -15,3 +15,21 @@ bootstrap SDBM_File $VERSION;
 1;
 
 __END__
+
+=head1 NAME
+
+SDBM_File - Tied access to sdbm files
+
+=head1 SYNOPSIS
+
+ use SDBM_File;
+
+ tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
index f970a62..6b25924 100644 (file)
@@ -2,6 +2,9 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* maxo should never differ from MAXO but leave some room anyway */
+#define OP_MASK_BUF_SIZE (MAXO + 100)
+
 MODULE = Safe  PACKAGE = Safe
 
 void
@@ -13,14 +16,15 @@ safe_call_sv(package, mask, codesv)
        int i;
        char *str;
        STRLEN len;
+       char op_mask_buf[OP_MASK_BUF_SIZE];
 
+       assert(maxo < OP_MASK_BUF_SIZE);
        ENTER;
        SAVETMPS;
        save_hptr(&defstash);
        save_aptr(&endav);
        SAVEPPTR(op_mask);
-       Newz(666, op_mask, maxo+1, char);
-       SAVEFREEPV(op_mask);
+       op_mask = &op_mask_buf[0];
        str = SvPV(mask, len);
        if (maxo != len)
            croak("Bad mask length");
@@ -62,8 +66,8 @@ void
 ops_to_mask(...)
     CODE:
        int i, j;
-       char *mask, *op;
-       Newz(666, mask, maxo+1, char);
+       char mask[OP_MASK_BUF_SIZE], *op;
+       Zero(mask, sizeof mask, char);
        for (i = 0; i < items; i++)
        {
            op = SvPV(ST(i), na);
@@ -76,8 +80,7 @@ ops_to_mask(...)
                croak("bad op name \"%s\" in mask", op);
            }
        }
-       ST(0) = sv_newmortal();
-       sv_usepvn(ST(0), mask, maxo);
+       ST(0) = sv_2mortal(newSVpv(mask,maxo));
 
 void
 opname(...)
diff --git a/gv.c b/gv.c
index 7836d88..8cf552a 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -65,7 +65,7 @@ char *name;
     gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
     if (perldb)
        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
@@ -96,7 +96,7 @@ int multi;
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
 }
 
 static void
@@ -366,7 +366,7 @@ I32 sv_type;
                gv = *gvp;
 
                if (SvTYPE(gv) == SVt_PVGV)
-                   SvMULTI_on(gv);
+                   GvMULTI_on(gv);
                else if (!add)
                    return Nullgv;
                else
@@ -432,15 +432,16 @@ I32 sv_type;
                {
                    gvp = (GV**)hv_fetch(stash,name,len,0);
                    if (!gvp ||
-                           *gvp == (GV*)&sv_undef ||
-                           SvTYPE(*gvp) != SVt_PVGV ||
-                           !(GvFLAGS(*gvp) & GVf_IMPORTED))
+                       *gvp == (GV*)&sv_undef ||
+                       SvTYPE(*gvp) != SVt_PVGV)
+                   {
                        stash = 0;
-                   else if (sv_type == SVt_PVAV && !GvAV(*gvp) ||
-                            sv_type == SVt_PVHV && !GvHV(*gvp) ||
-                            sv_type == SVt_PV   && !GvSV(*gvp) )
+                   }
+                   else if (sv_type == SVt_PV   && !GvIMPORTED_SV(*gvp) ||
+                            sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
+                            sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
                    {
-                       warn("Variable \"%c%s\" is not exported",
+                       warn("Variable \"%c%s\" is not imported",
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
                            name);
@@ -478,7 +479,7 @@ I32 sv_type;
     gv = *gvp;
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            gv_init_sv(gv, sv_type);
        }
        return gv;
@@ -502,16 +503,16 @@ I32 sv_type;
     case 'a':
     case 'b':
        if (len == 1)
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'E':
        if (strnEQ(name, "EXPORT", 6))
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'I':
        if (strEQ(name, "ISA")) {
            AV* av = GvAVn(gv);
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
            if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
            {
@@ -533,7 +534,7 @@ I32 sv_type;
     case 'O':
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
-            SvMULTI_on(gv);
+            GvMULTI_on(gv);
             sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
         }
         break;
@@ -542,7 +543,7 @@ I32 sv_type;
        if (strEQ(name, "SIG")) {
            HV *hv;
            siggv = gv;
-           SvMULTI_on(siggv);
+           GvMULTI_on(siggv);
            hv = GvHVn(siggv);
            hv_magic(hv, siggv, 'S');
 
@@ -699,7 +700,7 @@ newIO()
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
-    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO);
+    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
@@ -726,12 +727,12 @@ HV* stash;
            }
            else if (isALPHA(*entry->hent_key)) {
                gv = (GV*)entry->hent_val;
-               if (SvMULTI(gv))
+               if (GvMULTI(gv))
                    continue;
                curcop->cop_line = GvLINE(gv);
                filegv = GvFILEGV(gv);
                curcop->cop_filegv = filegv;
-               if (filegv && SvMULTI(filegv))  /* Filename began with slash */
+               if (filegv && GvMULTI(filegv))  /* Filename began with slash */
                    continue;
                warn("Identifier \"%s::%s\" used only once: possible typo",
                        HvNAME(stash), GvNAME(gv));
diff --git a/gv.h b/gv.h
index 3dd0ec8..b823fa5 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -20,7 +20,6 @@ struct gp {
     I32                gp_lastexpr;    /* used by nothing_in_common() */
     line_t     gp_line;        /* line first declared at (for -w) */
     GV *       gp_filegv;      /* file first declared in (for -w) */
-    char       gp_flags;
 };
 
 #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
@@ -29,6 +28,12 @@ struct gp {
 
 #define GvXPVGV(gv)    ((XPVGV*)SvANY(gv))
 
+#define GvGP(gv)       (GvXPVGV(gv)->xgv_gp)
+#define GvNAME(gv)     (GvXPVGV(gv)->xgv_name)
+#define GvNAMELEN(gv)  (GvXPVGV(gv)->xgv_namelen)
+#define GvSTASH(gv)    (GvXPVGV(gv)->xgv_stash)
+#define GvFLAGS(gv)    (GvXPVGV(gv)->xgv_flags)
+
 #define GvSV(gv)       (GvGP(gv)->gp_sv)
 #define GvREFCNT(gv)   (GvGP(gv)->gp_refcnt)
 #define GvIO(gv)       ((gv) && SvTYPE((SV*)gv) == SVt_PVGV ? GvIOp(gv) : 0)
@@ -63,18 +68,51 @@ HV *GvHVn();
 #define GvLINE(gv)     (GvGP(gv)->gp_line)
 #define GvFILEGV(gv)   (GvGP(gv)->gp_filegv)
 
-#define GvFLAGS(gv)    (GvGP(gv)->gp_flags)
-
 #define GvEGV(gv)      (GvGP(gv)->gp_egv)
-
-#define GvGP(gv)       (GvXPVGV(gv)->xgv_gp)
-#define GvNAME(gv)     (GvXPVGV(gv)->xgv_name)
-#define GvNAMELEN(gv)  (GvXPVGV(gv)->xgv_namelen)
 #define GvENAME(gv)    GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
-
-#define GvSTASH(gv)    (GvXPVGV(gv)->xgv_stash)
 #define GvESTASH(gv)   GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv)
 
+#define GVf_INTRO      0x01
+#define GVf_MULTI      0x02
+#define GVf_ASSUMECV   0x04
+#define GVf_IMPORTED   0xF0
+#define GVf_IMPORTED_SV          0x10
+#define GVf_IMPORTED_AV          0x20
+#define GVf_IMPORTED_HV          0x40
+#define GVf_IMPORTED_CV          0x80
+
+#define GvINTRO(gv)            (GvFLAGS(gv) & GVf_INTRO)
+#define GvINTRO_on(gv)         (GvFLAGS(gv) |= GVf_INTRO)
+#define GvINTRO_off(gv)                (GvFLAGS(gv) &= ~GVf_INTRO)
+
+#define GvMULTI(gv)            (GvFLAGS(gv) & GVf_MULTI)
+#define GvMULTI_on(gv)         (GvFLAGS(gv) |= GVf_MULTI)
+#define GvMULTI_off(gv)                (GvFLAGS(gv) &= ~GVf_MULTI)
+
+#define GvASSUMECV(gv)         (GvFLAGS(gv) & GVf_ASSUMECV)
+#define GvASSUMECV_on(gv)      (GvFLAGS(gv) |= GVf_ASSUMECV)
+#define GvASSUMECV_off(gv)     (GvFLAGS(gv) &= ~GVf_ASSUMECV)
+
+#define GvIMPORTED(gv)         (GvFLAGS(gv) & GVf_IMPORTED)
+#define GvIMPORTED_on(gv)      (GvFLAGS(gv) |= GVf_IMPORTED)
+#define GvIMPORTED_off(gv)     (GvFLAGS(gv) &= ~GVf_IMPORTED)
+
+#define GvIMPORTED_SV(gv)      (GvFLAGS(gv) & GVf_IMPORTED_SV)
+#define GvIMPORTED_SV_on(gv)   (GvFLAGS(gv) |= GVf_IMPORTED_SV)
+#define GvIMPORTED_SV_off(gv)  (GvFLAGS(gv) &= ~GVf_IMPORTED_SV)
+
+#define GvIMPORTED_AV(gv)      (GvFLAGS(gv) & GVf_IMPORTED_AV)
+#define GvIMPORTED_AV_on(gv)   (GvFLAGS(gv) |= GVf_IMPORTED_AV)
+#define GvIMPORTED_AV_off(gv)  (GvFLAGS(gv) &= ~GVf_IMPORTED_AV)
+
+#define GvIMPORTED_HV(gv)      (GvFLAGS(gv) & GVf_IMPORTED_HV)
+#define GvIMPORTED_HV_on(gv)   (GvFLAGS(gv) |= GVf_IMPORTED_HV)
+#define GvIMPORTED_HV_off(gv)  (GvFLAGS(gv) &= ~GVf_IMPORTED_HV)
+
+#define GvIMPORTED_CV(gv)      (GvFLAGS(gv) & GVf_IMPORTED_CV)
+#define GvIMPORTED_CV_on(gv)   (GvFLAGS(gv) |= GVf_IMPORTED_CV)
+#define GvIMPORTED_CV_off(gv)  (GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
+
 #define Nullgv Null(GV*)
 
 #define DM_UID   0x003
@@ -85,9 +123,6 @@ HV *GvHVn();
 #define DM_EGID   0x020
 #define DM_DELAY 0x100
 
-#define GVf_INTRO      0x01
-#define GVf_IMPORTED   0x02
-
 #define GV_ADD         0x01
 #define GV_ADDMULTI    0x02
 #define GV_ADDWARN     0x04
index 6a4c585..a9f277e 100644 (file)
@@ -15,6 +15,8 @@ d_setruid='undef'
 
 alignbytes=8
 
+usemymalloc='n'
+
 # Make setsockopt work correctly.  See man page.
 # ccflags='-D_BSD=44'
 
index 2c3126d..0f8d33c 100644 (file)
@@ -24,7 +24,7 @@ ldflags="$ldflags"
 # ANSI C (the -Aa flag) nor can it produce shared libraries.  Thus we have
 # to turn off dynamic loading.
 case "$cc" in
-'') if cc $ccflags -Aa 2>&1 | $contains 'Unknown option "A"' >/dev/null
+'') if cc $ccflags -Aa 2>&1 | $contains 'option' >/dev/null
     then
        case "$usedl" in
         '') usedl="$undef"
index 3dedb33..cbeafcb 100644 (file)
@@ -82,6 +82,7 @@ EOM
     ccflags="-DOVR_DBL_DIG=14 $ccflags"
     so='sa'
     dlext='o'
+    nm_so_opt=' '
     ## If you are using DLD 3.2.4 which does not support shared libs,
     ## uncomment the next two lines:
     #ldflags="-static"
index c972665..d4fb71d 100644 (file)
@@ -84,10 +84,6 @@ usedl='define'
 
 #cppflags='-DDOSISH -DOS2=2 -DEMBED -I.'
 
-# This variables taken from recommended config.sh
-# [Does Configure get it wrong?]
-alignbytes='8'
-
 # for speedup: (some patches to ungetc are also needed):
 # Note that without this guy tests 8 and 10 of io/tell.t fail, with it 11 fails
 
index 5e8a6b0..307e27e 100644 (file)
@@ -1,7 +1,19 @@
 # sco_3.sh 
 # Courtesy of Joel Rosi-Schwartz <joel@ftechne.co.uk>
-# To use gcc, do     Configure -Dcc=gcc
-#
+# Additional SCO version info from
+# Peter Wolfe  <wolfe@teloseng.com>
+# Last revised 
+# Tue Feb 13 09:09:10 EST 1996
+
+# To use gcc, use     sh Configure -Dcc=gcc
+
+# figure out what SCO version we are:
+case `uname -X | egrep '^Release'` in
+*3.2v4.2) scorls=3 ;;
+*3.2v5.*) scorls=5 ;;
+*) scorls=3 ;; # this probabaly shouldn't happen
+esac
+
 # Try to use libintl.a since it has strcoll and strxfrm
 libswanted="intl $libswanted"
 # Try to use libdbm.nfs.a since it has dbmclose.
@@ -12,11 +24,11 @@ fi
 set X $libswanted
 shift
 libswanted="$*"
-# 
+
 # We don't want Xenix cross-development libraries
 glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'`
 xlibpth=''
-# 
+
 case "$cc" in
 gcc)
        ccflags="$ccflags -U M_XENIX"
@@ -24,10 +36,12 @@ gcc)
        ;;
 scocc) ;;
 
-*)
-       # Apparently, SCO's cc gives rather verbose warnings
+*)     # Apparently, SCO's cc gives rather verbose warnings
        # Set -w0 to turn them off.
-       ccflags="$ccflags -w0 -U M_XENIX"
+       case $scorls in
+       3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
+       5) ccflags="$ccflags -w0 -U M_XENIX" ;;
+       esac
        ;;
 esac
 i_varargs=undef
index f4664d9..5569274 100644 (file)
@@ -26,6 +26,12 @@ if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library:
 fi
 d_suidsafe='define'    # "./Configure -d" can't figure this out easilly
 usevfork='false'
+
+# Configure may fail to find lstat() since it's a static/inline
+# function in <sys/stat.h> on Unisys U6000 SVR4, and possibly
+# other SVR4 derivatives.
+d_lstat=define
+
 cat <<'EOM' >&4
 
 If you wish to use dynamic linking, you must use 
old mode 100755 (executable)
new mode 100644 (file)
index e88b899..1a1f8b1 100644 (file)
@@ -61,6 +61,10 @@ __END__
 
 ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker
 
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed
+
 =head1 DESCRIPTION
 
 See ExtUtils::MM_Unix for a documentation of the methods provided
index cabb1be..bbaef15 100644 (file)
@@ -65,7 +65,7 @@ with a directory
 
 sub catdir  {
     shift;
-    my $result = join('/',@_,'/');
+    my $result = join('/',@_);
     $result =~ s:/\./:/:g;
     $result =~ s:/+:/:g;
     $result;
@@ -689,7 +689,7 @@ sub init_dirscan {  # --- File and Directory Lists (.xs .pm .pod etc)
            my($c); ($c = $name) =~ s/\.xs$/.c/;
            $xs{$name} = $c;
            $c{$c} = 1;
-       } elsif ($name =~ /\.c$/i){
+       } elsif ($name =~ /\.c(pp|xx|c)?$/i){  # .c .C .cpp .cxx .cc
            $c{$name} = 1
                unless $name =~ m/perlmain\.c/; # See MAP_TARGET
        } elsif ($name =~ /\.h$/i){
@@ -772,7 +772,7 @@ sub init_dirscan {  # --- File and Directory Lists (.xs .pm .pod etc)
     $self->{PM}  = \%pm             unless $self->{PM};
     $self->{C}   = [sort keys %c]   unless $self->{C};
     my(@o_files) = @{$self->{C}};
-    $self->{O_FILES} = [grep s/\.c$/$self->{OBJ_EXT}/i, @o_files] ;
+    $self->{O_FILES} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ;
     $self->{H}   = [sort keys %h]   unless $self->{H};
     $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES};
 
@@ -1015,7 +1015,8 @@ sub const_config {
     push(@m,"\n# They may have been overridden via Makefile.PL or on the command line\n");
     my(%once_only);
     foreach $m (@{$self->{CONFIG}}){
-       next if $once_only{$m};
+       # SITE*EXP macros are defined in &constants; avoid duplicates here
+       next if $once_only{$m} or $m eq 'SITELIBEXP' or $m eq 'SITEARCHEXP';
        push @m, "\U$m\E = ".$self->{uc $m}."\n";
        $once_only{$m} = 1;
     }
@@ -1096,7 +1097,7 @@ MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
 # work around a famous dec-osf make(1) feature(?):
 makemakerdflt: all
 
-.SUFFIXES: .xs .c .C \$(OBJ_EXT)
+.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT)
 
 # Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
 # some make implementations will delete the Makefile when we rebuild it. Because
@@ -1641,6 +1642,15 @@ sub c_o {
 
 .C$(OBJ_EXT):
        $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+
+.cpp$(OBJ_EXT):
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
+
+.cxx$(OBJ_EXT):
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx
+
+.cc$(OBJ_EXT):
+       $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc
 ';
     join "", @m;
 }
@@ -2449,9 +2459,9 @@ sub install {
     push @m, q{
 install :: all pure_install doc_install
 
-install_perl :: pure_perl_install doc_perl_install
+install_perl :: all pure_perl_install doc_perl_install
 
-install_site :: pure_site_install doc_site_install
+install_site :: all pure_site_install doc_site_install
 
 install_ :: install_site
        @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
index 8b6625e..7e92a2e 100644 (file)
@@ -3,11 +3,11 @@
 #   This package is inserted into @ISA of MakeMaker's MM before the
 #   built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
 #
-#   Version: 5.17
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
-#   Revised: 14-Jan-1996
 
 package ExtUtils::MM_VMS;
+$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.21 (15-Feb-1996)';
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
 use Config;
 require Exporter;
@@ -15,7 +15,6 @@ use VMS::Filespec;
 use File::Basename;
 
 Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
-unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
 
 sub eliminate_macros {
@@ -99,7 +98,7 @@ sub catdir {
       $rslt = vmspath($self->eliminate_macros($spath)."/$sdir");
     }
     else { $rslt = vmspath($dir); }
-    print "catdir($path,$dir) = |$rslt|\n" if $Verbose >= 3;
+    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
     $rslt;
 }
 
@@ -117,10 +116,13 @@ sub catfile {
       my($spath) = $path;
       $spath =~ s/.dir$//;
       if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
-      else { $rslt = vmsify($self->eliminate_macros($spath).'/'.unixify($file)); }
+      else {
+          $rslt = $self->eliminate_macros($spath);
+          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+      }
     }
     else { $rslt = vmsify($file); }
-    print "catfile($path,$file) = |$rslt|\n" if $Verbose >= 3;
+    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
     $rslt;
 }
 
@@ -197,6 +199,13 @@ sub find_perl{
 }
 
 
+sub path {
+    my(@dirs,$dir,$i);
+    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
+    @dirs;
+}
+
+
 sub maybe_command {
     my($self,$file) = @_;
     return $file if -x $file && ! -d _;
@@ -275,7 +284,7 @@ sub init_others {
     $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
     $self->{NOECHO} ||= '@ ';
     $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"';
-    $self->{RM_RF} = '$(PERL) -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
+    $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
     $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"';
     $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
     $self->{CP} = 'Copy/NoConfirm';
@@ -284,95 +293,14 @@ sub init_others {
     &ExtUtils::MM_Unix::init_others;
 }
 
+
 sub constants {
     my($self) = @_;
     unless (ref $self){
        ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
        $self = $ExtUtils::MakeMaker::Parent[-1];
     }
-    my(@m,$def);
-    push @m, "
-NAME = $self->{NAME}
-DISTNAME = $self->{DISTNAME}
-NAME_SYM = $self->{NAME_SYM}
-VERSION = $self->{VERSION}
-VERSION_SYM = $self->{VERSION_SYM}
-VERSION_MACRO = VERSION
-DEFINE_VERSION = ",'"$(VERSION_MACRO)=""$(VERSION)"""',"
-XS_VERSION = $self->{XS_VERSION}
-XS_VERSION_MACRO = XS_VERSION
-XS_DEFINE_VERSION = ",'"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""',"
-
-# In which library should we install this extension?
-# This is typically the same as PERL_LIB.
-# (also see INST_LIBDIR and relationship to ROOTEXT)
-INST_LIB = ",$self->fixpath($self->{INST_LIB},1),"
-INST_ARCHLIB = ",$self->fixpath($self->{INST_ARCHLIB},1),"
-INST_EXE = ",$self->fixpath($self->{INST_EXE},1),"
-
-PREFIX = $self->{PREFIX}
-
-# AFS users will want to set the installation directories for
-# the final 'make install' early without setting INST_LIB,
-# INST_ARCHLIB, and INST_EXE for the testing phase
-INSTALLPRIVLIB = ",$self->fixpath($self->{INSTALLPRIVLIB},1),'
-INSTALLARCHLIB = ',$self->fixpath($self->{INSTALLARCHLIB},1),'
-INSTALLBIN = ',$self->fixpath($self->{INSTALLBIN},1),'
-
-# Perl library to use when building the extension
-PERL_LIB = ',$self->fixpath($self->{PERL_LIB},1),'
-PERL_ARCHLIB = ',$self->fixpath($self->{PERL_ARCHLIB},1),'
-LIBPERL_A = ',$self->fixpath($self->{LIBPERL_A}),'
-
-MAKEMAKER = ',$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),"
-MM_VERSION = $ExtUtils::MakeMaker::VERSION
-FIRST_MAKEFILE  = ",$self->fixpath($self->{FIRST_MAKEFILE}),'
-MAKE_APERL_FILE = ',$self->fixpath($self->{MAKE_APERL_FILE}),"
-
-PERLMAINCC = $self->{PERLMAINCC}
-";
-
-    if ($self->{PERL_SRC}) {
-         push @m, "
-# Where is the perl source code located?
-PERL_SRC = ",$self->fixpath($self->{PERL_SRC},1);
-        push @m, "
-PERL_VMS = ",$self->catdir($self->{PERL_SRC},q(VMS));
-    }
-    push @m,"
-# Perl header files (will eventually be under PERL_LIB)
-PERL_INC = ",$self->fixpath($self->{PERL_INC},1),"
-# Perl binaries
-PERL = $self->{PERL}
-FULLPERL = $self->{FULLPERL}
-
-# FULLEXT = Pathname for extension directory (eg DBD/Oracle).
-# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT.
-# ROOTEXT = Directory part of FULLEXT with leading slash (e.g /DBD)
-FULLEXT = ",$self->fixpath($self->{FULLEXT},1),"
-BASEEXT = $self->{BASEEXT}
-ROOTEXT = ",($self->{ROOTEXT} eq '') ? '[]' : $self->fixpath($self->{ROOTEXT},1),"
-DLBASE  = $self->{DLBASE}
-";
-
-    push @m, "
-VERSION_FROM = $self->{VERSION_FROM}
-" if defined $self->{VERSION_FROM};
-
-    push @m,'
-INC = ';
-
-    if ($self->{'INC'}) {
-       push @m,'/Include=(';
-       my(@includes) = split(/\s+/,$self->{INC});
-       my($plural);
-       foreach (@includes) {
-           s/^-I//;
-           push @m,', ' if $plural++;
-           push @m,$self->fixpath($_,1);
-       }
-       push @m, ")\n";
-    }
+    my(@m,$def,$macro);
 
     if ($self->{DEFINE} ne '') {
        my(@defs) = split(/\s+/,$self->{DEFINE});
@@ -390,35 +318,99 @@ INC = ';
     }
     $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
 
-    push @m,"
-DEFINE = $self->{DEFINE}
-OBJECT = $self->{OBJECT}
-LDFROM = $self->{LDFROM}
-LINKTYPE = $self->{LINKTYPE}
+    if ($self->{'INC'} && $self->{INC} !~ m!/Include=!i) {
+       my(@val) = ( '/Include=(' );
+       my(@includes) = split(/\s+/,$self->{INC});
+       my($plural);
+       foreach (@includes) {
+           s/^-I//;
+           push @val,', ' if $plural++;
+           push @val,$self->fixpath($_,1);
+       }
+       $self->{INC} = join('',@val,')');
+    }
+
+    # Fix up directory specs
+    $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1)
+                                        : '[]';
+    foreach $macro ( qw [
+            INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB INSTALLARCHLIB
+            INSTALLBIN PERL_LIB PERL_ARCHLIB PERL_INC PERL_SRC FULLEXT
+            INST_MAN1DIR INSTALLMAN1DIR INST_MAN3DIR INSTALLMAN3DIR
+            INSTALLSITELIB INSTALLSITEARCH SITELIBEXP SITEARCHEXP ] ) {
+       next unless defined $self->{$macro};
+       $self->{$macro} = $self->fixpath($self->{$macro},1);
+    }
+    $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC},q(VMS))
+       if ($self->{PERL_SRC});
+                        
+
+
+    # Fix up file specs
+    foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
+       next unless defined $self->{$macro};
+       $self->{$macro} = $self->fixpath($self->{$macro});
+    }
+
+    for $tmp (qw/
+             AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION
+             INST_LIB INST_ARCHLIB INST_EXE PREFIX INSTALLDIRS INSTALLPRIVLIB
+             INSTALLARCHLIB INSTALLSITELIB INSTALLSITEARCH INSTALLBIN PERL_LIB
+             PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
+             FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS
+             PERL_INC PERL FULLPERL
+             / ) {
+       next unless defined $self->{$tmp};
+       push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+
+    push @m, q[
+VERSION_MACRO = VERSION
+DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)"""
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)"""
+
+MAKEMAKER = ],$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[
+MM_VERSION = $ExtUtils::MakeMaker::VERSION
+MM_REVISION = $ExtUtils::MakeMaker::Revision
+MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
+
+# FULLEXT = Pathname for extension directory (eg DBD/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT.
+# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+];
+
+    for $tmp (qw/
+             FULLEXT BASEEXT ROOTEXT DLBASE VERSION_FROM INC DEFINE OBJECT
+             LDFROM LINKTYPE
+             / ) {
+       next unless defined $self->{$tmp};
+       push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m,'
 
 # Handy lists of source code files:
-XS_FILES = ",join(', ', sort keys %{$self->{XS}}),'
+XS_FILES = ',join(', ', sort keys %{$self->{XS}}),'
 C_FILES  = ',join(', ', @{$self->{C}}),'
 O_FILES  = ',join(', ', @{$self->{O_FILES}} ),'
 H_FILES  = ',join(', ', @{$self->{H}}),'
-MAN1PODS = ',join(" \\\n\t", sort keys %{$self->{MAN1PODS}}),'
-MAN3PODS = ',join(" \\\n\t", sort keys %{$self->{MAN3PODS}}),'
-
-# Man installation stuff:
-INST_MAN1DIR = ',$self->fixpath($self->{INST_MAN1DIR},1),'
-INSTALLMAN1DIR = ',$self->fixpath($self->{INSTALLMAN1DIR},1),"
-MAN1EXT = $self->{MAN1EXT}
-
-INST_MAN3DIR = ",$self->fixpath($self->{INST_MAN3DIR},1),'
-INSTALLMAN3DIR = ',$self->fixpath($self->{INSTALLMAN3DIR},1),"
-MAN3EXT = $self->{MAN3EXT}
+MAN1PODS = ',join(', ', sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',join(', ', sort keys %{$self->{MAN3PODS}}),'
 
+';
 
-.SUFFIXES : .xs .c \$(OBJ_EXT)
+    for $tmp (qw/
+             INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+             /) {
+       next unless defined $self->{$tmp};
+       push @m, "$tmp = $self->{$tmp}\n";
+    }
 
-# This extension may link to it's own library (see SDBM_File)";
-    push @m,"
-MYEXTLIB = ",$self->fixpath($self->{MYEXTLIB}),"
+push @m,"
+.SUFFIXES : .xs .c .cpp .cxx \$(OBJ_EXT)
 
 # Here is the Config.pm that we are using/depend on
 CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
@@ -696,7 +688,7 @@ sub tools_other {
        ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
        $self = $ExtUtils::MakeMaker::Parent[-1];
     }
-    "
+    qq!
 # Assumes \$(MMS) invokes MMS or MMK
 # (It is assumed in some cases later that the default makefile name
 # (Descrip.MMS for MM[SK]) is used.)
@@ -713,7 +705,12 @@ RM_F  = $self->{RM_F}
 RM_RF = $self->{RM_RF}
 UMASK_NULL = $self->{UMASK_NULL}
 MKPATH = Create/Directory
-";
+EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
+WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
+MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
+DOC_INSTALL = \$(PERL) -e "@ARGV=split('|',<STDIN>);print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
+UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1);"
+!;
 }
 
 
@@ -808,7 +805,7 @@ sub top_targets {
     }
     my(@m);
     push @m, '
-all :: config $(INST_PM) subdirs linkext manifypods reorg_packlist
+all :: config $(INST_PM) subdirs linkext manifypods
        $(NOOP)
 
 subdirs :: $(MYEXTLIB)
@@ -817,13 +814,18 @@ subdirs :: $(MYEXTLIB)
 config :: $(MAKEFILE) $(INST_LIBDIR).exists
        $(NOOP)
 
-config :: $(INST_ARCHAUTODIR).exists Version_check
+config :: $(INST_ARCHAUTODIR).exists
        $(NOOP)
 
 config :: $(INST_AUTODIR).exists
        $(NOOP)
 ';
 
+    push @m, q{
+config :: Version_check
+
+} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl");
+
 
     push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
     if (%{$self->{MAN1PODS}}) {
@@ -853,8 +855,7 @@ help :
     push @m, q{
 Version_check :
        },$self->{NOECHO},q{$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
-       -e "use ExtUtils::MakeMaker qw($Version &Version_check);" -
-       -e "&Version_check('$(MM_VERSION)')"
+       "-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
 };
 
     join('',@m);
@@ -871,17 +872,30 @@ sub dlsyms {
     return '' unless $self->needs_linking();
 
     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
-    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
+    my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
     my(@m);
 
-    push(@m,'
+    unless ($self->{SKIPHASH}{'dynamic'}) {
+       push(@m,'
 dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
        $(NOOP)
-
+');
+       if ($srcdir) {
+          my($opt) = $self->catfile($srcdir,'perlshr.opt');
+          push(@m,"# Depend on $(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
+rtls.opt : $opt \$(BASEEXT).opt
+       Copy/Log $opt Sys\$Disk:[]rtls.opt
+");
+       }
+       else {
+           push(@m,'
 # rtls.opt is built in the same step as $(BASEEXT).opt
 rtls.opt : $(BASEEXT).opt
        $(TOUCH) $(MMS$TARGET)
-') unless $self->{SKIPHASH}{'dynamic'};
+');
+       }
+    }
 
     push(@m,'
 static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
@@ -891,7 +905,6 @@ static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
     push(@m,'
 $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
        $(CP) $(MMS$SOURCE) $(MMS$TARGET)
-       ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 
 $(BASEEXT).opt : Makefile.PL
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
@@ -929,7 +942,6 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
        ',$self->{NOECHO},'$(MKPATH) $(INST_ARCHAUTODIR)
        Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
-       ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 ';
 
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
@@ -956,12 +968,10 @@ $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
        '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
        -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
        '.$self->{NOECHO}.' $(TOUCH) $(MMS$TARGET)
-       '.$self->{NOECHO}.'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 
 $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
        '.$self->{NOECHO}.'$(RM_RF) $(INST_BOOT)
        - $(CP) $(BOOTSTRAP) $(INST_BOOT)
-       '.$self->{NOECHO}.'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 ';
 }
 # --- Static Loading Sections ---
@@ -994,7 +1004,6 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
        If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
        Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
        ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
-       ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 ');
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
@@ -1021,7 +1030,6 @@ $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
 ",'    ',$self->{NOECHO},'$(RM_F) $(MMS$TARGET)
        ',$self->{NOECHO},'$(CP) ',"$dist $inst",'
        $(CHMOD) 644 $(MMS$TARGET)
-       ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;"
 ');
     push(@m, ' $(AUTOSPLITFILE) $(MMS$TARGET) ',
               $self->catdir($splitlib,'auto')."\n\n")
@@ -1155,25 +1163,6 @@ $to : $from \$(MAKEFILE) ${todir}.exists
 
 # --- Sub-directory Sections ---
 
-sub pasthru {
-    my($self) = @_;
-    unless (ref $self){
-       ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
-       $self = $ExtUtils::MakeMaker::Parent[-1];
-    }
-    my(@m,$key);
-    my(@pasthru);
-
-    foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN 
-                     INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A LINKTYPE)){
-       push @pasthru, "$key=\"$self->{$key}\"";
-    }
-
-    push @m, "\nPASTHRU = \\\n ", join (",\\\n ", @pasthru), "\n";
-    join "", @m;
-}
-
-
 sub subdir_x {
     my($self, $subdir) = @_;
     unless (ref $self){
@@ -1390,82 +1379,100 @@ sub install {
        ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
        $self = $ExtUtils::MakeMaker::Parent[-1];
     }
-    my(@m);
-    push @m, q{
-doc_install ::
-       },$self->{NOECHO},q{Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod"
-       },$self->{NOECHO},q{$(PERL) "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"  \\
-               -e "use ExtUtils::MakeMaker; MY->new({})->writedoc('Module', '$(NAME)', \\
-               'LINKTYPE=$(LINKTYPE)', 'VERSION=$(VERSION)', 'XS_VERSION=$(XS_VERSION)', 'EXE_FILES=$(EXE_FILES)')" \\
-               >>$(INSTALLARCHLIB)perllocal.pod
-};
+    my(@m,@docfiles);
 
-    push(@m, "
-install :: pure_install doc_install
-       \$(NOOP)
-
-# Interim solution for VMS; assumes directory tree of same structure under
-# both \$(INST_LIB) and \$(INSTALLPRIVLIB).  This operation will be assumed
-# into MakeMaker in a (near) future version.
-pure_install :: all
-");
-#    # install subdirectories first
-#    foreach(@{$self->{DIR}}){
-#      my($vmsdir) = $self->fixpath($_,1);
-#      push(@m, '      If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
-#           '; print `$(MMS) install`"'."\n");
-#    }
-#
-#    push(@m, '        ',$self->{NOECHO},'$(PERL) "-I$(PERL_LIB)" -e "use File::Path; mkpath(\@ARGV)" $(INSTALLPRIVLIB) $(INSTALLARCHLIB)
-#      ',$self->{NOECHO},'$(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLPRIVLIB)
-#      ',$self->{NOECHO},'$(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLARCHLIB)',"
-#      # Can't install manpages here -- INST_MAN%DIR macros make line >255 chars
-#      \$(MMS) \$(USEMACROS)INST_LIB=$self->{INSTALLPRIVLIB},INST_ARCHLIB=$self->{INSTALLARCHLIB},INST_EXE=$self->{INSTALLBIN}\$(MACROEND)",'
-#      ',$self->{NOECHO},'$(PERL) -i_bak -lne "print unless $seen{$_}++" $(INST_ARCHAUTODIR).packlist
-#');
-
-    my($curtop,$insttop);
-    ($curtop = $self->fixpath($self->{INST_LIB},1)) =~ s/]$//;
-    ($insttop = $self->fixpath($self->{INSTALLPRIVLIB},1)) =~ s/]$//;
-    push(@m,"  Backup/Log ${curtop}...]*.*; ${insttop}...]/New_Version/By_Owner=Parent\n");
-
-    my($oldpacklist) = $self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist');
-    push @m,'
-# This song and dance brought to you by DCL\'s 255 char limit
-reorg_packlist :
-';
-    my($oldpacklist) = $self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist');
-    if ("\L$oldpacklist" ne "\L$self->{INST_ARCHAUTODIR}.packlist") {
-       push(@m,'       If F$Search("',$oldpacklist,'").nes."" Then Append/New ',$oldpacklist,' $(INST_ARCHAUTODIR).packlist');
+    if ($self->{EXE_FILES}) {
+       my($line,$file) = ('','');
+       foreach $file (@{$self->{EXE_FILES}}) {
+           $line .= "$file ";
+           if (length($line) > 128) {
+               push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]);
+               $line = '';
+           }
+       }
+       push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]) if $line;
     }
-    push @m,'
-       $(PERL) -ne "BEGIN{exit unless -e $ARGV[0];}print unless $s{$_}++;"  $(INST_ARCHAUTODIR).packlist >.MM_tmp
-       If F$Search(".MM_tmp").nes."" Then Copy/NoConfirm .MM_tmp $(INST_ARCHAUTODIR).packlist
-       If F$Search(".MM_tmp").nes."" Then Delete/NoConfirm .MM_tmp;
-';
-
-# From MM 5.16:
 
     push @m, q[
-# Comment on .packlist rewrite above:
-# Read both .packlist files: the old one in PERL_ARCHLIB/auto/FULLEXT, and the new one
-# in INSTARCHAUTODIR. Don't croak if they are missing. Write to the one
-# in INSTARCHAUTODIR. 
+install :: all pure_install doc_install
+       $(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+       $(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+       $(NOOP)
+
+install_ :: install_site
+       ],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+pure_install :: pure_$(INSTALLDIRS)_install
+       $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+       ],$self->{NOECHO},q[Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod"
+
+pure__install : pure_site_install
+       ],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+doc__install : doc_site_install
+       ],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+# This hack brought to you by DCL's 255-character command line limit
+pure_perl_install ::
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_EXE) $(INSTALLBIN) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+       $(MOD_INSTALL) <.MM_tmp
+       ].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+       ].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
+
+# Likewise
+pure_site_install ::
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_EXE) $(INSTALLBIN) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+       $(MOD_INSTALL) <.MM_tmp
+       ].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+       ].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+# Ditto
+doc_perl_install ::
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[ $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+       ].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
+# And again
+doc_site_install ::
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[ $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+       ].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
 ];
 
-    push @m, '
-##### UNINSTALL IS STILL EXPERIMENTAL ####
-uninstall ::
-';
-    foreach(@{$self->{DIR}}){
-      my($vmsdir) = $self->fixpath($_,1);
-      push(@m, '       If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
-           '; print `$(MMS) uninstall`"'."\n");
-    }
-    push @m, "\t".'$(PERL) -le "use File::Path; foreach (<>) {s/',"$curtop/$insttop/;",'rmtree($_,1,0);}" <$(INST_ARCHAUTODIR).packlist
-';
+    push @m, q[
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+       $(NOOP)
+
+uninstall_from_perldirs ::
+       ].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+uninstall_from_sitedirs ::
+       ].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist')."\n";
 
-    join("",@m);
+    join('',@m);
 }
 
 
@@ -1533,7 +1540,7 @@ $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
        ',$self->{NOECHO},'Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..."
        - $(MV) $(MAKEFILE) $(MAKEFILE)_old
        - $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
-       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ',join(' ',@ARGV),'
+       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ',join(' ',map(qq["$_"],@ARGV)),'
        ',$self->{NOECHO},'Write Sys$Output "$(MAKEFILE) has been rebuilt."
        ',$self->{NOECHO},'Write Sys$Output "Please run $(MMS) to build the extension."
 ';
@@ -1562,13 +1569,14 @@ test : \$(TEST_TYPE)
       push(@m, '       If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
            '; print `$(MMS) $(PASTHRU2) test`'."\n");
     }
-    push(@m, "\t$self->{NOECHO}Write Sys\$Output 'No tests defined for \$(NAME) extension.'\n")
+    push(@m, "\t$self->{NOECHO}Write Sys\$Output \"No tests defined for \$(NAME) extension.\"\n")
         unless $tests or -f "test.pl" or @{$self->{DIR}};
     push(@m, "\n");
 
     push(@m, "test_dynamic :: all\n");
     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "    \$(NOOP)\n") if (!$tests && ! -f "test.pl");
     push(@m, "\n");
 
     # Occasionally we may face this degenerate target:
@@ -1578,10 +1586,11 @@ test : \$(TEST_TYPE)
        push(@m, "test_static :: all \$(MAP_TARGET)\n");
        push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
        push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f "test.pl";
+       push(@m, "\t$self->{NOECHO}\$(NOOP)\n") if (!$tests && ! -f "test.pl");
        push(@m, "\n");
     }
     else {
-       push @m, "test_static :: test_dynamic\n";
+       push @m, "test_static :: test_dynamic\n\t$self->{NOECHO}\$(NOOP)\n";
     }
 
     join('',@m);
@@ -1605,7 +1614,7 @@ sub test_via_script {
        ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
        $self = $ExtUtils::MakeMaker::Parent[-1];
     }
-    "  $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" test.pl
+    "  $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
 ';
 }
 
@@ -1757,10 +1766,16 @@ $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt"
        ',$self->{NOECHO},'$(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
 ';
 
-    push @m, q{
+    push @m, q[
+# More from the 255-char line length limit
 doc_inst_perl :
-       },$self->{NOECHO},q{$(PERL) -e "use ExtUtils::MakeMaker; MY->new()->writedoc('Perl binary','$(MAP_TARGET)','MAP_STATIC=$(MAP_STATIC)','MAP_EXTRA=$(MAP_EXTRA)','MAP_LIBPERL=$(MAP_LIBPERL)')"
-};
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+       ].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
+       $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+       ].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+];
 
     push @m, "
 inst_perl : pure_inst_perl doc_inst_perl
@@ -1781,7 +1796,7 @@ map_clean :
     join '', @m;
 }
   
-sub extliblist {
+sub ext {
     my($self) = @_;
     unless (ref $self){
        ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
@@ -1795,9 +1810,9 @@ sub extliblist {
 # dir_target(@array) returns a Makefile entry for the file .exists in each
 # named directory. Returns nothing, if the entry has already been processed.
 # We're helpless though, if the same directory comes as $(FOO) _and_ as "bar".
-# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the 
-# prerequisite, because there has to be one, something that doesn't change 
-# too often :)
+# Both of them get an entry, that's why we use "::". I chose
+# '$(PERL_INC)perl.h' as the prerequisite, because there has to be one,
+# something that doesn't change too often :)
 
 sub dir_target {
     my($self,@dirs) = @_;
@@ -1812,7 +1827,7 @@ sub dir_target {
        push @m, "
 ${vmsdir}.exists :: \$(PERL_INC)perl.h
        $self->{NOECHO}\$(MKPATH) $vmsdir
-       $self->{NOECHO}\$(TOUCH) ${vmsdir}.exists
+       $self->{NOECHO}\$(EQUALIZE_TIMESTAMP) \$(MMS\$SOURCE) \$(MMS\$TARGET)
 ";
     }
     join "", @m;
@@ -1844,9 +1859,12 @@ __END__
 
 ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
 
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_VMS; # Done internally by ExtUtils::MakeMaker if needed
+
 =head1 DESCRIPTION
 
 See ExtUtils::MM_Unix for a documentation of the methods provided
 there. This package overrides the implementation of these methods, not
 the semantics.
-
index 76486b1..f2ee0ce 100644 (file)
@@ -160,15 +160,20 @@ eval {require DynaLoader;};       # Get mod2fname, if defined. Will fail
 }
 
 #
-# No we can can pull in the friends
+# Now we can can pull in the friends
+# Since they will require us back, we would better prepare the needed
+# data _before_ we require them.
 #
+$Is_VMS = ($Config{osname} eq 'VMS');
+$Is_OS2 = ($Config{osname} =~ m|^os/?2$|i);
+
 require ExtUtils::MM_Unix;
-if ($Is_VMS = ($Config{osname} eq 'VMS')) {
+if ($Is_VMS) {
     require ExtUtils::MM_VMS;
     require VMS::Filespec;
     import VMS::Filespec '&vmsify';
 }
-if ($Is_OS2 = $Config{osname} =~ m|^os/?2$|i) {
+if ($Is_OS2) {
     require ExtUtils::MM_OS2;
 }
 
@@ -568,7 +573,7 @@ sub parse_args{
            $value = $self->catdir("..",$value)
                if $Prepend_dot_dot{$name} && ! $value =~ m!^/!;
        }
-       $self->{$name} = $value;
+       $self->{uc($name)} = $value;
     }
     # This may go away, in mid 1996
     delete $self->{Correct_relativ_directories};
@@ -1758,7 +1763,7 @@ An example:
 Andy Dougherty F<E<lt>doughera@lafcol.lafayette.eduE<gt>>, Andreas
 KE<ouml>nig F<E<lt>A.Koenig@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce
 F<E<lt>Tim.Bunce@ig.co.ukE<gt>>.  VMS support by Charles Bailey
-F<E<lt>bailey@HMIVAX.HUMGEN.UPENN.EDUE<gt>>. OS/2 support by Ilya
+F<E<lt>bailey@genetics.upenn.eduE<gt>>. OS/2 support by Ilya
 Zakharevich F<E<lt>ilya@math.ohio-state.eduE<gt>>. Contact the
 makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
 you have any questions.
index aa21f43..1d7ae8c 100644 (file)
@@ -169,8 +169,8 @@ from which it is usually taken.  Its value is a reference to an
 associative array, in which each key is the name of a package, and
 each value is an a reference to an array of function names which
 should be exported by the extension.  For instance, one might say
-C<DL_FUNCS => { Homer::Iliad   => [ qw(trojans greeks) ],
-Homer::Odyssey => [ qw(travellers family suitors) ] }>.  The
+C<DL_FUNCS =E<gt> { Homer::Iliad   =E<gt> [ qw(trojans greeks) ],
+Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
 function names should be identical to those in the XSUB code;
 C<Mksymlists> will alter the names written to the linker option
 file to match the changes made by F<xsubpp>.  In addition, if
@@ -221,4 +221,4 @@ Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
 
 =head1 REVISION
 
-Last revised 14-Jan-1996, for Perl 5.002.
+Last revised 14-Feb-1996, for Perl 5.002.
index b4a075d..6269745 100644 (file)
@@ -24,6 +24,10 @@ sub copy {
     croak("Usage: copy( file1, file2 [, buffersize]) ")
       unless(@_ == 2 || @_ == 3);
 
+    # VMS: perform RMS copy to preserve file attributes, indices, etc.
+    # This function is always defined under VMS, even in miniperl
+    if (defined(&File::Copy::rmscopy)) { return File::Copy::rmscopy($_[0],$_[1]) }
+
     my $from = shift;
     my $to = shift;
     my $recsep = $\;
@@ -99,11 +103,12 @@ sub copy {
 1;
 
 __END__
+
 =head1 NAME
 
 File::Copy - Copy files or filehandles
 
-=head1 USAGE
+=head1 SYNOPSIS
 
        use File::Copy;
 
@@ -133,6 +138,10 @@ being written to the second file. The default buffer size depends
 upon the file, but will generally be the whole file (up to 2Mb), or
 1k for filehandles that do not reference files (eg. sockets).
 
+When running under VMS, this routine performs an RMS copy of
+the file, in order to preserve file attributed, indexed file
+structure, I<etc.>  The buffer size parameter is ignored.
+
 You may use the syntax C<use File::Copy "cp"> to get at the
 "cp" alias for this function. The syntax is I<exactly> the same.
 
index 6cb675b..8a17173 100644 (file)
@@ -73,7 +73,8 @@ than VMS is settled. (defaults to FALSE)
 
 =back
 
-It returns the number of files successfully deleted.
+It returns the number of files successfully deleted. Symlinks are
+treated as ordinary files.
 
 =head1 AUTHORS
 
@@ -82,10 +83,13 @@ Charles Bailey <bailey@genetics.upenn.edu>
 
 =head1 REVISION
 
-This document was last revised 25-Aug-1995, for perl 5.002
+This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is
+1.01.
 
 =cut
 
+$VERSION = "1.01"; # That's my hobby-horse, A.K.
+
 require 5.000;
 use Config;
 use Carp;
@@ -95,7 +99,7 @@ require Exporter;
 
 $Is_VMS = $Config{'osname'} eq 'VMS';
 
-sub mkpath{
+sub mkpath {
     my($paths, $verbose, $mode) = @_;
     # $paths   -- either a path string or ref to list of paths
     # $verbose -- optional print "mkdir $path" for each directory created
@@ -126,7 +130,7 @@ sub rmtree {
 
     foreach $root (@{$roots}) {
        $root =~ s#/$##;
-       if (-d $root) { 
+       if (not -l $root and -d _) { 
            opendir(D,$root);
            ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
            @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
@@ -147,7 +151,7 @@ sub rmtree {
                next;
            }
            print "unlink $root\n" if $verbose;
-           while (-e $root) { # delete all versions under VMS
+           while (-e $root || -l $root) { # delete all versions under VMS
                (unlink($root) && ++$count)
                    or carp "Can't unlink file $root: $!";
            }
index d012fcc..0d8314e 100644 (file)
@@ -99,7 +99,7 @@ require Exporter;
 @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
 @EXPORT_OK = qw();
 
-%OVERLOAD = qw(
+use overload qw(
 fallback       1
 cmp            collate_cmp
 );
index 92e7016..7551ad0 100644 (file)
@@ -5,31 +5,31 @@ use Math::BigInt;
 use Exporter;  # just for use to be happy
 @ISA = (Exporter);
 
-%OVERLOAD = ( 
-                               # Anonymous subroutines:
-'+'    =>      sub {new BigFloat &fadd},
-'-'    =>      sub {new BigFloat
+use overload
+'+'    =>      sub {new Math::BigFloat &fadd},
+'-'    =>      sub {new Math::BigFloat
                       $_[2]? fsub($_[1],${$_[0]}) : fsub(${$_[0]},$_[1])},
-'<=>'  =>      sub {new BigFloat
+'<=>'  =>      sub {new Math::BigFloat
                       $_[2]? fcmp($_[1],${$_[0]}) : fcmp(${$_[0]},$_[1])},
-'cmp'  =>      sub {new BigFloat
+'cmp'  =>      sub {new Math::BigFloat
                       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
-'*'    =>      sub {new BigFloat &fmul},
-'/'    =>      sub {new BigFloat 
+'*'    =>      sub {new Math::BigFloat &fmul},
+'/'    =>      sub {new Math::BigFloat 
                       $_[2]? scalar fdiv($_[1],${$_[0]}) :
                         scalar fdiv(${$_[0]},$_[1])},
-'neg'  =>      sub {new BigFloat &fneg},
-'abs'  =>      sub {new BigFloat &fabs},
+'neg'  =>      sub {new Math::BigFloat &fneg},
+'abs'  =>      sub {new Math::BigFloat &fabs},
 
 qw(
 ""     stringify
 0+     numify)                 # Order of arguments unsignificant
-);
+;
 
 sub new {
-  my $foo = fnorm($_[1]);
-  panic("Not a number initialized to BigFloat") if $foo eq "NaN";
-  bless \$foo;
+  my ($class) = shift;
+  my ($foo) = fnorm(shift);
+  panic("Not a number initialized to Math::BigFloat") if $foo eq "NaN";
+  bless \$foo, $class;
 }
 sub numify { 0 + "${$_[0]}" }  # Not needed, additional overhead
                                # comparing to direct compilation based on
@@ -58,21 +58,6 @@ sub stringify {
     return $n;
 }
 
-# Arbitrary length float math package
-#
-# by Mark Biggar
-#
-# number format
-#   canonical strings have the form /[+-]\d+E[+-]\d+/
-#   Input values can have inbedded whitespace
-# Error returns
-#   'NaN'           An input parameter was "Not a Number" or 
-#                       divide by zero or sqrt of negative number
-# Division is computed to 
-#   max($div_scale,length(dividend)+length(divisor)) 
-#   digits by default.
-# Also used for default sqrt scale
-
 $div_scale = 40;
 
 # Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
@@ -84,21 +69,6 @@ sub fneg; sub fabs; sub fcmp;
 sub fround; sub ffround;
 sub fnorm; sub fsqrt;
 
-#   bigfloat routines
-#
-#   fadd(NSTR, NSTR) return NSTR            addition
-#   fsub(NSTR, NSTR) return NSTR            subtraction
-#   fmul(NSTR, NSTR) return NSTR            multiplication
-#   fdiv(NSTR, NSTR[,SCALE]) returns NSTR   division to SCALE places
-#   fneg(NSTR) return NSTR                  negation
-#   fabs(NSTR) return NSTR                  absolute value
-#   fcmp(NSTR,NSTR) return CODE             compare undef,<0,=0,>0
-#   fround(NSTR, SCALE) return NSTR         round to SCALE digits
-#   ffround(NSTR, SCALE) return NSTR        round at SCALEth place
-#   fnorm(NSTR) return (NSTR)               normalize
-#   fsqrt(NSTR[, SCALE]) return NSTR        sqrt to SCALE places
-
-\f
 # Convert a number to canonical string form.
 #   Takes something that looks like a number and converts it to
 #   the form /^[+-]\d+E[+-]\d+$/.
@@ -154,7 +124,7 @@ sub fmul { #(fnum_str, fnum_str) return fnum_str
        &norm(Math::BigInt::bmul($xm,$ym),$xe+$ye);
     }
 }
-\f
+
 # addition
 sub fadd { #(fnum_str, fnum_str) return fnum_str
     local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1]));
@@ -192,7 +162,7 @@ sub fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
            $xe-$ye-$scale);
     }
 }
-\f
+
 # round int $q based on fraction $r/$base using $rnd_mode
 sub round { #(int_str, int_str, int_str) return int_str
     local($q,$r,$base) = @_;
@@ -233,7 +203,7 @@ sub fround { #(fnum_str, scale) return fnum_str
        }
     }
 }
-\f
+
 # round $x at the 10 to the $scale digit place
 sub ffround { #(fnum_str, scale) return fnum_str
     local($x,$scale) = (fnorm($_[$[]),$_[$[+1]);
@@ -273,7 +243,7 @@ sub fcmp #(fnum_str, fnum_str) return cond_code
        );
     }
 }
-\f
+
 # square root by Newtons method.
 sub fsqrt { #(fnum_str[, scale]) return fnum_str
     local($x, $scale) = (fnorm($_[$[]), $_[$[+1]);
@@ -290,8 +260,67 @@ sub fsqrt { #(fnum_str[, scale]) return fnum_str
            $guess = fmul(fadd($guess,fdiv($x,$guess,$gs*2)),".5");
            $gs *= 2;
        }
-       new BigFloat &fround($guess, $scale);
+       new Math::BigFloat &fround($guess, $scale);
     }
 }
 
 1;
+__END__
+
+=head1 NAME
+
+Math::BigFloat - Arbitrary length float math package
+
+=head1 SYNOPSIS
+
+  use Math::BogFloat;
+  $f = Math::BigFloat->new($string);
+
+  $f->fadd(NSTR) return NSTR            addition
+  $f->fsub(NSTR) return NSTR            subtraction
+  $f->fmul(NSTR) return NSTR            multiplication
+  $f->fdiv(NSTR[,SCALE]) returns NSTR   division to SCALE places
+  $f->fneg() return NSTR                negation
+  $f->fabs() return NSTR                absolute value
+  $f->fcmp(NSTR) return CODE            compare undef,<0,=0,>0
+  $f->fround(SCALE) return NSTR         round to SCALE digits
+  $f->ffround(SCALE) return NSTR        round at SCALEth place
+  $f->fnorm() return (NSTR)             normalize
+  $f->fsqrt([SCALE]) return NSTR        sqrt to SCALE places
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+floats as
+
+    $float = new Math::BigFloat "2.123123123123123123123123123123123";
+
+=over 2
+
+=item number format
+
+canonical strings have the form /[+-]\d+E[+-]\d+/ .  Input values can
+have inbedded whitespace.
+
+=item Error returns 'NaN'
+
+An input parameter was "Not a Number" or divide by zero or sqrt of
+negative number.
+
+=item Division is computed to 
+
+C<max($div_scale,length(dividend)+length(divisor))> digits by default.
+Also used for default sqrt scale.
+
+=back
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar
+
+=cut
index 8c0ca4e..68856ae 100644 (file)
@@ -1,7 +1,6 @@
 package Math::BigInt;
 
-%OVERLOAD = ( 
-                               # Anonymous subroutines:
+use overload
 '+'    =>      sub {new Math::BigInt &badd},
 '-'    =>      sub {new Math::BigInt
                       $_[2]? bsub($_[1],${$_[0]}) : bsub(${$_[0]},$_[1])},
@@ -23,57 +22,24 @@ package Math::BigInt;
 qw(
 ""     stringify
 0+     numify)                 # Order of arguments unsignificant
-);
+;
 
 $NaNOK=1;
 
 sub new {
-  my $foo = bnorm($_[1]);
+  my($class) = shift;
+  my($foo) = bnorm(shift);
   die "Not a number initialized to Math::BigInt" if !$NaNOK && $foo eq "NaN";
-  bless \$foo;
+  bless \$foo, $class;
 }
 sub stringify { "${$_[0]}" }
 sub numify { 0 + "${$_[0]}" }  # Not needed, additional overhead
                                # comparing to direct compilation based on
                                # stringify
 
-# arbitrary size integer math package
-#
-# by Mark Biggar
-#
-# Canonical Big integer value are strings of the form
-#       /^[+-]\d+$/ with leading zeros suppressed
-# Input values to these routines may be strings of the form
-#       /^\s*[+-]?[\d\s]+$/.
-# Examples:
-#   '+0'                            canonical zero value
-#   '   -123 123 123'               canonical value '-123123123'
-#   '1 23 456 7890'                 canonical value '+1234567890'
-# Output values always always in canonical form
-#
-# Actual math is done in an internal format consisting of an array
-#   whose first element is the sign (/^[+-]$/) and whose remaining 
-#   elements are base 100000 digits with the least significant digit first.
-# The string 'NaN' is used to represent the result when input arguments 
-#   are not numbers, as well as the result of dividing by zero
-#
-# routines provided are:
-#
-#   bneg(BINT) return BINT              negation
-#   babs(BINT) return BINT              absolute value
-#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
-#   badd(BINT,BINT) return BINT         addition
-#   bsub(BINT,BINT) return BINT         subtraction
-#   bmul(BINT,BINT) return BINT         multiplication
-#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
-#   bmod(BINT,BINT) return BINT         modulus
-#   bgcd(BINT,BINT) return BINT         greatest common divisor
-#   bnorm(BINT) return BINT             normalization
-#
-
 $zero = 0;
 
-\f
+
 # normalize string form of number.   Strip leading zeros.  Strip any
 #   white space and add a sign, if missing.
 # Strings that are not numbers result the value 'NaN'.
@@ -125,7 +91,7 @@ sub abs { # post-normalized abs for internal use
     s/^-/+/;
     $_;
 }
-\f
+
 # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
 sub bcmp { #(num_str, num_str) return cond_code
     local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
@@ -186,7 +152,7 @@ sub bgcd { #(num_str, num_str) return num_str
        $x;
     }
 }
-\f
+
 # routine to add two base 1e5 numbers
 #   stolen from Knuth Vol 2 Algorithm A pg 231
 #   there are separate routines to add and sub as per Kunth pg 233
@@ -252,7 +218,7 @@ sub mul { #(*int_num_array, *int_num_array) return int_num_array
 sub bmod { #(num_str, num_str) return num_str
     (&bdiv(@_))[$[+1];
 }
-\f
+
 sub bdiv { #(dividend: num_str, divisor: num_str) return num_str
     local (*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
     return wantarray ? ('NaN','NaN') : 'NaN'
@@ -347,3 +313,74 @@ sub bpow { #(num_str, num_str) return num_str
 }
 
 1;
+__END__
+
+=head1 NAME
+
+Math::BigInt - Arbitrary size integer math package
+
+=head1 SYNOPSIS
+
+  use Math::BigInt;
+  $i = Math::BigInt->new($string);
+
+  $i->bneg return BINT               negation
+  $i->babs return BINT               absolute value
+  $i->bcmp(BINT) return CODE         compare numbers (undef,<0,=0,>0)
+  $i->badd(BINT) return BINT         addition
+  $i->bsub(BINT) return BINT         subtraction
+  $i->bmul(BINT) return BINT         multiplication
+  $i->bdiv(BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+  $i->bmod(BINT) return BINT         modulus
+  $i->bgcd(BINT) return BINT         greatest common divisor
+  $i->bnorm return BINT              normalization
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+integers as
+
+  $i = new Math::BigInt '123 456 789 123 456 789';
+
+
+=over 2
+
+=item Canonical notation
+
+Big integer value are strings of the form C</^[+-]\d+$/> with leading
+zeros suppressed.
+
+=item Input
+
+Input values to these routines may be strings of the form
+C</^\s*[+-]?[\d\s]+$/>.
+
+=item Output
+
+Output values always always in canonical form
+
+=back
+
+Actual math is done in an internal format consisting of an array
+whose first element is the sign (/^[+-]$/) and whose remaining 
+elements are base 100000 digits with the least significant digit first.
+The string 'NaN' is used to represent the result when input arguments 
+are not numbers, as well as the result of dividing by zero.
+
+=head1 EXAMPLES
+
+   '+0'                            canonical zero value
+   '   -123 123 123'               canonical value '-123123123'
+   '1 23 456 7890'                 canonical value '+1234567890'
+
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar, overloaded interface by Ilya Zakharevich.
+
+=cut
index a5a40b2..969f3c2 100644 (file)
@@ -1,18 +1,3 @@
-#
-#  Perl5 Package for complex numbers
-#
-#  1994 by David Nadler
-#  Coding know-how provided by Tom Christiansen, Tim Bunce, and Larry Wall
-#      sqrt() added by Tom Christiansen; beware should have two roots, 
-#                      but only returns one.  (use wantarray?)
-#  
-#
-# The functions "Re", "Im", and "arg" are provided.
-# "~" is used as the conjugation operator and "abs" is overloaded.
-#
-# Transcendental functions overloaded: so far only sin, cos, and exp.
-#  
-
 package Math::Complex;
 
 require Exporter;
@@ -21,7 +6,7 @@ require Exporter;
 
 # just to make use happy
 
-%OVERLOAD= (
+use overload
     '+'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
                       bless [ $x1+$x2, $y1+$y2];
              },
@@ -95,12 +80,12 @@ require Exporter;
       },
 
     qw("" stringify)
-);
+;
 
 sub new {
-    shift;
+    my $class = shift;
     my @C = @_;
-    bless \@C;
+    bless \@C, $class;
 }
 
 sub Re {
@@ -134,3 +119,45 @@ sub stringify {
     $_ = 0 if ($_ eq '');
     return $_;
 }
+
+1;
+__END__
+
+=head1 NAME
+
+Math::Complex - complex numbers package
+
+=head1 SYNOPSIS
+
+  use Math::Complex;
+  $i = new Math::Complex;
+
+=head1 DESCRIPTION
+
+Complex numbers declared as
+
+    $i = Math::Complex->new(1,1);
+
+can be manipulated with overloaded math operators. The operators
+
+  + - * / neg ~ abs cos sin exp sqrt
+
+are supported as well as
+
+  "" (stringify)
+
+The methods
+
+  Re Im arg
+
+are also provided.
+
+=head1 BUGS
+
+sqrt() should return two roots, but only returns one.
+
+=head1 AUTHORS
+
+Dave Nadler, Tom Christiansen, Tim Bunce, Larry Wall.
+
+=cut
index 021f175..bb44b53 100644 (file)
@@ -75,3 +75,52 @@ AUTOLOAD {
 }
 
 1;
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+See below.
+
+=head1 DESCRIPTION
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
+  To: perl5-porters@isu.edu
+  From: Larry Wall <lwall@scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/tmp/passwd");
+
+That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
+package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+Larry
+
+
+=head1 AUTHOR
+
+Larry Wall
+
+=cut
index 8927850..97d7beb 100644 (file)
@@ -9,43 +9,76 @@ use Carp;
 @EXPORT = qw(shellwords quotewords);
 @EXPORT_OK = qw(old_shellwords);
 
-# This code needs updating to use new Perl 5 features (regexp etc).
-
-# ParseWords.pm
-#
-# Usage:
-#      use ParseWords;
-#      @words = &quotewords($delim, $keep, @lines);
-#      @words = &shellwords(@lines);
-#      @words = &old_shellwords(@lines);
-
-# Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
-# Permission to use and distribute under the same terms as Perl.
-# No warranty expressed or implied.
-
-# Basically an update and generalization of the old shellwords.pl.
-# Much code shamelessly stolen from the old version (author unknown).
-#
-# &quotewords() accepts a delimiter (which can be a regular expression)
-# and a list of lines and then breaks those lines up into a list of
-# words ignoring delimiters that appear inside quotes.
-#
-# The $keep argument is a boolean flag.  If true, the quotes are kept
-# with each word, otherwise quotes are stripped in the splitting process.
-# $keep also defines whether unprotected backslashes are retained.
-#
+=head1 NAME
 
-1;
-__END__
+Text::ParseWords - parse text into an array of tokens
 
+=head1 SYNOPSIS
 
-sub shellwords {
+  use Text::ParseWords;
+  @words = &quotewords($delim, $keep, @lines);
+  @words = &shellwords(@lines);
+  @words = &old_shellwords(@lines);
+
+=head1 DESCRIPTION
+
+&quotewords() accepts a delimiter (which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes.
+
+The $keep argument is a boolean flag.  If true, the quotes are kept
+with each word, otherwise quotes are stripped in the splitting process.
+$keep also defines whether unprotected backslashes are retained.
+
+A &shellwords() replacement is included to demonstrate the new package.
+This version differs from the original in that it will _NOT_ default
+to using $_ if no arguments are given.  I personally find the old behavior
+to be a mis-feature.
+
+
+&quotewords() works by simply jamming all of @lines into a single
+string in $_ and then pulling off words a bit at a time until $_
+is exhausted.
+
+The inner "for" loop builds up each word (or $field) one $snippet
+at a time.  A $snippet is a quoted string, a backslashed character,
+or an unquoted string.  We fall out of the "for" loop when we reach
+the end of $_ or when we hit a delimiter.  Falling out of the "for"
+loop, we push the $field we've been building up onto the list of
+@words we'll be returning, and then loop back and pull another word
+off of $_.
+
+The first two cases inside the "for" loop deal with quoted strings.
+The first case matches a double quoted string, removes it from $_,
+and assigns the double quoted string to $snippet in the body of the
+conditional.  The second case handles single quoted strings.  In
+the third case we've found a quote at the current beginning of $_,
+but it didn't match the quoted string regexps in the first two cases,
+so it must be an unbalanced quote and we croak with an error (which can
+be caught by eval()).
 
-    # A &shellwords() replacement is included to demonstrate the new package.
-    # This version differs from the original in that it will _NOT_ default
-    # to using $_ if no arguments are given.  I personally find the old behavior
-    # to be a mis-feature.
+The next case handles backslashed characters, and the next case is the
+exit case on reaching the end of the string or finding a delimiter.
 
+Otherwise, we've found an unquoted thing and we pull of characters one
+at a time until we reach something that could start another $snippet--
+a quote of some sort, a backslash, or the delimiter.  This one character
+at a time behavior was necessary if the delimiter was going to be a
+regexp (love to hear it if you can figure out a better way).
+
+=head1 AUTHORS
+
+Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
+
+Basically an update and generalization of the old shellwords.pl.
+Much code shamelessly stolen from the old version (author unknown).
+
+=cut
+
+1;
+__END__
+
+sub shellwords {
     local(@lines) = @_;
     $lines[$#lines] =~ s/\s+$//;
     &quotewords('\s+', 0, @lines);
@@ -54,37 +87,6 @@ sub shellwords {
 
 
 sub quotewords {
-
-# &quotewords() works by simply jamming all of @lines into a single
-# string in $_ and then pulling off words a bit at a time until $_
-# is exhausted.
-#
-# The inner "for" loop builds up each word (or $field) one $snippet
-# at a time.  A $snippet is a quoted string, a backslashed character,
-# or an unquoted string.  We fall out of the "for" loop when we reach
-# the end of $_ or when we hit a delimiter.  Falling out of the "for"
-# loop, we push the $field we've been building up onto the list of
-# @words we'll be returning, and then loop back and pull another word
-# off of $_.
-#
-# The first two cases inside the "for" loop deal with quoted strings.
-# The first case matches a double quoted string, removes it from $_,
-# and assigns the double quoted string to $snippet in the body of the
-# conditional.  The second case handles single quoted strings.  In
-# the third case we've found a quote at the current beginning of $_,
-# but it didn't match the quoted string regexps in the first two cases,
-# so it must be an unbalanced quote and we croak with an error (which can
-# be caught by eval()).
-#
-# The next case handles backslashed characters, and the next case is the
-# exit case on reaching the end of the string or finding a delimiter.
-#
-# Otherwise, we've found an unquoted thing and we pull of characters one
-# at a time until we reach something that could start another $snippet--
-# a quote of some sort, a backslash, or the delimiter.  This one character
-# at a time behavior was necessary if the delimiter was going to be a
-# regexp (love to hear it if you can figure out a better way).
-
     local($delim, $keep, @lines) = @_;
     local(@words,$snippet,$field,$_);
 
index ab19426..546ae87 100644 (file)
@@ -10,7 +10,7 @@ my $archname = $Config{'archname'};
 
 sub import {
     shift;
-    foreach (@_) {
+    foreach (reverse @_) {
        unshift(@INC, $_);
        # Put a corresponding archlib directory infront of $_ if it
        # looks like $_ has an archlib directory below it.
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/mg.c b/mg.c
index 9d69be5..e88a8c5 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -461,7 +461,11 @@ MAGIC *mg;
        sv_setpv(sv,ofmt);
        break;
     case '!':
+#ifdef VMS
+       sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
+#else
        sv_setnv(sv,(double)errno);
+#endif
        sv_setpv(sv, errno ? Strerror(errno) : "");
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
@@ -1137,7 +1141,7 @@ MAGIC* mg;
        statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SS$_ABORT);         /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);         /* will anyone ever use this? */
        break;
     case '<':
        uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
diff --git a/op.c b/op.c
index 9874c28..5207820 100644 (file)
--- a/op.c
+++ b/op.c
@@ -23,7 +23,7 @@
 #ifdef USE_OP_MASK
 /*
  * In the following definition, the ", (OP *) op" is just to make the compiler
- * think the expression is of the right type: croak actually does a longjmp.
+ * think the expression is of the right type: croak actually does a Siglongjmp.
  */
 #define CHECKOP(type,op) \
     ((op_mask && op_mask[type]) \
@@ -190,7 +190,7 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
                    SvFLAGS(sv) |= SVf_FAKE;
                }
                av_store(comppad, newoff, SvREFCNT_inc(oldsv));
-               SvFLAGS(compcv) |= SVpcv_CLONE;
+               CvCLONE_on(compcv);
                return newoff;
            }
        }
@@ -1424,10 +1424,12 @@ register OP *o;
            if (curop->op_type == OP_PADSV || curop->op_type == OP_RV2SV) {
                if (vars++)
                    return o;
-               if ((o->op_type == OP_LT && curop == ((BINOP*)o)->op_first) ||
-                   (o->op_type == OP_GT && curop == ((BINOP*)o)->op_last))
+               if (((o->op_type == OP_LT || o->op_type == OP_GE) &&
+                       curop == ((BINOP*)o)->op_first ) ||
+                   ((o->op_type == OP_GT || o->op_type == OP_LE) &&
+                       curop == ((BINOP*)o)->op_last ))
                {
-                   /* Allow "$i < 100" and "100 > $i" to integerize */
+                   /* Allow "$i < 100" and variants to integerize */
                    continue;
                }
            }
@@ -2210,6 +2212,8 @@ OP *right;
                        tmpop->op_sibling = Nullop;     /* don't free split */
                        right->op_next = tmpop->op_next;  /* fix starting loc */
                        op_free(op);                    /* blow off assign */
+                       right->op_flags &= ~(OPf_KNOW|OPf_LIST);
+                               /* "I don't know and I don't care." */
                        return right;
                    }
                }
@@ -2301,8 +2305,8 @@ OP *op;
     if (perldb && curstash != debstash) {
        SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
        if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
-           SvIVX(*svp) = 1;
            (void)SvIOK_on(*svp);
+           SvIVX(*svp) = 1;
            SvSTASH(*svp) = (HV*)cop;
        }
     }
@@ -2675,7 +2679,7 @@ CV *cv;
        SAVESPTR(curpad);
        curpad = 0;
 
-       if (!(SvFLAGS(cv) & SVpcv_CLONED))
+       if (!CvCLONED(cv))
            op_free(CvROOT(cv));
        CvROOT(cv) = Nullop;
        LEAVE;
@@ -2716,7 +2720,7 @@ CV* proto;
 
     cv = compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)cv, SVt_PVCV);
-    SvFLAGS(cv) |= SVpcv_CLONED;
+    CvCLONED_on(cv);
 
     CvFILEGV(cv)       = CvFILEGV(proto);
     CvGV(cv)           = SvREFCNT_inc(CvGV(proto));
@@ -2791,7 +2795,7 @@ OP *block;
     if (cv = GvCV(gv)) {
        if (GvCVGEN(gv))
            cv = 0;                     /* just a cached method */
-       else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
+       else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            if (dowarn) {               /* already defined (or promised)? */
                line_t oldline = curcop->cop_line;
 
@@ -2906,7 +2910,7 @@ OP *block;
     LEAVE_SCOPE(floor);
     if (!op) {
        GvCV(gv) = 0;   /* Will remember in SVOP instead. */
-       SvFLAGS(cv) |= SVpcv_ANON;
+       CvANON_on(cv);
     }
     return cv;
 }
@@ -2920,7 +2924,7 @@ I32 (*subaddr)();
 char *filename;
 {
     CV* cv = newXS(name, (void(*)())subaddr, filename);
-    CvOLDSTYLE(cv) = TRUE;
+    CvOLDSTYLE_on(cv);
     CvXSUBANY(cv).any_i32 = ix;
     return cv;
 }
@@ -2985,7 +2989,7 @@ char *filename;
     }
     if (!name) {
        GvCV(gv) = 0;   /* Will remember elsewhere instead. */
-       SvFLAGS(cv) |= SVpcv_ANON;
+       CvANON_on(cv);
     }
     return cv;
 }
@@ -3006,7 +3010,7 @@ OP *block;
     else
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
-    SvMULTI_on(gv);
+    GvMULTI_on(gv);
     if (cv = GvFORM(gv)) {
        if (dowarn) {
            line_t oldline = curcop->cop_line;
index a18311f..b13849d 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -2325,7 +2325,7 @@ EXT U32 opargs[] = {
        0x00000604,     /* binmode */
        0x00021755,     /* tie */
        0x00000714,     /* untie */
-       0x0000070c,     /* tied */
+       0x00000704,     /* tied */
        0x00011414,     /* dbmopen */
        0x00000414,     /* dbmclose */
        0x00111108,     /* sselect */
@@ -2336,7 +2336,7 @@ EXT U32 opargs[] = {
        0x00000000,     /* leavewrite */
        0x00002e15,     /* prtf */
        0x00002e15,     /* print */
-       0x0091160c,     /* sysopen */
+       0x00911604,     /* sysopen */
        0x0091761d,     /* sysread */
        0x0091161d,     /* syswrite */
        0x0091161d,     /* send */
index ce40acb..fddf646 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -452,7 +452,7 @@ binmode             binmode                 ck_fun          s       F
 
 tie            tie                     ck_fun          idms    R S L
 untie          untie                   ck_fun          is      R
-tied           tied                    ck_fun          st      R
+tied           tied                    ck_fun          s       R
 dbmopen                dbmopen                 ck_fun          is      H S S
 dbmclose       dbmclose                ck_fun          is      H
 
@@ -467,7 +467,7 @@ leavewrite  write exit              ck_null         0
 prtf           printf                  ck_listiob      ims     F? L
 print          print                   ck_listiob      ims     F? L
 
-sysopen                sysopen                 ck_fun          st      F S S S?
+sysopen                sysopen                 ck_fun          s       F S S S?
 sysread                sysread                 ck_fun          imst    F R S S?
 syswrite       syswrite                ck_fun          imst    F S S S?
 
index 2d0b723..fdce070 100644 (file)
   
 ! miniperl: $& miniperlmain.o $(perllib)
 !      $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o $(perllib) $(libs)
-       @miniperl -w -MExporter -e 0 || $(MAKE) minitest
+       @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
   
 ! miniperlmain.o: miniperlmain.c
        $(CCCMD) $(PLDLFLAGS) $*.c
   
 ! miniperl: $& miniperlmain$(OBJ_EXT) $(perllib)
 !      $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(perllib) $(libs)
-       @miniperl -w -MExporter -e 0 || $(MAKE) minitest
+       @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
   
 ! miniperlmain$(OBJ_EXT): miniperlmain.c
        $(CCCMD) $(PLDLFLAGS) $*.c
diff --git a/os2/diff.exec b/os2/diff.exec
deleted file mode 100644 (file)
index f3ef938..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-Only #if lines are changed below.
-
-diff -rc perl5.002b3/pp_sys.c perl5.002b3.new/pp_sys.c
-*** perl5.002b3/pp_sys.c       Fri Feb 02 16:39:40 1996
---- perl5.002b3.new/pp_sys.c   Sat Feb 03 21:20:56 1996
-***************
-*** 2771,2777 ****
-      Signal_t (*ihand)();     /* place to save signal during system() */
-      Signal_t (*qhand)();     /* place to save signal during system() */
-  
-! #if defined(HAS_FORK) && !defined(VMS)
-      if (SP - MARK == 1) {
-       if (tainting) {
-           char *junk = SvPV(TOPs, na);
---- 2771,2777 ----
-      Signal_t (*ihand)();     /* place to save signal during system() */
-      Signal_t (*qhand)();     /* place to save signal during system() */
-  
-! #if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
-      if (SP - MARK == 1) {
-       if (tainting) {
-           char *junk = SvPV(TOPs, na);
-***************
-*** 2817,2823 ****
-       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
-      }
-      _exit(-1);
-! #else /* ! FORK or VMS */
-      if (op->op_flags & OPf_STACKED) {
-       SV *really = *++MARK;
-       value = (I32)do_aspawn(really, MARK, SP);
---- 2817,2823 ----
-       value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
-      }
-      _exit(-1);
-! #else /* ! FORK or VMS or OS/2 */
-      if (op->op_flags & OPf_STACKED) {
-       SV *really = *++MARK;
-       value = (I32)do_aspawn(really, MARK, SP);
-diff -rc perl5.002b3/util.c perl5.002b3.new/util.c
-*** perl5.002b3/util.c Fri Jan 26 15:46:42 1996
---- perl5.002b3.new/util.c     Sat Feb 03 23:03:48 1996
-***************
-*** 1287,1293 ****
-  VTOH(vtohl,long)
-  #endif
-  
-! #if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
-  FILE *
-  my_popen(cmd,mode)
-  char *cmd;
---- 1287,1294 ----
-  VTOH(vtohl,long)
-  #endif
-  
-! #if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in
-!                                         VMS.c, same with OS/2. */
-  FILE *
-  my_popen(cmd,mode)
-  char *cmd;
-***************
-*** 1364,1370 ****
-      return fdopen(p[this], mode);
-  }
-  #else
-! #if defined(atarist) || defined(OS2)
-  FILE *popen();
-  FILE *
-  my_popen(cmd,mode)
---- 1365,1371 ----
-      return fdopen(p[this], mode);
-  }
-  #else
-! #if defined(atarist)
-  FILE *popen();
-  FILE *
-  my_popen(cmd,mode)
index 8d0820d..0a8720c 100644 (file)
@@ -70,6 +70,7 @@ void settmppath();
 
 #define Stat(fname,bufptr) os2_stat((fname),(bufptr))
 #define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define FFlush(fp)         fflush(fp)
 
 #undef S_IFBLK
 #undef S_ISBLK
@@ -80,5 +81,6 @@ void settmppath();
 
 #define Stat(fname,bufptr) stat((fname),(bufptr))
 #define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define FFlush(fp)         fflush(fp)
 
 #endif
index e3d7670..4c941b4 100644 (file)
@@ -1 +1,2 @@
 #define PATCHLEVEL 2
+#define SUBVERSION 0
diff --git a/perl.c b/perl.c
index 738c95c..03c4d48 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -114,7 +114,13 @@ register PerlInterpreter *sv_interp;
 #endif
 
     init_ids();
+
+#if defined(SUBVERSION) && SUBVERSION > 0
+    sprintf(patchlevel, "%7.5f", 5.0 + (PATCHLEVEL / 1000.0)
+                                    + (SUBVERSION / 100000.0));
+#else
     sprintf(patchlevel, "%5.3f", 5.0 + (PATCHLEVEL / 1000.0));
+#endif
 
     fdpid = newAV();   /* for remembering popen pids by fd */
     pidstatus = newHV();/* for remembering status of dead pids */
@@ -263,7 +269,7 @@ setuid perl scripts securely.\n");
        op_free(main_root);
     main_root = 0;
 
-    switch (setjmp(top_env)) {
+    switch (Sigsetjmp(top_env,1)) {
     case 1:
 #ifdef VMS
        statusvalue = 255;
@@ -397,7 +403,7 @@ setuid perl scripts securely.\n");
     if (!scriptname)
        scriptname = argv[0];
     if (e_fp) {
-       if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+       if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
            croak("Can't write to temp file for -e: %s", Strerror(errno));
        argc++,argv--;
        scriptname = e_tmpname;
@@ -465,6 +471,7 @@ setuid perl scripts securely.\n");
     curstash = defstash;
     preprocess = FALSE;
     if (e_fp) {
+       fclose(e_fp);
        e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
     }
@@ -499,7 +506,7 @@ PerlInterpreter *sv_interp;
 {
     if (!(curinterp = sv_interp))
        return 255;
-    switch (setjmp(top_env)) {
+    switch (Sigsetjmp(top_env,1)) {
     case 1:
        cxstack_ix = -1;                /* start context stack again */
        break;
@@ -569,7 +576,7 @@ U32 status;
        POPBLOCK(cx,curpm);
        LEAVE;
     }
-    longjmp(top_env, 2);
+    Siglongjmp(top_env, 2);
 }
 
 SV*
@@ -679,7 +686,7 @@ I32 flags;          /* See G_* flags in cop.h */
     SV** sp = stack_sp;
     I32 oldmark = TOPMARK;
     I32 retval;
-    jmp_buf oldtop;
+    Sigjmp_buf oldtop;
     I32 oldscope;
     
     if (flags & G_DISCARD) {
@@ -702,7 +709,7 @@ I32 flags;          /* See G_* flags in cop.h */
       myop.op_flags |= OPf_LIST;
 
     if (flags & G_EVAL) {
-       Copy(top_env, oldtop, 1, jmp_buf);
+       Copy(top_env, oldtop, 1, Sigjmp_buf);
 
        cLOGOP->op_other = op;
        markstack_ptr--;
@@ -728,7 +735,7 @@ I32 flags;          /* See G_* flags in cop.h */
        markstack_ptr++;
 
     restart:
-       switch (setjmp(top_env)) {
+       switch (Sigsetjmp(top_env,1)) {
        case 0:
            break;
        case 1:
@@ -742,7 +749,7 @@ I32 flags;          /* See G_* flags in cop.h */
            /* my_exit() was called */
            curstash = defstash;
            FREETMPS;
-           Copy(oldtop, top_env, 1, jmp_buf);
+           Copy(oldtop, top_env, 1, Sigjmp_buf);
            if (statusvalue)
                croak("Callback called exit");
            my_exit(statusvalue);
@@ -787,7 +794,7 @@ I32 flags;          /* See G_* flags in cop.h */
            curpm = newpm;
            LEAVE;
        }
-       Copy(oldtop, top_env, 1, jmp_buf);
+       Copy(oldtop, top_env, 1, Sigjmp_buf);
     }
     if (flags & G_DISCARD) {
        stack_sp = stack_base + oldmark;
@@ -809,7 +816,7 @@ I32 flags;          /* See G_* flags in cop.h */
     SV** sp = stack_sp;
     I32 oldmark = sp - stack_base;
     I32 retval;
-    jmp_buf oldtop;
+    Sigjmp_buf oldtop;
     I32 oldscope;
     
     if (flags & G_DISCARD) {
@@ -831,10 +838,10 @@ I32 flags;                /* See G_* flags in cop.h */
     if (flags & G_ARRAY)
       myop.op_flags |= OPf_LIST;
 
-    Copy(top_env, oldtop, 1, jmp_buf);
+    Copy(top_env, oldtop, 1, Sigjmp_buf);
 
 restart:
-    switch (setjmp(top_env)) {
+    switch (Sigsetjmp(top_env,1)) {
     case 0:
        break;
     case 1:
@@ -848,7 +855,7 @@ restart:
        /* my_exit() was called */
        curstash = defstash;
        FREETMPS;
-       Copy(oldtop, top_env, 1, jmp_buf);
+       Copy(oldtop, top_env, 1, Sigjmp_buf);
        if (statusvalue)
            croak("Callback called exit");
        my_exit(statusvalue);
@@ -878,7 +885,7 @@ restart:
        sv_setpv(GvSV(errgv),"");
 
   cleanup:
-    Copy(oldtop, top_env, 1, jmp_buf);
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
     if (flags & G_DISCARD) {
        stack_sp = stack_base + oldmark;
        retval = 0;
@@ -1101,8 +1108,12 @@ char *s;
     case 'm':
        taint_not("-m");        /* XXX ? */
        if (*++s) {
-           char *start = s;
-           Sv = newSVpv("use ",4);
+           char *start;
+           char *use = "use ";
+           /* -M-foo == 'no foo'       */
+           if (*s == '-') { use = "no "; ++s; }
+           Sv = newSVpv(use,0);
+           start = s;
            /* We allow -M'Module qw(Foo Bar)'  */
            while(isALNUM(*s) || *s==':') ++s;
            if (*s != '=') {
@@ -1114,9 +1125,9 @@ char *s;
                }
            } else {
                sv_catpvn(Sv, start, s-start);
-               sv_catpv(Sv, " qw(");
+               sv_catpv(Sv, " split(/,/,q{");
                sv_catpv(Sv, ++s);
-               sv_catpv(Sv,    ")");
+               sv_catpv(Sv,    "})");
            }
            s += strlen(s);
            if (preambleav == NULL)
@@ -1152,7 +1163,11 @@ char *s;
        s++;
        return s;
     case 'v':
-       printf("\nThis is perl, version %s gamma",patchlevel);
+#if defined(SUBVERSION) && SUBVERSION > 0
+       printf("\nThis is perl, version 5.%03d_%02d", PATCHLEVEL, SUBVERSION);
+#else
+       printf("\nThis is perl, version %s",patchlevel);
+#endif
 
 #if defined(DEBUGGING) || defined(EMBED) || defined(MULTIPLICITY)
        fputs(" with", stdout);
@@ -1228,9 +1243,14 @@ my_unexec()
     if (status)
        fprintf(stderr, "unexec of %s into %s failed!\n", tokenbuf, buf);
     exit(status);
+#else
+#  ifdef VMS
+#    include <lib$routines.h>
+     lib$signal(SS$_DEBUG);  /* ssdef.h #included from vmsish.h */
 #else
     ABORT();           /* for use with undump */
 #endif
+#endif
 }
 
 static void
@@ -1245,10 +1265,10 @@ init_main_stash()
     SvREADONLY_on(gv);
     HvNAME(defstash) = savepv("main");
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
-    SvMULTI_on(incgv);
+    GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
     errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
-    SvMULTI_on(errgv);
+    GvMULTI_on(errgv);
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
@@ -1745,9 +1765,9 @@ init_stacks()
     retstack_ix = 0;
     retstack_max = 16;
 
-    New(50,cxstack,129,CONTEXT);       /* XXX should fix CXINC macro */
+    cxstack_max = 8192 / sizeof(CONTEXT) - 2;  /* Use most of 8K. */
+    New(50,cxstack,cxstack_max + 1,CONTEXT);
     cxstack_ix = -1;
-    cxstack_max        = 128;
 
     New(50,tmps_stack,128,SV*);
     tmps_ix = -1;
@@ -1779,26 +1799,26 @@ init_predump_symbols()
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
 
     stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
-    SvMULTI_on(stdingv);
+    GvMULTI_on(stdingv);
     IoIFP(GvIOp(stdingv)) = stdin;
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(stdingv));
-    SvMULTI_on(tmpgv);
 
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
-    SvMULTI_on(tmpgv);
+    GvMULTI_on(tmpgv);
     IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = stdout;
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(defoutgv));
-    SvMULTI_on(tmpgv);
 
     othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
-    SvMULTI_on(othergv);
+    GvMULTI_on(othergv);
     IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = stderr;
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
-    SvMULTI_on(tmpgv);
 
     statname = NEWSV(66,0);            /* last filename we did stat on */
 }
@@ -1848,7 +1868,7 @@ register char **env;
     if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
        sv_setpv(GvSV(tmpgv),origargv[0]);
     if (argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
-       SvMULTI_on(argvgv);
+       GvMULTI_on(argvgv);
        (void)gv_AVadd(argvgv);
        av_clear(GvAVn(argvgv));
        for (; argc > 0; argc--,argv++) {
@@ -1857,7 +1877,7 @@ register char **env;
     }
     if (envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
        HV *hv;
-       SvMULTI_on(envgv);
+       GvMULTI_on(envgv);
        hv = GvHVn(envgv);
        hv_clear(hv);
 #ifndef VMS  /* VMS doesn't have environ array */
@@ -1935,25 +1955,25 @@ void
 calllist(list)
 AV* list;
 {
-    jmp_buf oldtop;
+    Sigjmp_buf oldtop;
     STRLEN len;
     line_t oldline = curcop->cop_line;
 
-    Copy(top_env, oldtop, 1, jmp_buf);
+    Copy(top_env, oldtop, 1, Sigjmp_buf);
 
     while (AvFILL(list) >= 0) {
        CV *cv = (CV*)av_shift(list);
 
        SAVEFREESV(cv);
 
-       switch (setjmp(top_env)) {
+       switch (Sigsetjmp(top_env,1)) {
        case 0: {
                SV* atsv = GvSV(errgv);
                PUSHMARK(stack_sp);
                perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
                (void)SvPV(atsv, len);
                if (len) {
-                   Copy(oldtop, top_env, 1, jmp_buf);
+                   Copy(oldtop, top_env, 1, Sigjmp_buf);
                    curcop = &compiling;
                    curcop->cop_line = oldline;
                    if (list == beginav)
@@ -1977,7 +1997,7 @@ AV* list;
            if (endav)
                calllist(endav);
            FREETMPS;
-           Copy(oldtop, top_env, 1, jmp_buf);
+           Copy(oldtop, top_env, 1, Sigjmp_buf);
            curcop = &compiling;
            curcop->cop_line = oldline;
            if (statusvalue) {
@@ -1995,13 +2015,13 @@ AV* list;
                FREETMPS;
                break;
            }
-           Copy(oldtop, top_env, 1, jmp_buf);
+           Copy(oldtop, top_env, 1, Sigjmp_buf);
            curcop = &compiling;
            curcop->cop_line = oldline;
-           longjmp(top_env, 3);
+           Siglongjmp(top_env, 3);
        }
     }
 
-    Copy(oldtop, top_env, 1, jmp_buf);
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
 }
 
diff --git a/perl.h b/perl.h
index a4d63e2..cf12d63 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1206,7 +1206,7 @@ IEXT SV * Iparsehook;
 /* switches */
 IEXT char *    Icddir;
 IEXT bool      Iminus_c;
-IEXT char      Ipatchlevel[6];
+IEXT char      Ipatchlevel[10];
 IEXT SV *      Inrs;
 IEXT char *    Isplitstr IINIT(" ");
 IEXT bool      Ipreprocess;
@@ -1339,7 +1339,7 @@ IEXT line_t       Icopline IINIT(NOLINE);
 IEXT CONTEXT * Icxstack;
 IEXT I32       Icxstack_ix IINIT(-1);
 IEXT I32       Icxstack_max IINIT(128);
-IEXT jmp_buf   Itop_env;
+IEXT Sigjmp_buf        Itop_env;
 IEXT I32       Irunlevel;
 
 /* stack stuff */
index ea63054..5835162 100644 (file)
@@ -22,6 +22,7 @@ sed -n "/^[A-Za-z]/ p" interp.sym >> perl.exp
 
 # extra globals not included above.
 cat <<END >> perl.exp
+perl_init_i18nl14n
 perl_init_ext
 perl_alloc
 perl_construct
diff --git a/perly.c b/perly.c
index b86af92..9ecf6d2 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -1318,7 +1318,7 @@ int yyerrflag;
 int yychar;
 YYSTYPE yyval;
 YYSTYPE yylval;
-#line 572 "perly.y"
+#line 571 "perly.y"
  /* PROGRAM */
 #line 1394 "y.tab.c"
 #define YYABORT goto yyabort
@@ -2083,19 +2083,18 @@ break;
 case 122:
 #line 455 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                           append_elem(OP_LIST,
-                               yyvsp[0].opval, newCVREF(0,scalar(yyvsp[-1].opval)))); }
+                           append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 123:
-#line 459 "perly.y"
+#line 458 "perly.y"
 { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
 break;
 case 124:
-#line 461 "perly.y"
+#line 460 "perly.y"
 { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
 break;
 case 125:
-#line 463 "perly.y"
+#line 462 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
@@ -2105,7 +2104,7 @@ case 125:
                                )),Nullop)); dep();}
 break;
 case 126:
-#line 471 "perly.y"
+#line 470 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            append_elem(OP_LIST,
@@ -2116,138 +2115,138 @@ case 126:
                                )))); dep();}
 break;
 case 127:
-#line 480 "perly.y"
+#line 479 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
 break;
 case 128:
-#line 484 "perly.y"
+#line 483 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                yyvsp[-1].opval,
                                scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
 break;
 case 129:
-#line 489 "perly.y"
+#line 488 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
                            hints |= HINT_BLOCK_SCOPE; }
 break;
 case 130:
-#line 492 "perly.y"
+#line 491 "perly.y"
 { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 131:
-#line 494 "perly.y"
+#line 493 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
 case 132:
-#line 496 "perly.y"
+#line 495 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 133:
-#line 498 "perly.y"
+#line 497 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 134:
-#line 500 "perly.y"
+#line 499 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 135:
-#line 502 "perly.y"
+#line 501 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 136:
-#line 505 "perly.y"
+#line 504 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 137:
-#line 507 "perly.y"
+#line 506 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, 0); }
 break;
 case 138:
-#line 509 "perly.y"
+#line 508 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0,
                                scalar(yyvsp[0].opval)); }
 break;
 case 139:
-#line 512 "perly.y"
+#line 511 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
 break;
 case 140:
-#line 514 "perly.y"
+#line 513 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
 case 141:
-#line 516 "perly.y"
+#line 515 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
 break;
 case 142:
-#line 518 "perly.y"
+#line 517 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
 break;
 case 145:
-#line 524 "perly.y"
+#line 523 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 146:
-#line 526 "perly.y"
+#line 525 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 147:
-#line 530 "perly.y"
+#line 529 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 148:
-#line 532 "perly.y"
+#line 531 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 149:
-#line 534 "perly.y"
+#line 533 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 150:
-#line 538 "perly.y"
+#line 537 "perly.y"
 { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 151:
-#line 542 "perly.y"
+#line 541 "perly.y"
 { yyval.opval = newSVREF(yyvsp[0].opval); }
 break;
 case 152:
-#line 546 "perly.y"
+#line 545 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 153:
-#line 550 "perly.y"
+#line 549 "perly.y"
 { yyval.opval = newHVREF(yyvsp[0].opval); }
 break;
 case 154:
-#line 554 "perly.y"
+#line 553 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 155:
-#line 558 "perly.y"
+#line 557 "perly.y"
 { yyval.opval = newGVREF(0,yyvsp[0].opval); }
 break;
 case 156:
-#line 562 "perly.y"
+#line 561 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval); }
 break;
 case 157:
-#line 564 "perly.y"
+#line 563 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval);  }
 break;
 case 158:
-#line 566 "perly.y"
+#line 565 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 159:
-#line 569 "perly.y"
+#line 568 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2237 "y.tab.c"
+#line 2236 "y.tab.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
index 37b1b92..3b3c04e 100644 (file)
@@ -1,5 +1,5 @@
-*** perly.c.orig       Thu Feb  1 20:47:42 1996
---- perly.c    Thu Feb  1 20:47:43 1996
+*** perly.c.orig       Wed Feb 14 15:29:04 1996
+--- perly.c    Wed Feb 14 15:29:05 1996
 ***************
 *** 12,82 ****
       deprecate("\"do\" to call subroutines");
@@ -86,7 +86,7 @@
 - short yyss[YYSTACKSIZE];
 - YYSTYPE yyvs[YYSTACKSIZE];
 - #define yystacksize YYSTACKSIZE
-  #line 572 "perly.y"
+  #line 571 "perly.y"
    /* PROGRAM */
   #line 1394 "y.tab.c"
 --- 1316,1323 ----
   #endif
       yym = yylen[yyn];
 ***************
-*** 2243,2250 ****
+*** 2242,2249 ****
       {
   #if YYDEBUG
           if (yydebug)
   #endif
           yystate = YYFINAL;
           *++yyssp = YYFINAL;
---- 2257,2265 ----
+--- 2256,2264 ----
       {
   #if YYDEBUG
           if (yydebug)
           yystate = YYFINAL;
           *++yyssp = YYFINAL;
 ***************
-*** 2258,2264 ****
+*** 2257,2263 ****
                   yys = 0;
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
                           YYFINAL, yychar, yys);
               }
   #endif
---- 2273,2279 ----
+--- 2272,2278 ----
                   yys = 0;
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
               }
   #endif
 ***************
-*** 2273,2292 ****
+*** 2272,2291 ****
           yystate = yydgoto[yym];
   #if YYDEBUG
       if (yydebug)
   yyaccept:
 !     return (0);
   }
---- 2288,2322 ----
+--- 2287,2321 ----
           yystate = yydgoto[yym];
   #if YYDEBUG
       if (yydebug)
diff --git a/perly.y b/perly.y
index 099969f..96a35e1 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -453,8 +453,7 @@ term        :       term ASSIGNOP term
                            append_elem(OP_LIST, $3, scalar($1))); }
        |       NOAMP WORD listexpr
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                           append_elem(OP_LIST,
-                               $3, newCVREF(0,scalar($2)))); }
+                           append_elem(OP_LIST, $3, scalar($2))); }
        |       DO term %prec UNIOP
                        { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
        |       DO block        %prec '('
index 130bc8d..38edda1 100644 (file)
@@ -133,6 +133,10 @@ which provides a race condition that breaks security.
 (F) Perl can't peek at the stdio buffer of filehandles when it doesn't
 know about your kind of stdio.  You'll have to use a filename instead.
 
+=item 500 Server error
+
+See Server error.
+
 =item ?+* follows nothing in regexp
 
 (F) You started a regular expression with a quantifier.  Backslash it
@@ -1751,6 +1755,15 @@ but has not yet been written.  See L<perlre>.
 (F) You used a regular expression extension that doesn't make sense.
 See L<perlre>.
 
+=item Server error
+
+Also known as "500 Server error".  This is a CGI error, not a Perl
+error.  You need to make sure your script is executable, is accessible
+by the user CGI is running the script under (which is probably not
+the user account you tested it under), does not rely on any environment
+variables (like PATH) from the user it isn't running under, and isn't
+in a location where the CGI server can't find it, basically, more or less.
+
 =item setegid() not implemented
 
 (F) You tried to assign to $), and your operating system doesn't support
index 7017c8f..6b31253 100644 (file)
@@ -628,6 +628,21 @@ Examples:
 
 See also undef().
 
+Note: many folks tend to overuse defined(), and then are surprised to
+discover that the number 0 and the null string are, in fact, defined
+concepts.  For example, if you say
+
+    "ab" =~ /a(.*)b/;
+
+the pattern match succeeds, and $1 is defined, despite the fact that it
+matched "nothing".  But it didn't really match nothing--rather, it
+matched something that happened to be 0 characters long.  This is all
+very above-board and honest.  When a function returns an undefined value,
+it's an admission that it couldn't give you an honest answer.  So
+you should only use defined() when you're questioning the integrity
+of what you're trying to do.  At other times, a simple comparison to
+0 or "" is what you want.
+
 =item delete EXPR
 
 Deletes the specified value from its hash array.  Returns the deleted
index d96afc5..810cff3 100644 (file)
@@ -32,7 +32,7 @@ operate on scalar values only, not array values.
     right      = += -= *= etc.
     left       , =>
     nonassoc   list operators (rightward)
-    left       not
+    right      not
     left       and
     left       or xor
 
@@ -562,7 +562,6 @@ are interpolated, as are the following sequences:
     \n         newline
     \r         return
     \f         form feed
-    \v         vertical tab, whatever that is
     \b         backspace
     \a         alarm (bell)
     \e         escape
index 1c7855c..41a3d5f 100644 (file)
@@ -104,7 +104,6 @@ also work:
     \n         newline
     \r         return
     \f         form feed
-    \v         vertical tab, whatever that is
     \a         alarm (bell)
     \e         escape (think troff)
     \033       octal char (think of a PDP-11)
index fe8a154..7169515 100644 (file)
@@ -260,11 +260,19 @@ C<-M>I<module> executes C<use> I<module> C<;> before executing your
 script.  You can use quotes to add extra code after the module name,
 e.g., C<-M'module qw(foo bar)'>.
 
+If the first character after the C<-M> or C<-m> is a dash (C<->)
+then the 'use' is replaced with 'no'.
+
 A little built-in syntactic sugar means you can also say
 C<-mmodule=foo> or C<-Mmodule=foo> as a shortcut for
 C<-M'module qw(foo)'>.  Note that using the C<=> form
 removes the distinction between C<-m> and C<-M>.
 
+To avoid the need to use quotes when importing more that one symbol
+with the C<=> form, the text following the C<=> is split into a list
+on commas (C<,>) rather than whitespace. The actual code generated
+by C<-Mmodule=foo,bar> is C<use module split(/,/,q{foo,bar})>.
+
 =item B<-n>
 
 causes Perl to assume the following loop around your script, which
index 0c37604..5e7699b 100644 (file)
@@ -27,12 +27,11 @@ See L<perlxstut> for a tutorial on the whole extension creation process.
 
 =head2 On The Road
 
-Many of the examples which follow will concentrate on creating an
-interface between Perl and the ONC+ RPC bind library functions.
-Specifically, the rpcb_gettime() function will be used to demonstrate many
-features of the XS language.  This function has two parameters; the first
-is an input parameter and the second is an output parameter.  The function
-also returns a status value.
+Many of the examples which follow will concentrate on creating an interface
+between Perl and the ONC+ RPC bind library functions.  The rpcb_gettime()
+function is used to demonstrate many features of the XS language.  This
+function has two parameters; the first is an input parameter and the second
+is an output parameter.  The function also returns a status value.
 
        bool_t rpcb_gettime(const char *host, time_t *timep);
 
@@ -845,10 +844,10 @@ the function will be called using the THIS->method() syntax.
 
 The next examples will use the following C++ class.
 
-     class colors {
+     class color {
           public:
-          colors();
-          ~colors();
+          color();
+          ~color();
           int blue();
           void set_blue( int );
 
@@ -1115,9 +1114,9 @@ File C<rpctest.pl>: Perl test program for the RPC extension.
 
 =head1 XS VERSION
 
-This document covers features supported by C<xsubpp> 1.931.
+This document covers features supported by C<xsubpp> 1.933.
 
 =head1 AUTHOR
 
 Dean Roehrich F<E<lt>roehrich@cray.comE<gt>>
-Jan 25, 1996
+Feb 13, 1996
diff --git a/pp.c b/pp.c
index 7da420b..54433af 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -132,7 +132,7 @@ PP(pp_rv2gv)
 
        if (op->op_flags & OPf_SPECIAL) {
            GvGP(sv)->gp_refcnt++;              /* will soon be assigned */
-           GvFLAGS(sv) |= GVf_INTRO;
+           GvINTRO_on(sv);
        }
        else {
            GP *gp;
@@ -273,9 +273,8 @@ PP(pp_anoncode)
     CV* cv = (CV*)cSVOP->op_sv;
     EXTEND(SP,1);
 
-    if (SvFLAGS(cv) & SVpcv_CLONE) {
+    if (CvCLONE(cv))
        cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
-    }
 
     PUSHs((SV*)cv);
     RETURN;
index 7416f0e..1f558f7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -937,7 +937,7 @@ die(pat, va_alist)
     }
     restartop = die_where(message);
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
-       longjmp(top_env, 3);
+       Siglongjmp(top_env, 3);
     return restartop;
 }
 
@@ -997,11 +997,10 @@ char *message;
        }
     }
     fputs(message, stderr);
-    (void)fflush(stderr);
+    (void)Fflush(stderr);
     if (e_fp) {
-#ifdef DOSISH
        fclose(e_fp);
-#endif 
+       e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
     }
     statusvalue = SHIFTSTATUS(statusvalue);
@@ -1135,7 +1134,7 @@ PP(pp_caller)
            GV* tmpgv;
            dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
                                SVt_PVAV)));
-           SvMULTI_on(tmpgv);
+           GvMULTI_on(tmpgv);
            AvREAL_off(dbargs);         /* XXX Should be REIFY */
        }
 
@@ -1828,6 +1827,9 @@ PP(pp_goto)
     }
 
     if (do_dump) {
+#ifdef VMS
+       if (!retop) retop = main_start;
+#endif
        restartop = retop;
        do_undump = TRUE;
 
@@ -1839,7 +1841,7 @@ PP(pp_goto)
 
     if (stack == signalstack) {
         restartop = retop;
-        longjmp(top_env, 3);
+        Siglongjmp(top_env, 3);
     }
 
     RETURNOP(retop);
@@ -2038,9 +2040,9 @@ PP(pp_require)
 
     sv = POPs;
     if (SvNIOKp(sv) && !SvPOKp(sv)) {
-       if (atof(patchlevel) + 0.000999 < SvNV(sv))
-           DIE("Perl %3.3f required--this is only version %s, stopped",
-               SvNV(sv),patchlevel);
+       if (atof(patchlevel) + 0.00000999 < SvNV(sv))
+           DIE("Perl %s required--this is only version %s, stopped",
+               SvPV(sv,na),patchlevel);
        RETPUSHYES;
     }
     name = SvPV(sv, na);
index 5988d2e..63362c4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -373,7 +373,7 @@ PP(pp_print)
                    goto just_say_no;
 
            if (IoFLAGS(io) & IOf_FLUSH)
-               if (fflush(fp) == EOF)
+               if (Fflush(fp) == EOF)
                    goto just_say_no;
        }
     }
@@ -1720,8 +1720,10 @@ PP(pp_entersub)
     if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) {
        sv = GvSV(DBsub);
        save_item(sv);
-       if (SvFLAGS(cv) & (SVpcv_ANON | SVpcv_CLONED)) /* Is GV potentially non-unique? */
+       if (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) {
+           /* GV is potentially non-unique */
            sv_setsv(sv, newRV((SV*)cv));
+       }
        else {
            gv = CvGV(cv);
            gv_efullname(sv,gv);
index f0c9d1d..b389f57 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -365,7 +365,7 @@ PP(pp_binmode)
 
 #ifdef DOSISH
 #ifdef atarist
-    if (!fflush(fp) && (fp->_flag |= _IOBIN))
+    if (!Fflush(fp) && (fp->_flag |= _IOBIN))
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -452,7 +452,7 @@ PP(pp_untie)
 
 PP(pp_tied)
 {
-    dSP; dTARGET ;
+    dSP;
     SV * sv ;
     MAGIC * mg ;
 
@@ -919,7 +919,7 @@ PP(pp_leavewrite)
            SvCUR_set(formtarget, 0);
            *SvEND(formtarget) = '\0';
            if (IoFLAGS(io) & IOf_FLUSH)
-               (void)fflush(fp);
+               (void)Fflush(fp);
            PUSHs(&sv_yes);
        }
     }
@@ -965,7 +965,7 @@ PP(pp_prtf)
            goto just_say_no;
 
        if (IoFLAGS(io) & IOf_FLUSH)
-           if (fflush(fp) == EOF)
+           if (Fflush(fp) == EOF)
                goto just_say_no;
     }
     SvREFCNT_dec(sv);
@@ -982,9 +982,8 @@ PP(pp_prtf)
 
 PP(pp_sysopen)
 {
-    dSP; dTARGET;
+    dSP;
     GV *gv;
-    IO *io;
     SV *sv;
     char *tmps;
     STRLEN len;
diff --git a/sv.c b/sv.c
index 34c1e95..a1f1d60 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -210,6 +210,27 @@ sv_clean_objs()
     register SV* svend;
     SV* rv;
 
+#ifndef DISABLE_DESTRUCTOR_KLUDGE
+    register GV* gv;
+    for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+       gv = sva + 1;
+       svend = &sva[SvREFCNT(sva)];
+       while (gv < svend) {
+           if (SvTYPE(gv) == SVt_PVGV && (sv = GvSV(gv)) &&
+               SvROK(sv) && SvOBJECT(rv = SvRV(sv)))
+           {
+               DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
+                        sv_dump(sv));)
+               SvROK_off(sv);
+               SvRV(sv) = 0;
+               SvREFCNT_dec(rv);
+           }
+           ++gv;
+       }
+    }
+    if (!sv_objcount)
+       return;
+#endif
     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
        sv = sva + 1;
        svend = &sva[SvREFCNT(sva)];
@@ -503,6 +524,9 @@ U32 mt;
     if (SvTYPE(sv) == mt)
        return TRUE;
 
+    if (mt < SVt_PVIV)
+       (void)SvOOK_off(sv);
+
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        pv      = 0;
@@ -719,6 +743,7 @@ U32 mt;
        GvNAME(sv)      = 0;
        GvNAMELEN(sv)   = 0;
        GvSTASH(sv)     = 0;
+       GvFLAGS(sv)     = 0;
        break;
     case SVt_PVBM:
        SvANY(sv) = new_XPVBM();
@@ -1004,8 +1029,8 @@ IV i;
        croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
            op_name[op->op_type]);
     }
-    SvIVX(sv) = i;
     (void)SvIOK_only(sv);                      /* validate number */
+    SvIVX(sv) = i;
     SvTAINT(sv);
 }
 
@@ -1157,6 +1182,7 @@ register SV *sv;
        break;
     }
     if (SvNOKp(sv)) {
+       (void)SvIOK_on(sv);
        if (SvNVX(sv) < 0.0)
            SvIVX(sv) = I_V(SvNVX(sv));
        else
@@ -1165,6 +1191,7 @@ register SV *sv;
     else if (SvPOKp(sv) && SvLEN(sv)) {
        if (dowarn && !looks_like_number(sv))
            not_a_number(sv);
+       (void)SvIOK_on(sv);
        SvIVX(sv) = (IV)atol(SvPVX(sv));
     }
     else  {
@@ -1172,7 +1199,6 @@ register SV *sv;
            warn(warn_uninit);
        return 0;
     }
-    (void)SvIOK_on(sv);
     DEBUG_c(fprintf(stderr,"0x%lx 2iv(%ld)\n",
        (unsigned long)sv,(long)SvIVX(sv)));
     return SvIVX(sv);
@@ -1522,6 +1548,12 @@ register SV *sstr;
        else if (dtype == SVt_PVGV &&
                 SvTYPE(SvRV(sstr)) == SVt_PVGV) {
            sstr = SvRV(sstr);
+           if (sstr == dstr) {
+               if (curcop->cop_stash != GvSTASH(dstr))
+                   GvIMPORTED_on(dstr);
+               GvMULTI_on(dstr);
+               return;
+           }
            goto glob_assign;
        }
        break;
@@ -1556,9 +1588,7 @@ register SV *sstr;
     case SVt_PVGV:
        if (dtype <= SVt_PVGV) {
   glob_assign:
-           if (dtype == SVt_PVGV)
-               GvFLAGS(sstr) |= GVf_IMPORTED;
-           else {
+           if (dtype != SVt_PVGV) {
                char *name = GvNAME(sstr);
                STRLEN len = GvNAMELEN(sstr);
                sv_upgrade(dstr, SVt_PVGV);
@@ -1569,12 +1599,13 @@ register SV *sstr;
                SvFAKE_on(dstr);        /* can coerce to non-glob */
            }
            (void)SvOK_off(dstr);
-           if (GvGP(dstr))
-               gp_free(dstr);
+           GvINTRO_off(dstr);          /* one-shot flag */
+           gp_free(dstr);
            GvGP(dstr) = gp_ref(GvGP(sstr));
            SvTAINT(dstr);
-           GvFLAGS(dstr) &= ~GVf_INTRO;        /* one-shot flag */
-           SvMULTI_on(dstr);
+           if (curcop->cop_stash != GvSTASH(dstr))
+               GvIMPORTED_on(dstr);
+           GvMULTI_on(dstr);
            return;
        }
        /* FALL THROUGH */
@@ -1593,20 +1624,20 @@ register SV *sstr;
            if (dtype == SVt_PVGV) {
                SV *sref = SvREFCNT_inc(SvRV(sstr));
                SV *dref = 0;
-               int intro = GvFLAGS(dstr) & GVf_INTRO;
+               int intro = GvINTRO(dstr);
 
                if (intro) {
                    GP *gp;
                    GvGP(dstr)->gp_refcnt--;
+                   GvINTRO_off(dstr);  /* one-shot flag */
                    Newz(602,gp, 1, GP);
                    GvGP(dstr) = gp;
                    GvREFCNT(dstr) = 1;
                    GvSV(dstr) = NEWSV(72,0);
                    GvLINE(dstr) = curcop->cop_line;
                    GvEGV(dstr) = dstr;
-                   GvFLAGS(dstr) &= ~GVf_INTRO;        /* one-shot flag */
                }
-               SvMULTI_on(dstr);
+               GvMULTI_on(dstr);
                switch (SvTYPE(sref)) {
                case SVt_PVAV:
                    if (intro)
@@ -1614,6 +1645,8 @@ register SV *sstr;
                    else
                        dref = (SV*)GvAV(dstr);
                    GvAV(dstr) = (AV*)sref;
+                   if (curcop->cop_stash != GvSTASH(dstr))
+                       GvIMPORTED_AV_on(dstr);
                    break;
                case SVt_PVHV:
                    if (intro)
@@ -1621,6 +1654,8 @@ register SV *sstr;
                    else
                        dref = (SV*)GvHV(dstr);
                    GvHV(dstr) = (HV*)sref;
+                   if (curcop->cop_stash != GvSTASH(dstr))
+                       GvIMPORTED_HV_on(dstr);
                    break;
                case SVt_PVCV:
                    if (intro)
@@ -1637,7 +1672,12 @@ register SV *sstr;
                            SvFAKE_on(cv);
                        }
                    }
-                   GvCV(dstr) = (CV*)sref;
+                   if (GvCV(dstr) != (CV*)sref) {
+                       GvCV(dstr) = (CV*)sref;
+                       GvASSUMECV_on(dstr);
+                   }
+                   if (curcop->cop_stash != GvSTASH(dstr))
+                       GvIMPORTED_CV_on(dstr);
                    break;
                case SVt_PVIO:
                    if (intro)
@@ -1652,10 +1692,10 @@ register SV *sstr;
                    else
                        dref = (SV*)GvSV(dstr);
                    GvSV(dstr) = sref;
+                   if (curcop->cop_stash != GvSTASH(dstr))
+                       GvIMPORTED_SV_on(dstr);
                    break;
                }
-               if (curcop->cop_stash != GvSTASH(dstr))
-                   GvFLAGS(dstr) |= GVf_IMPORTED;      /* crude */
                if (dref)
                    SvREFCNT_dec(dref);
                if (intro)
@@ -1694,20 +1734,27 @@ register SV *sstr;
         * has to be allocated and SvPVX(sstr) has to be freed.
         */
 
-       if (SvTEMP(sstr)) {             /* slated for free anyway? */
+       if (SvTEMP(sstr) &&             /* slated for free anyway? */
+           !(sflags & SVf_OOK))        /* and not involved in OOK hack? */
+       {
            if (SvPVX(dstr)) {          /* we know that dtype >= SVt_PV */
-               (void)SvOOK_off(dstr);
-               Safefree(SvPVX(dstr));
+               if (SvOOK(dstr)) {
+                   SvFLAGS(dstr) &= ~SVf_OOK;
+                   Safefree(SvPVX(dstr) - SvIVX(dstr));
+               }
+               else
+                   Safefree(SvPVX(dstr));
            }
+           (void)SvPOK_only(dstr);
            SvPV_set(dstr, SvPVX(sstr));
            SvLEN_set(dstr, SvLEN(sstr));
            SvCUR_set(dstr, SvCUR(sstr));
-           (void)SvPOK_only(dstr);
            SvTEMP_off(dstr);
+           (void)SvOK_off(sstr);
            SvPV_set(sstr, Nullch);
            SvLEN_set(sstr, 0);
-           SvPOK_off(sstr);                    /* wipe out any weird flags */
-           SvPVX(sstr) = 0;                    /* so sstr frees uneventfully */
+           SvCUR_set(sstr, 0);
+           SvTEMP_off(sstr);
        }
        else {                                  /* have to copy actual string */
            STRLEN len = SvCUR(sstr);
@@ -2578,6 +2625,7 @@ I32 append;
                memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */    
                bp += cnt;                           /* screams  |  dust */   
                ptr += cnt;                          /* louder   |  sed :-) */
+               cnt = 0;
            }
        }
        
@@ -2696,8 +2744,8 @@ register SV *sv;
        mg_get(sv);
     flags = SvFLAGS(sv);
     if (flags & SVp_IOK) {
-       ++SvIVX(sv);
        (void)SvIOK_only(sv);
+       ++SvIVX(sv);
        return;
     }
     if (flags & SVp_NOK) {
@@ -2766,8 +2814,8 @@ register SV *sv;
        mg_get(sv);
     flags = SvFLAGS(sv);
     if (flags & SVp_IOK) {
-       --SvIVX(sv);
        (void)SvIOK_only(sv);
+       --SvIVX(sv);
        return;
     }
     if (flags & SVp_NOK) {
@@ -3349,7 +3397,7 @@ SV* sv;
        gp_free(sv);
     sv_unmagic(sv, '*');
     Safefree(GvNAME(sv));
-    SvMULTI_off(sv);
+    GvMULTI_off(sv);
     SvFLAGS(sv) &= ~SVTYPEMASK;
     SvFLAGS(sv) |= SVt_PVMG;
 }
diff --git a/sv.h b/sv.h
index 194abd1..4e5592d 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -129,12 +129,6 @@ struct io {
 #define SVpbm_CASEFOLD 0x40000000
 #define SVpbm_TAIL     0x20000000
 
-#define SVpgv_MULTI    0x80000000
-
-#define SVpcv_CLONE    0x80000000      /* anon CV uses external lexicals */
-#define SVpcv_CLONED   0x40000000      /* a clone of one of those */
-#define SVpcv_ANON     0x20000000      /* CvGV() can't be trusted */
-
 #ifdef OVERLOAD
 #define SVpgv_AM        0x40000000
 /* #define SVpgv_badAM     0x20000000 */
@@ -203,6 +197,7 @@ struct xpvgv {
     char*      xgv_name;
     STRLEN     xgv_namelen;
     HV*                xgv_stash;
+    U8         xgv_flags;
 };
 
 struct xpvbm {
@@ -301,7 +296,7 @@ struct xpvio {
 #define SvIOK_on(sv)           (SvOOK_off(sv), \
                                    SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
 #define SvIOK_off(sv)          (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK))
-#define SvIOK_only(sv)         (SvOK_off(sv), \
+#define SvIOK_only(sv)         (SvOOK_off(sv), SvOK_off(sv), \
                                    SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
 
 #define SvNOK(sv)              (SvFLAGS(sv) & SVf_NOK)
@@ -411,10 +406,6 @@ struct xpvio {
 #define SvVALID_on(sv)         (SvFLAGS(sv) |= SVpbm_VALID)
 #define SvVALID_off(sv)                (SvFLAGS(sv) &= ~SVpbm_VALID)
 
-#define SvMULTI(sv)            (SvFLAGS(sv) & SVpgv_MULTI)
-#define SvMULTI_on(sv)         (SvFLAGS(sv) |= SVpgv_MULTI)
-#define SvMULTI_off(sv)                (SvFLAGS(sv) &= ~SVpgv_MULTI)
-
 #define SvRV(sv) ((XRV*)  SvANY(sv))->xrv_rv
 #define SvRVx(sv) SvRV(sv)
 
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/t/harness b/t/harness
new file mode 100644 (file)
index 0000000..c98d91e
--- /dev/null
+++ b/t/harness
@@ -0,0 +1,15 @@
+#!./perl
+
+# We suppose that perl _mostly_ works at this moment, so may use
+# sophisticated testing.
+
+# Note that _before install_ you may need to run it with -I ../lib flag
+
+use lib '../lib';
+use Test::Harness;
+
+$Test::Harness::switches = ""; # Too much noise otherwise
+
+@tests = @ARGV;
+@tests = <*/*.t> unless @tests;
+Test::Harness::runtests @tests;
old mode 100755 (executable)
new mode 100644 (file)
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/toke.c b/toke.c
index 54c0919..7bb61c9 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -276,7 +276,7 @@ void *f;
 
     if (rsfp == stdin)
        clearerr(rsfp);
-    else if (rsfp != fp)
+    else if (rsfp && (rsfp != fp))
        fclose(rsfp);
     rsfp = fp;
 }
@@ -1877,6 +1877,24 @@ yylex()
        if (expect == XSTATE && isALPHA(tmp) &&
                (s == SvPVX(linestr)+1 || s[-2] == '\n') )
        {
+           if (in_eval && !rsfp) {
+               d = bufend;
+               while (s < d) {
+                   if (*s++ == '\n') {
+                       incline(s);
+                       if (strnEQ(s,"=cut",4)) {
+                           s = strchr(s,'\n');
+                           if (s)
+                               s++;
+                           else
+                               s = d;
+                           incline(s);
+                           goto retry;
+                       }
+                   }
+               }
+               goto retry;
+           }
            s = bufend;
            doextract = TRUE;
            goto retry;
@@ -2297,10 +2315,9 @@ yylex()
        if (tmp < 0) {                  /* second-class keyword? */
            GV* gv;
            if (expect != XOPERATOR &&
-             (*s != ':' || s[1] != ':') &&
-             (gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV)) &&
-             (GvFLAGS(gv) & GVf_IMPORTED) &&
-             GvCV(gv))
+               (*s != ':' || s[1] != ':') &&
+               (gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
+               GvIMPORTED_CV(gv))
            {
                tmp = 0;
            }
@@ -2415,8 +2432,8 @@ yylex()
 
                if (gv && GvCV(gv)) {
                    CV* cv = GvCV(gv);
-                   nextval[nexttoke].opval = yylval.opval;
                    if (*s == '(') {
+                       nextval[nexttoke].opval = yylval.opval;
                        expect = XTERM;
                        force_next(WORD);
                        yylval.ival = 0;
@@ -2427,6 +2444,9 @@ yylex()
                                tokenbuf, tokenbuf);
                    last_lop = oldbufptr;
                    last_lop_op = OP_ENTERSUB;
+                   /* Resolve to GV now. */
+                   op_free(yylval.opval);
+                   yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
                    /* Is there a prototype? */
                    if (SvPOK(cv)) {
                        STRLEN len;
@@ -2440,6 +2460,7 @@ yylex()
                            PREBLOCK(LSTOPSUB);
                        }
                    }
+                   nextval[nexttoke].opval = yylval.opval;
                    expect = XTERM;
                    force_next(WORD);
                    TOKEN(NOAMP);
@@ -2492,14 +2513,14 @@ yylex()
            GV *gv;
 
            /*SUPPRESS 560*/
-           if (!in_eval || tokenbuf[2] == 'D') {
+           if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
                char dname[256];
                char *pname = "main";
                if (tokenbuf[2] == 'D')
                    pname = HvNAME(curstash ? curstash : defstash);
                sprintf(dname,"%s::DATA", pname);
                gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
-               SvMULTI_on(gv);
+               GvMULTI_on(gv);
                if (!GvIO(gv))
                    GvIOp(gv) = newIO();
                IoIFP(GvIOp(gv)) = rsfp;
index 281f4bc..4308db8 100644 (file)
--- a/unixish.h
+++ b/unixish.h
@@ -73,6 +73,7 @@
 
 #define Stat(fname,bufptr) stat((fname),(bufptr))
 #define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
 
 #define my_getenv(var) getenv(var)
 
diff --git a/util.c b/util.c
index 8ce3d32..c8cbc2b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -821,14 +821,13 @@ long a1, a2, a3, a4;
     }
     if (in_eval) {
        restartop = die_where(message);
-       longjmp(top_env, 3);
+       Siglongjmp(top_env, 3);
     }
     fputs(message,stderr);
-    (void)fflush(stderr);
+    (void)Fflush(stderr);
     if (e_fp) {
-#ifdef DOSISH
-        fclose(e_fp);
-#endif
+       fclose(e_fp);
+       e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
     }
     statusvalue = SHIFTSTATUS(statusvalue);
@@ -865,7 +864,7 @@ long a1, a2, a3, a4;
 #ifdef LEAKTEST
        DEBUG_L(xstat());
 #endif
-       (void)fflush(stderr);
+       (void)Fflush(stderr);
     }
 }
 
@@ -981,14 +980,13 @@ croak(pat, va_alist)
     }
     if (in_eval) {
        restartop = die_where(message);
-       longjmp(top_env, 3);
+       Siglongjmp(top_env, 3);
     }
     fputs(message,stderr);
-    (void)fflush(stderr);
+    (void)Fflush(stderr);
     if (e_fp) {
-#ifdef DOSISH
-        fclose(e_fp);
-#endif
+       fclose(e_fp);
+       e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
     }
     statusvalue = SHIFTSTATUS(statusvalue);
@@ -1037,7 +1035,7 @@ warn(pat,va_alist)
 #ifdef LEAKTEST
        DEBUG_L(xstat());
 #endif
-       (void)fflush(stderr);
+       (void)Fflush(stderr);
     }
 }
 #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
index 375bb78..a3aaefe 100644 (file)
@@ -51,16 +51,18 @@ use strict;
 sub paraprint;
 
 
-my($Version) = "1.11";
+my($Version) = "1.12";
 
 # 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.08 to use correct address for sendmail
+# Changed in 1.07 to see more sendmail execs, and added pipe output.
+# Changed in 1.08 to use correct address for sendmail.
 # Changed in 1.09 to close the REP file before calling it up in the editor.
 #                 Also removed some old comments duplicated elsewhere.
 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
-#                 temp filename generation
+#                 temp filename generation.
 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
+# Changed in 1.12 to check for editor errors, make save/send distinction
+#                 clearer and add $ENV{REPLYTO}.
 
 # TODO: Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is 
@@ -204,20 +206,23 @@ EOF
                        $guess = "$me\@$domain" if $domain;
                        $guess = "$me\@unknown.addresss" unless $domain;
                        }
+                       
+               $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
+               $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
        
                if( $guess ) {
                        paraprint <<EOF;
 
 
-Your e-mail address will be useful if you need to be contacted.
-If the default shown is not your proper address, please correct it.
+Your e-mail address will be useful if you need to be contacted. If the
+default shown is not your full internet e-mail address, please correct it.
 
 EOF
                } else {
                        paraprint <<EOF;
 
 So that you may be contacted if necessary, please enter 
-your e-mail address here.
+your full internet e-mail address here.
 
 EOF
                }
@@ -394,10 +399,34 @@ EOF
 sub Edit {
        # Edit the report
        
+tryagain:      
        if(!$file and !$body) {
                my($sts) = system("$ed $filename");
                if( $Is_VMS ? !($sts & 1) : $sts ) {
-                       print "\nUnable to run editor!\n";
+                       #print "\nUnable to run editor!\n";
+                       paraprint <<EOF;
+
+The editor you chose (`$ed') could apparently not be run!
+Did you mistype the name of your editor? If so, please
+correct it here, otherwise just press Enter. 
+
+EOF
+                       print "Editor [$ed]: ";
+               
+                       my($entry) =scalar(<>);
+                       chop $entry;
+       
+                       if($entry ne "") {
+                               $ed = $entry;
+                               goto tryagain;
+                       } else {
+                       
+                       paraprint <<EOF;
+
+You may want to save your report to a file, so you can edit and mail it
+yourself.
+EOF
+                       }
                } 
        }
 }
@@ -418,14 +447,11 @@ You may also save the message as a file to mail at another time.
 
 EOF
 
-                       print "Action (Send/Display/Edit/Cancel/File): ";
+                       print "Action (Send/Display/Edit/Cancel/Save to File): ";
                        my($action) = scalar(<>);
                        chop $action;
 
-                       if($action =~ /^s/i) { # Send
-                               # Send the message
-                               last;
-                       } elsif($action =~ /^f/i) { # File
+                       if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
                                print "\n\nName of file to save message in [perlbug.rep]: ";
                                my($file) = scalar(<>);
                                chop $file;
@@ -444,15 +470,19 @@ EOF
                                print "\nMessage saved in `$file'.\n";
                                exit;
 
-                       } elsif($action =~ /^[drl]/i) { # Display, Redisplay, List
+                       } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
                                # Display the message
                                open(REP,"<$filename");
                                while(<REP>) { print $_ }
                                close(REP);
-                       } elsif($action =~ /^e/i) { # Edit
+                       } elsif( $action =~ /^s/i ) { # <S>end
+                               # Send the message
+                               last;
+                       } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
                                # edit the message
-                               system("$ed $filename");
-                       } elsif($action =~ /^[qc]/i) { # Cancel, Quit
+                               Edit();
+                               #system("$ed $filename");
+                       } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
                                1 while unlink($filename);  # remove all versions under VMS
                                print "\nCancelling.\n";
                                exit(0);
index d34245c..04fcfeb 100644 (file)
@@ -1,5 +1,5 @@
 # Descrip.MMS for perl5 on VMS
-# Last revised 17-Jan-1995 by Charles Bailey  bailey@genetics.upenn.edu
+# Last revised 22-Feb-1996 by Charles Bailey  bailey@genetics.upenn.edu
 #
 #: This file uses MMS syntax, and can be processed using DEC's MMS product,
 #: or the free MMK clone (available by ftp at ftp.spc.edu).  If you want to
@@ -230,6 +230,9 @@ CRTL = []crtl.opt
 CRTLOPTS =,$(CRTL)/Options
 
 .SUFFIXES
+
+.ifdef LINK_ONLY
+.else
 .SUFFIXES $(O) .c .xs
 
 .xs.c :
@@ -242,12 +245,14 @@ CRTLOPTS =,$(CRTL)/Options
 .xs$(O) :
        $(XSUBPP) $(MMS$SOURCE) >$(MMS$SOURCE_NAME).c
        $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
+.endif
+
 
 all : base extras archcorefiles preplibrary perlpods
        @ $(NOOP)
 base : miniperl$(E) perl$(E)
        @ $(NOOP)
-extras : FileHandle Safe libmods utils podxform
+extras : Fcntl FileHandle Safe libmods utils podxform
        @ $(NOOP)
 libmods : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm 
        @ $(NOOP)
@@ -286,29 +291,38 @@ $(DBG)libperl$(OLB) : $(obj)
 perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl
        $(MINIPERL) [.VMS]Writemain.pl "$(EXT)"
 
-perl$(E) : perlmain$(O), perlshr$(E), $(MINIPERL_EXE)
+$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
        @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
 .ifdef gnuc
        @ @[.vms]genopt "PerlShr.Opt/Append" "|" "$(LIBS1)|$(LIBS2)"
 .endif
        Link $(LINKFLAGS)/Exe=$(DBG)$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
-perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
+
+$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
        Link /NoTrace$(LINKFLAGS)/Share=$(DBG)$(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
 #  perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
+# The song and dance with gen_shrfls.opt accomodates DCL's 255 character
+# line length limit.
 .ifdef PIPES_BROKEN
 # This is a backup target used only with older versions of the DECCRTL which
 # can't deal with pipes properly.  See ReadMe.VMS for details.
 $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
        $(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h
-       $(MINIPERL) [.vms]gen_shrfls.pl "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)"
-       @ Delete/NoLog/NoConfirm perl.i;
+       @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" >gen_shrfls.opt
+       @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+       $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+       @ Delete/NoLog/NoConfirm perl.i;, gen_shrfls.opt;
        @ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
        @ Copy NLA0: $(DBG)perlshr_xtras.ts
 .else
 $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
-       $(MINIPERL) [.vms]gen_shrfls.pl "$(CC)$(CFLAGS)" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)"
+       @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt
+       @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+       $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+       @ Delete/NoLog/NoConfirm gen_shrfls.opt;
        @ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
        @ Copy NLA0: $(DBG)perlshr_xtras.ts
 .endif
@@ -317,8 +331,12 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(
        Create/Directory [.lib.$(ARCH)]
        Copy $(MMS$SOURCE) $(MMS$TARGET)
 
+# Once again, we accomodate DCL's 255 character buffer
 [.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE)
-       $(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) obj_ext=$(O) exe_ext=$(E) lib_ext=$(OLB)
+       @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt
+       @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt
+       $(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt
+       @ Delete/NoLog/NoConfirm genconfig.opt;
        $(MINIPERL) ConfigPM.
 
 [.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE)
@@ -335,6 +353,7 @@ Safe : [.lib]Safe.pm [.lib.auto]Safe$(E)
        @ $(NOOP)
 
 [.lib]Safe.pm : [.ext.Safe]Descrip.MMS
+       @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
        @ Set Default [.ext.Safe]
        $(MMS)
        @ Set Default [--]
@@ -347,12 +366,13 @@ Safe : [.lib]Safe.pm [.lib.auto]Safe$(E)
 # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
 # ${@} necessary to distract different versions of MM[SK]/make
 [.ext.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
-       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0:
+       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
 
 FileHandle : [.lib]FileHandle.pm [.lib.auto]FileHandle$(E)
        @ $(NOOP)
 
 [.lib]FileHandle.pm : [.ext.FileHandle]Descrip.MMS
+       @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
        @ Set Default [.ext.FileHandle]
        $(MMS)
        @ Set Default [--]
@@ -365,7 +385,26 @@ FileHandle : [.lib]FileHandle.pm [.lib.auto]FileHandle$(E)
 # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
 # ${@} necessary to distract different versions of MM[SK]/make
 [.ext.FileHandle]Descrip.MMS : [.ext.FileHandle]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
-       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0:
+       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
+
+Fcntl : [.lib]Fcntl.pm [.lib.auto]Fcntl$(E)
+       @ $(NOOP)
+
+[.lib]Fcntl.pm : [.ext.Fcntl]Descrip.MMS
+       @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+       @ Set Default [.ext.Fcntl]
+       $(MMS)
+       @ Set Default [--]
+
+[.lib.auto]Fcntl$(E) : [.ext.Fcntl]Descrip.MMS
+       @ Set Default [.ext.Fcntl]
+       $(MMS)
+       @ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
 
 [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm
        @ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS]
@@ -557,8 +596,18 @@ printconfig :
         @ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)"
 
 .ifdef SOCKET
+
+.ifdef LINK_ONLY
+.else
 $(SOCKOBJ) : $(SOCKC) $(SOCKH)
 
+[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c
+       $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
+
+[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE)
+       $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+.endif # !LINK_ONLY
+
 vmsish.h : $(SOCKH)
 
 $(SOCKC) : [.vms]$(SOCKC)
@@ -567,12 +616,6 @@ $(SOCKC) : [.vms]$(SOCKC)
 $(SOCKH) : [.vms]$(SOCKH)
        Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH)
 
-[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE)
-       $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
-
-[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c
-       $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
-
 [.lib]Socket.pm : [.ext.Socket]Socket.pm
        Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET)
 .endif
@@ -607,8 +650,11 @@ perly.h : [.vms]perly_h.vms
 #      rename y.tab.h perly.h
 #      $(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms
 
+.ifdef LINK_ONLY
+.else
 perly$(O) : perly.c, perly.h, $(h)
        $(CC) $(CFLAGS) $(MMS$SOURCE)
+.endif
 
 test : all
        - @[.VMS]Test.Com
@@ -714,6 +760,8 @@ $(ARCHAUTO)time.stamp :
        @ If F$Search("[.lib.$(ARCH)]auto.dir").eqs."" Then Create/Directory $(ARCHAUTO)
        @ If F$Search("$(MMS$TARGET)").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET)
 
+.ifdef LINK_ONLY
+.else
 # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
 av$(O) : EXTERN.h
 av$(O) : av.c
@@ -1340,6 +1388,7 @@ globals$(O) : scope.h
 globals$(O) : sv.h
 globals$(O) : vmsish.h
 globals$(O) : util.h
+.endif # !LINK_ONLY
 
 config.h : [.vms]config.vms
        Copy/Log/NoConfirm [.vms]config.vms []config.h
@@ -1409,6 +1458,9 @@ clean : tidy
        - If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;*
        - If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;*
        - If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);*
+       Set Default [.ext.Fcntl]
+       - $(MMS) clean
+       Set Default [--]
        Set Default [.ext.FileHandle]
        - $(MMS) clean
        Set Default [--]
@@ -1428,6 +1480,9 @@ realclean : clean
        - If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;*
        - If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;*
        - If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;*
+       Set Default [.ext.Fcntl]
+       - $(MMS) realclean
+       Set Default [--]
        Set Default [.ext.FileHandle]
        - $(MMS) realclean
        Set Default [--]
index c690cca..3ce67aa 100644 (file)
@@ -25,7 +25,7 @@ candelete('my:[VMS.or.Unix]file.specification');
 This package provides routines to simplify conversion between VMS and
 Unix syntax when processing file specifications.  This is useful when
 porting scripts designed to run under either OS, and also allows you
-to take advantage of conveniences provided by either syntax (e.g.
+to take advantage of conveniences provided by either syntax (I<e.g.>
 ability to easily concatenate Unix-style specifications).  In
 addition, it provides an additional file test routine, C<candelete>,
 which determines whether you have delete access to a file.
@@ -53,6 +53,12 @@ directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
 errors.  In general, any legal file specification will be converted
 properly, but garbage input tends to produce garbage output.  
 
+Each of these routines is prototyped as taking a single scalar
+argument, so you can use them as unary operators in complex
+expressions (as long as you don't use the C<&> form of
+subroutine call, which bypasses prototype checking).
+
+
 The routines provided are:
 
 =head2 vmsify
@@ -104,11 +110,13 @@ C<candelete> becomes part of the Perl core.
 
 =head1 REVISION
 
-This document was last revised 08-Dec-1995, for Perl 5.002.
+This document was last revised 22-Feb-1996, for Perl 5.002.
 
 =cut
 
 package VMS::Filespec;
+require 5.002;
+
 
 # If you want to use this package on a non-VMS system,
 # uncomment the following line.
@@ -182,7 +190,7 @@ sub rmsexpand {
   $fspec;
 }  
 
-sub vmsify {
+sub vmsify ($) {
   my($fspec) = @_;
   my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
 
@@ -215,7 +223,7 @@ sub vmsify {
   }
 }
 
-sub unixify {
+sub unixify ($) {
   my($fspec) = @_;
 
   return $fspec if $fspec !~ m#[:>\]]#;
@@ -244,7 +252,7 @@ sub unixify {
 }
 
 
-sub fileify {
+sub fileify ($) {
   my($path) = @_;
 
   if (!$path) { return undef }
@@ -279,7 +287,7 @@ sub fileify {
   }
 }
 
-sub pathify {
+sub pathify ($) {
   my($fspec) = @_;
 
   if (!$fspec) { return undef }
@@ -304,15 +312,15 @@ sub pathify {
   }
 }
 
-sub vmspath {
+sub vmspath ($) {
   pathify(vmsify($_[0]));
 }
 
-sub unixpath {
+sub unixpath ($) {
   pathify(unixify($_[0]));
 }
 
-sub candelete {
+sub candelete ($) {
   my($fspec) = @_;
   my($parent);
 
index e39b7c2..56ebc4b 100644 (file)
 #     (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)?
 #
 # Author: Charles Bailey  bailey@genetics.upenn.edu
-# Revised:  4-Dec-1995
+# Revised: 20-Feb-1996
 
 require 5.000;
 
 $debug = $ENV{'GEN_SHRFLS_DEBUG'};
+
+if ($ARGV[0] eq '-f') {
+  open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
+  print "Input taken from file $ARGV[1]\n" if $debug;
+  @ARGV = ();
+  while (<INP>) {
+    chomp;
+    push(@ARGV,split(/\|/,$_));
+  }
+  close INP;
+  print "Read input data | ",join(' | ',@ARGV)," |\n" if $debug > 1;
+}
+
 $cc_cmd = shift @ARGV;
 
 # Someday, we'll have $GetSyI built into perl . . .
@@ -75,7 +88,7 @@ if ($docc) {
   else { die "$0: Can't find perl.h\n"; }
 }
 else { 
-  ($junk,$ccvers,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
+  ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
   $isgcc = $cc_cmd =~ /case_hack/i
            or 0;  # for nice debug output
   $isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i)
@@ -158,7 +171,7 @@ if ($docc) {
     or die "$0: Can't preprocess ${dir}perl.h: $!\n";
 }
 else {
-  open(CPP,"$cpp_file") or die "$0: Can't read $cpp_file: $!\n";
+  open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
 }
 LINE: while (<CPP>) {
   while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
@@ -320,7 +333,7 @@ if ($isvax) {
 # Linker wants /Include and /Library on different lines
 print OPTBLD "$libperl/Include=($incstr)\n";
 print OPTBLD "$libperl/Library\n";
-open(RTLOPT,$rtlopt) or die "$0: Can't read $rtlopt: $!\n";
+open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n";
 while (<RTLOPT>) { print OPTBLD; }
 close RTLOPT;
 close OPTBLD;
index 781a0b7..d4194bd 100644 (file)
 unshift(@INC,'lib');  # In case someone didn't define Perl_Root
                       # before the build
 
+if ($ARGV[0] eq '-f') {
+  open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n";
+  @ARGV = ();
+  while (<ARGS>) {
+    push(@ARGV,split(/\|/,$_));
+  }
+  close ARGS;
+}
+
 if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; }
 elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; }
 elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";}
@@ -194,6 +203,7 @@ $archlib = &VMS::Filespec::vmspath($privlib);
 $installarchlib = &VMS::Filespec::vmspath($installprivlib);
 $sitearch = &VMS::Filespec::vmspath($sitelib);
 $archlib =~ s#\]#.VMS_$archsufx\]#;
+$sitearch =~ s#\]#.VMS_$archsufx\]#;
 print OUT "oldarchlib='$archlib'\n";
 print OUT "oldarchlibexp='$archlib'\n";
 ($vers = $]) =~ tr/./_/;
index 47ee3d3..377d97f 100644 (file)
@@ -242,45 +242,6 @@ documented L<perl>, except that the element
 separator is '|' instead of ':'.  The directory
 specifications may use either VMS or Unix syntax.
 
-=head1 %ENV 
-
-Reading the elements of the %ENV array returns the 
-translation of the logical name specified by the key, 
-according to the normal search order of access modes and 
-logical name tables.  If you append a semicolon to the
-logical name, followed by an integer, that integer is
-used as the translation index for the logical name,
-so that you can look up successive values for search
-list logical names.  For instance, if you say
-
-   $  Define STORY  once,upon,a,time,there,was
-   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
-   _$ -e "{ print $ENV{'foo'.$i},' '}"
-
-Perl will print C<ONCE UPON A TIME THERE WAS>.
-
-The %ENV keys C<home>, C<path>,C<term>, and C<user>
-return the CRTL "environment variables" of the same
-names, if these logical names are not defined.  The
-key C<default> returns the current default device
-and directory specification, regardless of whether
-there is a logical name DEFAULT defined..
-
-Setting an element of %ENV defines a supervisor-mode logical 
-name in the process logical name table.  C<Undef>ing or 
-C<delete>ing an element of %ENV deletes the equivalent user-
-mode or supervisor-mode logical name from the process logical 
-name table.  If you use C<undef>, the %ENV element remains 
-empty.  If you use C<delete>, another attempt is made at 
-logical name translation after the deletion, so an inner-mode 
-logical name or a name in another logical name table will 
-replace the logical name just deleted.  It is not possible
-at present to define a search list logical name via %ENV.
-
-In all operations on %ENV, the key string is treated as if it 
-were entirely uppercase, regardless of the case actually 
-specified in the Perl expression.
-
 =head1 Perl functions
 
 As of the time this document was last revised, the following 
@@ -558,6 +519,67 @@ and you invoked Perl with the C<-w> switch, a warning will be issued.)
 
 The FLAGS argument is ignored in all cases.
 
+=head1 Perl variables
+
+=item %ENV 
+
+Reading the elements of the %ENV array returns the 
+translation of the logical name specified by the key, 
+according to the normal search order of access modes and 
+logical name tables.  If you append a semicolon to the
+logical name, followed by an integer, that integer is
+used as the translation index for the logical name,
+so that you can look up successive values for search
+list logical names.  For instance, if you say
+
+   $  Define STORY  once,upon,a,time,there,was
+   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
+   _$ -e "{ print $ENV{'foo'.$i},' '}"
+
+Perl will print C<ONCE UPON A TIME THERE WAS>.
+
+The %ENV keys C<home>, C<path>,C<term>, and C<user>
+return the CRTL "environment variables" of the same
+names, if these logical names are not defined.  The
+key C<default> returns the current default device
+and directory specification, regardless of whether
+there is a logical name DEFAULT defined..
+
+Setting an element of %ENV defines a supervisor-mode logical 
+name in the process logical name table.  C<Undef>ing or 
+C<delete>ing an element of %ENV deletes the equivalent user-
+mode or supervisor-mode logical name from the process logical 
+name table.  If you use C<undef>, the %ENV element remains 
+empty.  If you use C<delete>, another attempt is made at 
+logical name translation after the deletion, so an inner-mode 
+logical name or a name in another logical name table will 
+replace the logical name just deleted.  It is not possible
+at present to define a search list logical name via %ENV.
+
+In all operations on %ENV, the key string is treated as if it 
+were entirely uppercase, regardless of the case actually 
+specified in the Perl expression.
+
+=item $?
+
+Since VMS status values are 32 bits wide, the value of C<$?>
+is simply the final status value of the last subprocess to
+complete.  This differs from the behavior of C<$?> under Unix,
+and under VMS' POSIX environment, in that the low-order 8 bits
+of C<$?> do not specify whether the process terminated normally
+or due to a signal, and you do not need to shift C<$?> 8 bits
+to the right in order to find the process' exit status.
+
+=item $!
+
+The string value of C<$!> is that returned by the CRTL's
+strerror() function, so it will include the VMS message for
+VMS-specific errors.  The numeric value of C<$!> is the
+value of C<errno>, except if errno is EVMSERR, in which
+case C<$!> contains the value of vaxc$errno.  Setting C<$!>
+always sets errno to the value specified, and sets vaxc$errno
+to 4 (NONAME-F-NOMSG).
+
 =head1 Revision date
 
 This document was last updated on 16-Dec-1994, for Perl 5, 
index 8644998..9904682 100644 (file)
@@ -1319,7 +1319,7 @@ dEXT int yyerrflag;
 dEXT int yychar;
 dEXT YYSTYPE yyval;
 dEXT YYSTYPE yylval;
-#line 572 "perly.y"
+#line 571 "perly.y"
  /* PROGRAM */
 #line 1394 "y_tab.c"
 #define YYABORT goto yyabort
@@ -2084,19 +2084,18 @@ break;
 case 122:
 #line 455 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                           append_elem(OP_LIST,
-                               yyvsp[0].opval, newCVREF(0,scalar(yyvsp[-1].opval)))); }
+                           append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 123:
-#line 459 "perly.y"
+#line 458 "perly.y"
 { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
 break;
 case 124:
-#line 461 "perly.y"
+#line 460 "perly.y"
 { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
 break;
 case 125:
-#line 463 "perly.y"
+#line 462 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
@@ -2106,7 +2105,7 @@ case 125:
                                )),Nullop)); dep();}
 break;
 case 126:
-#line 471 "perly.y"
+#line 470 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            append_elem(OP_LIST,
@@ -2117,138 +2116,138 @@ case 126:
                                )))); dep();}
 break;
 case 127:
-#line 480 "perly.y"
+#line 479 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
 break;
 case 128:
-#line 484 "perly.y"
+#line 483 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                yyvsp[-1].opval,
                                scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
 break;
 case 129:
-#line 489 "perly.y"
+#line 488 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
                            hints |= HINT_BLOCK_SCOPE; }
 break;
 case 130:
-#line 492 "perly.y"
+#line 491 "perly.y"
 { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 131:
-#line 494 "perly.y"
+#line 493 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
 case 132:
-#line 496 "perly.y"
+#line 495 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 133:
-#line 498 "perly.y"
+#line 497 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 134:
-#line 500 "perly.y"
+#line 499 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 135:
-#line 502 "perly.y"
+#line 501 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 136:
-#line 505 "perly.y"
+#line 504 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 137:
-#line 507 "perly.y"
+#line 506 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, 0); }
 break;
 case 138:
-#line 509 "perly.y"
+#line 508 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0,
                                scalar(yyvsp[0].opval)); }
 break;
 case 139:
-#line 512 "perly.y"
+#line 511 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
 break;
 case 140:
-#line 514 "perly.y"
+#line 513 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
 case 141:
-#line 516 "perly.y"
+#line 515 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
 break;
 case 142:
-#line 518 "perly.y"
+#line 517 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
 break;
 case 145:
-#line 524 "perly.y"
+#line 523 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 146:
-#line 526 "perly.y"
+#line 525 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 147:
-#line 530 "perly.y"
+#line 529 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 148:
-#line 532 "perly.y"
+#line 531 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 149:
-#line 534 "perly.y"
+#line 533 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 150:
-#line 538 "perly.y"
+#line 537 "perly.y"
 { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 151:
-#line 542 "perly.y"
+#line 541 "perly.y"
 { yyval.opval = newSVREF(yyvsp[0].opval); }
 break;
 case 152:
-#line 546 "perly.y"
+#line 545 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 153:
-#line 550 "perly.y"
+#line 549 "perly.y"
 { yyval.opval = newHVREF(yyvsp[0].opval); }
 break;
 case 154:
-#line 554 "perly.y"
+#line 553 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 155:
-#line 558 "perly.y"
+#line 557 "perly.y"
 { yyval.opval = newGVREF(0,yyvsp[0].opval); }
 break;
 case 156:
-#line 562 "perly.y"
+#line 561 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval); }
 break;
 case 157:
-#line 564 "perly.y"
+#line 563 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval);  }
 break;
 case 158:
-#line 566 "perly.y"
+#line 565 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 159:
-#line 569 "perly.y"
+#line 568 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2237 "y_tab.c"
+#line 2236 "y_tab.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
index dcb8685..073bf56 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1190,7 +1190,7 @@ static char *do_tounixspec(char *spec, char *buf, int ts)
     if (cp1) {
       for (cp1++; *cp1 == '-'; cp1++) dashes++; /* VMS  '-' ==> Unix '../' */
     }
-    New(7015,rslt,retlen+1+2*dashes,char);
+    New(7015,rslt,retlen+2+2*dashes,char);
   }
   else rslt = __tounixspec_retbuf;
   if (strchr(spec,'/') != NULL) {
@@ -1207,12 +1207,16 @@ static char *do_tounixspec(char *spec, char *buf, int ts)
     strcpy(rslt,spec);
     return rslt;
   }
-  if (*cp2 != '[') {
+  if (*cp2 != '[' && *cp2 != '<') {
     *(cp1++) = '/';
   }
   else {  /* the VMS spec begins with directories */
     cp2++;
-    if (*cp2 == '-') {
+    if (*cp2 == ']' || *cp2 == '>') {
+      strcpy(rslt,"./");
+      return rslt;
+    }
+    else if (*cp2 == '-') {
       while (*cp2 == '-') {
         *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
         cp2++;
@@ -1693,7 +1697,7 @@ getredirection(int *ac, char ***av)
        
     /* Check for input from a pipe (mailbox) */
 
-    if (1 == isapipe(0))
+    if (in == NULL && 1 == isapipe(0))
        {
        char mbxname[L_tmpnam];
        long int bufsize;
@@ -1704,11 +1708,6 @@ getredirection(int *ac, char ***av)
        /* Input from a pipe, reopen it in binary mode to disable       */
        /* carriage control processing.                                 */
 
-       if (in != NULL)
-           {
-           fprintf(stderr,"'|' and '<' may not both be specified on command line");
-           exit(LIB$_INVARGORD);
-           }
        fgetname(stdin, mbxname,1);
        mbxnam.dsc$a_pointer = mbxname;
        mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);     
@@ -2986,7 +2985,7 @@ cando_by_name(I32 bit, I32 effective, char *fname)
   static char usrname[L_cuserid];
   static struct dsc$descriptor_s usrdsc =
          {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
-
+  char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
   unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
   unsigned short int retlen;
   struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
@@ -2997,12 +2996,21 @@ cando_by_name(I32 bit, I32 effective, char *fname)
          {0,0,0,0}};
 
   if (!fname || !*fname) return FALSE;
+  if (!do_tovmsspec(fname,vmsname,1)) return FALSE;
+  retlen = namdsc.dsc$w_length = strlen(vmsname);
+  namdsc.dsc$a_pointer = vmsname;
+  if (vmsname[retlen-1] == ']' || vmsname[retlen-1] == '>' ||
+      vmsname[retlen-1] == ':') {
+    if (!do_fileify_dirspec(vmsname,fileified,1)) return FALSE;
+    namdsc.dsc$w_length = strlen(fileified);
+    namdsc.dsc$a_pointer = fileified;
+  }
+
   if (!usrdsc.dsc$w_length) {
     cuserid(usrname);
     usrdsc.dsc$w_length = strlen(usrname);
   }
-  namdsc.dsc$w_length = strlen(fname);
-  namdsc.dsc$a_pointer = fname;
+
   switch (bit) {
     case S_IXUSR:
     case S_IXGRP:
@@ -3126,6 +3134,158 @@ my_getlogin()
 /*}}}*/
 
 
+/*  rmscopy - copy a file using VMS RMS routines
+ *
+ *  Copies contents and attributes of spec_in to spec_out, except owner
+ *  and protection information.  Name and type of spec_in are used as
+ *  defaults for spec_out.  Returns 1 on success; returns 0 and sets
+ *  errno and vaxc$errno on failure.
+ *
+ *  Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
+ *  Incorporates, with permission, some code from EZCOPY by Tim Adye
+ *  <T.J.Adye@rl.ac.uk>.  Permission is given to use and distribute this
+ *  code under the same terms as Perl itself.  (See the GNU General Public
+ *  License or the Perl Artistic License supplied as part of the Perl
+ *  distribution.)
+ */
+/*{{{int rmscopy(char *src, char *dst)*/
+int
+rmscopy(char *spec_in, char *spec_out)
+{
+    char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS],
+         rsa[NAM$C_MAXRSS], ubf[32256];
+    unsigned long int i, sts, sts2;
+    struct FAB fab_in, fab_out;
+    struct RAB rab_in, rab_out;
+    struct NAM nam;
+    struct XABDAT xabdat;
+    struct XABFHC xabfhc;
+    struct XABRDT xabrdt;
+    struct XABSUM xabsum;
+
+    if (!spec_in  || !*spec_in  || !do_tovmsspec(spec_in,vmsin,1) ||
+        !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      return 0;
+    }
+
+    fab_in = cc$rms_fab;
+    fab_in.fab$l_fna = vmsin;
+    fab_in.fab$b_fns = strlen(vmsin);
+    fab_in.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;
+    fab_in.fab$b_fac = FAB$M_BIO | FAB$M_GET;
+    fab_in.fab$l_fop = FAB$M_SQO;
+    fab_in.fab$l_nam =  &nam;
+    fab_in.fab$l_xab = (void*) &xabdat;
+
+    nam = cc$rms_nam;
+    nam.nam$l_rsa = rsa;
+    nam.nam$b_rss = sizeof(rsa);
+    nam.nam$l_esa = esa;
+    nam.nam$b_ess = sizeof (esa);
+    nam.nam$b_esl = nam.nam$b_rsl = 0;
+
+    xabdat = cc$rms_xabdat;        /* To get creation date */
+    xabdat.xab$l_nxt = (void*) &xabfhc;
+
+    xabfhc = cc$rms_xabfhc;        /* To get record length */
+    xabfhc.xab$l_nxt = (void*) &xabsum;
+
+    xabsum = cc$rms_xabsum;        /* To get key and area information */
+
+    if (!((sts = sys$open(&fab_in)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_FNF:
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+
+    fab_out = fab_in;
+    fab_out.fab$w_ifi = 0;
+    fab_out.fab$b_fac = FAB$M_BIO | FAB$M_PUT;
+    fab_out.fab$b_shr = FAB$M_SHRGET | FAB$M_UPI;
+    fab_out.fab$l_fop = FAB$M_SQO;
+    fab_out.fab$l_fna = vmsout;
+    fab_out.fab$b_fns = strlen(vmsout);
+    fab_out.fab$l_dna = nam.nam$l_name;
+    fab_out.fab$b_dns = nam.nam$l_name ? nam.nam$b_name + nam.nam$b_type : 0;
+    if (!((sts = sys$create(&fab_out)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+    fab_out.fab$l_fop |= FAB$M_DLT;  /* in case we have to bail out */
+    /* sys$close() will process xabrdt, not xabdat */
+    xabrdt = cc$rms_xabrdt;
+    xabrdt.xab$q_rdt = xabdat.xab$q_rdt;
+    fab_out.fab$l_xab = &xabrdt;
+
+    rab_in = cc$rms_rab;
+    rab_in.rab$l_fab = &fab_in;
+    rab_in.rab$l_rop = RAB$M_BIO;
+    rab_in.rab$l_ubf = ubf;
+    rab_in.rab$w_usz = sizeof ubf;
+    if (!((sts = sys$connect(&rab_in)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    rab_out = cc$rms_rab;
+    rab_out.rab$l_fab = &fab_out;
+    rab_out.rab$l_rbf = ubf;
+    if (!((sts = sys$connect(&rab_out)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    while ((sts = sys$read(&rab_in))) {  /* always true  */
+      if (sts == RMS$_EOF) break;
+      rab_out.rab$w_rsz = rab_in.rab$w_rsz;
+      if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) {
+        sys$close(&fab_in); sys$close(&fab_out);
+        set_errno(EVMSERR); set_vaxc_errno(sts);
+        return 0;
+      }
+    }
+
+    fab_out.fab$l_fop &= ~FAB$M_DLT;  /* We got this far; keep the output */
+    sys$close(&fab_in);  sys$close(&fab_out);
+    sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts;
+    if (!(sts & 1)) {
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    return 1;
+
+}  /* end of rmscopy() */
+/*}}}*/
+
+
 /***  The following glue provides 'hooks' to make some of the routines
  * from this file available from Perl.  These routines are sufficiently
  * basic, and are required sufficiently early in the build process,
@@ -3217,12 +3377,80 @@ void
 candelete_fromperl(CV *cv)
 {
   dXSARGS;
-  char vmsspec[NAM$C_MAXRSS+1];
+  char fspec[NAM$C_MAXRSS+1], *fsp;
+  SV *mysv;
+  IO *io;
 
   if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
-  if (do_tovmsspec(SvPV(ST(0),na),buf,0) && cando_by_name(S_IDUSR,0,buf))
-    ST(0) = &sv_yes;
-  else ST(0) = &sv_no;
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    fsp = fspec;
+  }
+  else {
+    if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+
+  ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no;
+  XSRETURN(1);
+}
+
+void
+rmscopy_fromperl(CV *cv)
+{
+  dXSARGS;
+  char inspec[NAM$C_MAXRSS+1], outspec[NAM$C_MAXRSS+1], *inp, *outp;
+  struct dsc$descriptor indsc  = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+                        outdsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+  unsigned long int sts;
+  SV *mysv;
+  IO *io;
+
+  if (items != 2) croak("Usage: File::Copy::rmscopy(from,to)");
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    inp = inspec;
+  }
+  else {
+    if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+  mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    outp = outspec;
+  }
+  else {
+    if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+
+  ST(0) = rmscopy(inp,outp) ? &sv_yes : &sv_no;
   XSRETURN(1);
 }
 
@@ -3231,13 +3459,14 @@ init_os_extras()
 {
   char* file = __FILE__;
 
-  newXS("VMS::Filespec::vmsify",vmsify_fromperl,file);
-  newXS("VMS::Filespec::unixify",unixify_fromperl,file);
-  newXS("VMS::Filespec::pathify",pathify_fromperl,file);
-  newXS("VMS::Filespec::fileify",fileify_fromperl,file);
-  newXS("VMS::Filespec::vmspath",vmspath_fromperl,file);
-  newXS("VMS::Filespec::unixpath",unixpath_fromperl,file);
-  newXS("VMS::Filespec::candelete",candelete_fromperl,file);
+  newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixify",unixify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::pathify",pathify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::fileify",fileify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
+  newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
   return;
 }
   
index 55508b9..000ba29 100644 (file)
@@ -189,6 +189,9 @@ struct tms {
 #define Stat(name,bufptr) flex_stat(name,bufptr)
 #define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
 
+/* By default, flush data all the way to disk, not just to RMS buffers */
+#define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0)
+
 /* Setup for the dirent routines:
  * opendir(), closedir(), readdir(), seekdir(), telldir(), and
  * vmsreaddirversions(), and preprocessor stuff on which these depend:
@@ -348,6 +351,7 @@ struct passwd *     my_getpwuid _((Uid_t uid));
 struct passwd *        my_getpwent _(());
 void   my_endpwent _(());
 char * my_getlogin _(());
+int    rmscopy _((char *, char *));
 void   init_os_extras _(());
 typedef char __VMS_SEPYTOTORP__;
 /* prototype section end marker; `typedef' passes through cpp */