----------------
++Version 5.003_23
++----------------
++
++This release is our first candidate for a public beta test.
++
++ CORE LANGUAGE CHANGES
++
++ Title: "Disallow changing $_[0] in __DIE__ handlers"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pod/perlfunc.pod util.c
++
++ Title: "Fix overloading with inheritance and AUTOLOAD"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701202226.RAA05072@monk.mps.ohio-state.edu>
++ Date: Mon, 20 Jan 1997 17:26:32 -0500 (EST)
++ Files: gv.c lib/diagnostics.pm lib/overload.pm pod/perldebug.pod
++ pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod
++ pod/perlre.pod pod/perltoc.pod pod/perlxs.pod
++
++ Title: "Nested here-docs"
++ From: larry@wall.org (Larry Wall)
++ Msg-ID: <199701202313.PAA11693@wall.org>
++ Date: Mon, 20 Jan 1997 15:13:42 -0800
++ Files: toke.c
++
++ Title: "Revert $^X to old behavior (plus HP-UX bug fix)"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: hints/hpux.sh toke.c
++
++ Title: "Protect against '0' in 'stmt while <HANDLE>'"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: op.c
++
++ Title: "Don't warn when closure uses var at file scope"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: op.c
++
++ CORE PORTABILITY
++
++ Title: "VMS patches for _22"
++ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
++ Msg-ID: <01IEGBJ2TMYS003PCL@hmivax.humgen.upenn.edu>
++ Date: Mon, 20 Jan 1997 22:50:21 -0500 (EST)
++ Files: ext/POSIX/POSIX.xs lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp
++ lib/Test/Harness.pm toke.c vms/Makefile vms/descrip.mms
++ vms/genconfig.pl vms/perly_c.vms vms/vmsish.h x2p/a2p.h
++ vms/Makefile vms/config.vms vms/descrip.mms vms/perly_c.vms
++
++ Title: "Re: Perl 5.003_21: OS/2 patches"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701170446.XAA28939@monk.mps.ohio-state.edu>
++ Date: Thu, 16 Jan 1997 23:46:40 -0500 (EST)
++ Files: os2/Changes os2/os2.c
++
++ Title: "Plan9 update"
++ From: lutherh@stratcom.com (Luther Huffman)
++ Files: plan9/config.plan9 plan9/mkfile
++
++ Title: "Bugfixes for AmigaOS"
++ From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
++ Msg-ID: <77724691@Armageddon.meb.uni-bonn.de>
++ Date: Wed, 22 Jan 1997 00:13:54 +0100
++ Files: hints/amigaos.sh lib/File/Basename.pm
++
++ Title: "New dec_osf.sh hints file"
++ From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
++ Msg-ID: <9701241058.AA29550@o09.rosat.mpe-garching.mpg.de>
++ Date: Fri, 24 Jan 1997 11:58:24 +0100
++ Files: hints/dec_osf.sh
++
++ Title: "on NeXT: gdbm problem fixed"
++ From: Andreas Koenig <k@anna.in-berlin.de>
++ Msg-ID: <199701210201.DAA17794@anna.in-berlin.de>
++ Date: Tue, 21 Jan 1997 03:01:32 +0100
++ Files: hints/next_3.sh hints/next_3_0.sh
++
++ Title: "patch for hints/powerux.sh"
++ From: tom@amber.ssd.hcsc.com (Tom Horsley)
++ Msg-ID: <9701181833.AA02602@amber.ssd.hcsc.com>
++ Date: Sat, 18 Jan 97 13:33:26 -0500
++ Files: hints/powerux.sh
++
++ Title: "hints & Configure changes to build perl on DC/OSx"
++ From: Stephen Zander <stephen.zander@interlock.mckesson.com>
++ Msg-ID: <199701170043.QAA25985@wsbip1.mckesson.com>
++ Date: Thu, 16 Jan 1997 16:43:52 -0800
++ Files: Configure MANIFEST hints/dcosx.sh
++
++ Title: "patch for hints/cxux.sh perl5.003_22"
++ From: tom@amber.ssd.hcsc.com (Tom Horsley)
++ Msg-ID: <9701192014.AA05722@amber.ssd.hcsc.com>
++ Date: Sun, 19 Jan 97 15:14:04 -0500
++ Files: hints/cxux.sh
++
++ OTHER CORE CHANGES
++
++ Title: "Make PERL5LIB and -I work like C<use lib>"
++ From: Tim Bunce <Tim.Bunce@ig.co.uk>
++ Msg-ID: <9701231523.AA26613@toad.ig.co.uk>
++ Date: Thu, 23 Jan 1997 15:23:27 +0000
++ Files: lib/lib.pm perl.c
++
++ Title: "Fix /\G.a/"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: regcomp.c regcomp.h regexec.c regexp.h toke.c
++
++ Title: "Extend stack in pp_undef (!)"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pp.c
++
++ Title: "Allow for sub to be redefined while executing"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: cop.h pp_hot.c t/op/misc.t
++
++ Title: "Eliminate redundant flag CVf_FORMAT"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: cv.h op.c perl.c perly.c perly.y proto.h sv.c toke.c
++
++ Title: "Generate IVs when possible in abs() and int()"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pp.c
++
++ Title: "Efficiency patchlet for pp_aassign()"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701210305.WAA05451@monk.mps.ohio-state.edu>
++ Date: Mon, 20 Jan 1997 22:05:39 -0500 (EST)
++ Files: pp_hot.c
++
++ Title: "When sorting, promote to PVNV only for built-in comparison"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pp_ctl.c
++
++ Title: "Remove "suidperl security patch" message"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: perl.c
++
++ BUILD PROCESS
++
++ Title: "Make configure.gnu a copy of configure; make configure writea
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: MANIFEST configure.gnu
++
++ Title: "Regen Configure with metaconfig: +ARCHNAME, -FILE_filbuf"
++ From: Chip Salzenberg and Charles Bailey
++ Files: Configure config_H config_h.SH hints/lynxos.sh
++ os2/diff.configure os2/os2ish.h plan9/config.plan9 sv.c
++ utils/perlbug.PL vms/config.vms vms/fndvers.com
++
++ Title: "Compile with optimization when testing memory functions"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: Configure
++
++ Title: "Minor patch for Debian installation"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: installperl
++
++ LIBRARY AND EXTENSIONS
++
++ Title: "Debugger update"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701190455.XAA02579@monk.mps.ohio-state.edu>
++ Date: Sat, 18 Jan 1997 23:54:59 -0500 (EST)
++ Files: lib/perl5db.pl
++
++ Title: "DynaLoader enhancement: support RTLD_GLOBAL"
++ From: Nick Ing-Simmons <nik@tiuk.ti.com>
++ Msg-ID: <199701240937.JAA11443@pluto.tiuk.ti.com>
++ Date: Fri, 24 Jan 1997 09:37:18 GMT
++ Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_aix.xs
++ 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
++
++ Title: "Fcntl: add more constants"
++ From: Jarkko.Hietaniemi@cc.hut.fi
++ Msg-ID: <199701191811.UAA16346@alpha.hut.fi>
++ Date: Sun, 19 Jan 1997 20:11:22 +0200 (EET)
++ Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
++
++ Title: "Refresh IO to 1.15 (plus DESTROY and new_tmpfile fixes)"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm
++ ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm
++ ext/IO/lib/IO/Socket.pm t/lib/io_pipe.t
++
++ Title: "Allow IO.xs to remain at 1.15 while $VERSION is 1.1501"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: XSUB.h ext/IO/Makefile.PL ext/IO/lib/IO/Handle.pm
++
++ Title: "Refresh CPAN to 1.15"
++ From: Andreas Koenig <a.koenig@mind.de>
++ Files: lib/CPAN.pm lib/CPAN/FirstTime.pm
++
++ Title: "Add E* and SA_* constants"
++ From: Roderick Schertler <roderick@gate.net>
++ Msg-ID: <23338.853986967@eeyore.ibcinc.com>
++ Date: Wed, 22 Jan 1997 21:36:07 -0500
++ Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs
++
++ TESTS
++
++ Title: "Test nested here-docs"
++ From: hv@crypt.compulink.co.uk (Hugo van der Sanden)
++ Msg-ID: <199701210053.AAA02139@crypt.compulink.co.uk>
++ Date: Tue, 21 Jan 1997 00:53:44 +0000 (GMT)
++ Files: t/base/lex.t
++
++ Title: "Fix tests of $^X and $0 to work with QNX"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: t/lib/io_pipe.t t/lib/open2.t t/lib/open3.t t/op/magic.t
++
++ Title: "Patch tests for systems without fork()"
++ From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
++ Msg-ID: <77724697@Armageddon.meb.uni-bonn.de>
++ Date: Thu, 23 Jan 1997 23:51:28 +0100
++ Files: t/io/pipe.t t/lib/filehand.t t/lib/io_pipe.t t/lib/io_sock.t
++ t/lib/open2.t t/lib/open3.t t/op/fork.t
++
++ Title: "Test patches for OS/2"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701170448.XAA28948@monk.mps.ohio-state.edu>
++ Date: Thu, 16 Jan 1997 23:48:18 -0500 (EST)
++ Files: os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t
++ os2/OS2/REXX/t/rx_cmprt.t os2/OS2/REXX/t/rx_dllld.t
++ os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_sql.test
++ os2/OS2/REXX/t/rx_tiesql.test os2/OS2/REXX/t/rx_tievar.t
++ os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_varset.t
++ os2/OS2/REXX/t/rx_vrexx.t t/README t/cmd/while.t
++ t/comp/colon.t t/comp/multiline.t t/io/argv.t t/lib/anydbm.t
++ t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t
++ t/op/cmp.t t/op/magic.t
++
++ UTILITIES
++
++ Title: "Translate \200 to È in pod2html"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pod/pod2html.PL
++
++ Title: "VMS patches: '.com' extension on scripts"
++ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
++ Msg-ID: <01IELNPDLYJM003E7J@hmivax.humgen.upenn.edu>
++ Date: Fri, 24 Jan 1997 18:42:29 -0500 (EST)
++ Files: pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL
++ pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL
++ utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL
++ utils/pl2pm.PL utils/splain.PL vms/Makefile vms/descrip.mms
++ x2p/find2perl.PL x2p/s2p.PL
++
++ Title: "Allow MakeMaker 5.34 to use libraries containing '+' in name"
++ From: dennism@cyrix.com (Dennis Marsa)
++ Msg-ID: <9701172027.AA27861@orion.cyrix.com>
++ Date: Fri, 17 Jan 97 14:27:32 CST
++ Files: lib/ExtUtils/Liblist.pm
++
++ DOCUMENTATION
++
++ Title: "First cut at INSTALL edit"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: INSTALL
++
++ Title: "Additional docs for __DIE__ and __WARN__"
++ From: Gurusamy Sarathy <gsar@engin.umich.edu>
++ Files: pod/perlfunc.pod pod/perlrun.pod pod/perlvar.pod
++
++ Title: "Document #line directive"
++ From: Gurusamy Sarathy <gsar@engin.umich.edu>
++ Msg-ID: <199701240908.EAA23846@aatma.engin.umich.edu>
++ Date: Fri, 24 Jan 1997 04:08:44 -0500
++ Files: pod/perlsyn.pod pod/perltoc.pod
++
++ Title: "Perlguts version 30"
++ From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
++ Msg-ID: <199701172117.AA116515863@hpcc123.corp.hp.com>
++ Date: Fri, 17 Jan 1997 13:17:43 -0800
++ Files: pod/perlguts.pod
++
++ Title: "delta for perldelta"
++ From: Tom Christiansen <tchrist@mox.perl.com>
++ Msg-ID: <804.854121463@jinete>
++ Date: Fri, 24 Jan 1997 07:57:43 -0800
++ Files: pod/perlnews.pod pod/perltoc.pod
++
++ Title: "Updates to perldelta"
++ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
++ Msg-ID: <199701211610.LAA06227@monk.mps.ohio-state.edu>
++ Date: Mon, 20 Jan 1997 06:48:49 -0500 (EST)
++ Files: pod/perlnews.pod pod/perltoc.pod
++
++ Title: "perlnews.pod diff for the Fcntl"
++ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
++ Msg-ID: <199701211600.SAA30117@alpha.hut.fi>
++ Date: Tue, 21 Jan 1997 18:00:56 +0200 (EET)
++ Files: pod/perlnews.pod
++
++ Title: "Rename perlnews -> perldelta per Tom's request"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod
++ pod/perldelta.pod pod/perltoc.pod pod/roffitall
++
++ Title: "Remove bad advice from perllocale.pod"
++ From: Chip Salzenberg <chip@atlantic.net>
++ Files: pod/perllocale.pod
++
++
++----------------
Version 5.003_22
----------------
# $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $
#
--# Generated on Tue Dec 17 14:33:33 EST 1996 [metaconfig 3.0 PL60]
++# Generated on Thu Jan 23 14:39:28 EST 1997 [metaconfig 3.0 PL60]
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
stdio_base=''
stdio_bufsiz=''
stdio_cnt=''
--stdio_filbuf=''
stdio_ptr=''
d_index=''
d_strchr=''
fi
: set the base revision
--baserev=5
++baserev=5.0
: get the patchlevel
echo " "
eval $prefixit
case "$archlib" in
'')
-- case "$privlib" in
-- '') dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib`
-- set dflt
-- eval $prefixup
-- ;;
-- *) if test 0 -eq "$subversion"; then
-- version=`echo $baserev $patchlevel | \
-- $awk '{ printf "%d.%03d\n",$1,$2 }'`
-- else
-- version=`echo $baserev $patchlevel $subversion | \
-- $awk '{ printf "%d.%03d%02d\n",$1,$2,$3 }'`
-- fi
-- dflt="$privlib/$archname/$version"
-- ;;
-- esac
++ case "$privlib" in
++ '') dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib`
++ set dflt
++ eval $prefixup
;;
--*) dflt="$archlib";;
++ *) if test 0 -eq "$subversion"; then
++ version=`LC_ALL=C; export LC_ALL; \
++ echo $baserev $patchlevel | \
++ $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
++ else
++ version=`LC_ALL=C; export LC_ALL; \
++ echo $baserev $patchlevel $subversion | \
++ $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
++ fi
++ ;;
++ esac
++ ;;
++*)
++ dflt="$archlib"
++ ;;
esac
cat <<EOM
.) dflt=.`$sed -n -e 's/ / /g' \
-e 's/^domain *\([^ ]*\).*/\1/p' $tans \
| ./tr '[A-Z]' '[a-z]' 2>/dev/null`
-- ;;
++ ;;
esac
fi
;;
}
EOCP
if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
-- cat <<EOS >mtry
--$startsh
--EOS
++ echo "$startsh" >mtry
echo "./try >try.out 2>try.ret 3>try.err || exit 4" >>mtry
chmod +x mtry
./mtry >/dev/null 2>&1
exit(0);
}
EOCP
-- if $cc $ccflags $ldflags foo.c -o safebcpy $libs >/dev/null 2>&1; then
++ if $cc $optimize $ccflags $ldflags foo.c \
++ -o safebcpy $libs >/dev/null 2>&1; then
if ./safebcpy 2>/dev/null; then
echo "Yes, it can."
val="$define"
exit(0);
}
EOCP
-- if $cc $ccflags $ldflags foo.c -o safemcpy $libs >/dev/null 2>&1; then
++ if $cc $optimize $ccflags $ldflags foo.c \
++ -o safemcpy $libs >/dev/null 2>&1; then
if ./safemcpy 2>/dev/null; then
echo "Yes, it can."
val="$define"
exit(0);
}
EOCP
-- if $cc $ccflags $ldflags foo.c -o sanemcmp $libs >/dev/null 2>&1; then
++ if $cc $optimize $ccflags $ldflags foo.c \
++ -o sanemcmp $libs >/dev/null 2>&1; then
if ./sanemcmp 2>/dev/null; then
echo "Yes, it can."
val="$define"
set d_stdio_cnt_lval
eval $setvar
--: How to access the stdio _filbuf or __filbuf function.
--: If this fails, check how the getc macro in stdio.h works.
--case "${d_stdio_ptr_lval}${d_stdio_cnt_lval}" in
--${define}${define})
-- : Try $hint value, if any, then _filbuf, __filbuf, _fill, then punt.
-- : _fill is for os/2.
-- xxx='notok'
-- for filbuf in $stdio_filbuf '_filbuf(fp)' '__filbuf(fp) ' '_fill(fp)' ; do
-- $cat >try.c <<EOP
--#include <stdio.h>
--#define FILE_ptr(fp) $stdio_ptr
--#define FILE_cnt(fp) $stdio_cnt
--#define FILE_filbuf(fp) $filbuf
--main() {
-- FILE *fp = fopen("try.c", "r");
-- int c;
-- c = getc(fp);
-- c = FILE_filbuf(fp); /* Just looking for linker errors.*/
-- exit(0);
--}
--EOP
-- if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1 && ./try; then
-- echo "Your stdio appears to use $filbuf"
-- stdio_filbuf="$filbuf"
-- xxx='ok'
-- break
-- else
-- echo "Hmm. $filbuf doesn't seem to work."
-- fi
-- $rm -f try.c try
-- done
-- case "$xxx" in
-- notok) echo "I can't figure out how to access _filbuf"
-- echo "I'll just have to work around it."
-- d_stdio_ptr_lval="$undef"
-- d_stdio_cnt_lval="$undef"
-- ;;
-- esac
-- ;;
--esac
--
: see if _base is also standard
val="$undef"
stdio_base='$stdio_base'
stdio_bufsiz='$stdio_bufsiz'
stdio_cnt='$stdio_cnt'
--stdio_filbuf='$stdio_filbuf'
stdio_ptr='$stdio_ptr'
strings='$strings'
submit='$submit'
Changes5.001 Differences between 5.000 and 5.001
Changes5.002 Differences between 5.001 and 5.002
Changes5.003 Differences between 5.002 and 5.003
--Configure Portability tool
configure Crude emulation of GNU configure
++configure.gnu Copy of configure (for case-insensitive systems)
++Configure Portability tool
Copying The GNU General Public License
EXTERN.h Included before foreign .h files
INSTALL Detailed installation instructions
hints/bsdos.sh Hints for named architecture
hints/convexos.sh Hints for named architecture
hints/cxux.sh Hints for named architecture
++hints/dcosx.sh Hints for named architecture
hints/dec_osf.sh Hints for named architecture
hints/dgux.sh Hints for named architecture
hints/dynix.sh Hints for named architecture
pod/perlcall.pod Callback info
pod/perldata.pod Data structure info
pod/perldebug.pod Debugger info
++pod/perldelta.pod Changes since last version
pod/perldiag.pod Diagnostic info
pod/perldsc.pod Data Structures Cookbook
pod/perlembed.pod Embedding info
pod/perllocale.pod Locale support info
pod/perllol.pod How to use lists of lists
pod/perlmod.pod Module info
--pod/perlnews.pod News of changes since last version
pod/perlobj.pod Object info
pod/perlop.pod Operator info
pod/perlpod.pod Pod info
Perl Kit, Version 5.0
-- Copyright 1989-1996, Larry Wall
++ Copyright 1989-1997, Larry Wall
All rights reserved.
This program is free software; you can redistribute it and/or modify
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
-- STMT_START { \
-- char vn[255], *module = SvPV(ST(0),na); \
-- if (items >= 2) /* version supplied as bootstrap arg */ \
-- Sv=ST(1); \
-- else { /* read version from module::VERSION */ \
-- sprintf(vn,"%s::VERSION", module); \
-- Sv = perl_get_sv(vn, FALSE); /* XXX GV_ADDWARN */ \
-- } \
-- if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv,na))) ) \
-- croak("%s object version %s does not match %s.pm $VERSION %s", \
-- module,XS_VERSION, module,(Sv && SvOK(Sv))?SvPV(Sv,na):"(undef)");\
++ STMT_START { \
++ char vn[255], *module = SvPV(ST(0),na); \
++ if (items >= 2) /* version supplied as bootstrap arg */ \
++ Sv = ST(1); \
++ else { \
++ sprintf(vn,"%s::XS_VERSION", module); \
++ Sv = perl_get_sv(vn, FALSE); /* XXX GV_ADDWARN */ \
++ if (!Sv || !SvOK(Sv)) { \
++ sprintf(vn,"%s::VERSION", module); \
++ Sv = perl_get_sv(vn, FALSE); /* XXX GV_ADDWARN */ \
++ } \
++ } \
++ if (!Sv || !SvOK(Sv)) \
++ croak("%s object can't find $%s::XS_VERSION or $%s::VERSION", \
++ module, module, module); \
++ else if (strNE(XS_VERSION, SvPV(Sv, na))) \
++ croak("%s object version %s does not match $%s %s", \
++ module, XS_VERSION, vn, SvPV(Sv, na)); \
} STMT_END
#else
# define XS_VERSION_BOOTCHECK
#endif
--
*/
#define MEM_ALIGNBYTES 4 /**/
++/* ARCHNAME:
++ * This symbol holds a string representing the architecture name.
++ * It may be used to construct an architecture-dependant pathname
++ * where library files may be held under a private library, for
++ * instance.
++ */
++#define ARCHNAME "unknown" /**/
++
/* BIN:
* This symbol holds the path of the bin directory where the package will
* be installed. Program must be prepared to deal with ~name substitution.
#define HAS_NTOHL /**/
#define HAS_NTOHS /**/
--/* HAS_INET_ATON:
-- * This symbol, if defined, indicates to the C program that the
-- * inet_aton() function is available to parse IP address "dotted-quad"
-- * strings.
-- */
--#define HAS_INET_ATON /**/
--
/* HAS_ISASCII:
* This manifest constant lets the C program know that isascii
* is available.
* This symbol is defined if the FILE_cnt macro can be used as an
* lvalue.
*/
--/* FILE_filbuf:
-- * This macro is used to access the internal stdio _filbuf function
-- * (or equivalent), if STDIO_CNT_LVALUE and STDIO_PTR_LVALUE
-- * are defined. It is typically either _filbuf or __filbuf.
-- * This macro will only be defined if both STDIO_CNT_LVALUE and
-- * STDIO_PTR_LVALUE are defined.
-- */
#define USE_STDIO_PTR /**/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) ((fp)->_ptr)
#define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
#define STDIO_CNT_LVALUE /**/
--#if defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
--#define FILE_filbuf(fp) _filbuf(fp) /**/
--#endif
#endif
/* USE_STDIO_BASE:
/* HAS_STRTOD:
* This symbol, if defined, indicates that the strtod routine is
-- * available to translate strings to doubles.
++ * available to provide better numeric string conversion than atof().
*/
#define HAS_STRTOD /**/
/* HAS_STRTOL:
-- * This symbol, if defined, indicates that the strtol routine is
-- * available to translate strings to integers.
++ * This symbol, if defined, indicates that the strtol routine is available
++ * to provide better numeric string conversion than atoi() and friends.
*/
#define HAS_STRTOL /**/
/* HAS_STRTOUL:
* This symbol, if defined, indicates that the strtoul routine is
-- * available to translate strings to integers.
++ * available to provide conversion of strings to unsigned long.
*/
#define HAS_STRTOUL /**/
*/
#define Mode_t mode_t /* file mode parameter for system calls */
++/* VAL_O_NONBLOCK:
++ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
++ * non-blocking I/O for the file descriptor. Note that there is no way
++ * back, i.e. you cannot turn it blocking again this way. If you wish to
++ * alternatively switch between blocking and non-blocking, use the
++ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
++ */
++/* VAL_EAGAIN:
++ * This symbol holds the errno error code set by read() when no data was
++ * present on the non-blocking file descriptor.
++ */
++/* RD_NODATA:
++ * This symbol holds the return code from read() when no data is present
++ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
++ * not defined, then you can't distinguish between no data and EOF by
++ * issuing a read(). You'll have to find another way to tell for sure!
++ */
++/* EOF_NONBLOCK:
++ * This symbol, if defined, indicates to the C program that a read() on
++ * a non-blocking file descriptor will return 0 on EOF, and not the value
++ * held in RD_NODATA (-1 usually, in that case!).
++ */
++#define VAL_O_NONBLOCK O_NONBLOCK
++#define VAL_EAGAIN EAGAIN
++#define RD_NODATA -1
++#define EOF_NONBLOCK
++
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* function prototypes.
*/
#define Size_t size_t /* length paramater for string functions */
++/* SSize_t:
++ * This symbol holds the type used by functions that return
++ * a count of bytes or an error condition. It must be a signed type.
++ * It is usually ssize_t, but may be long or int, etc.
++ * It may be necessary to include <sys/types.h> or <unistd.h>
++ * to get any typedef'ed information.
++ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
++ */
++#define SSize_t ssize_t /* signed count of bytes */
++
/* STDCHAR:
* This symbol is defined to be the type of char used in stdio.h.
* It has the values "unsigned char" or "char".
#define HAS_GETPGRP /**/
/*#define USE_BSD_GETPGRP / **/
++/* HAS_INET_ATON:
++ * This symbol, if defined, indicates to the C program that the
++ * inet_aton() function is available to parse IP address "dotted-quad"
++ * strings.
++ */
++#define HAS_INET_ATON /**/
++
/* HAS_SETPGID:
* This symbol, if defined, indicates to the C program that
* the setpgid(pid, gpid) function is available to set the
*/
#define MYMALLOC /**/
--/* VAL_O_NONBLOCK:
-- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
-- * non-blocking I/O for the file descriptor. Note that there is no way
-- * back, i.e. you cannot turn it blocking again this way. If you wish to
-- * alternatively switch between blocking and non-blocking, use the
-- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
-- */
--/* VAL_EAGAIN:
-- * This symbol holds the errno error code set by read() when no data was
-- * present on the non-blocking file descriptor.
-- */
--/* RD_NODATA:
-- * This symbol holds the return code from read() when no data is present
-- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
-- * not defined, then you can't distinguish between no data and EOF by
-- * issuing a read(). You'll have to find another way to tell for sure!
-- */
--/* EOF_NONBLOCK:
-- * This symbol, if defined, indicates to the C program that a read() on
-- * a non-blocking file descriptor will return 0 on EOF, and not the value
-- * held in RD_NODATA (-1 usually, in that case!).
-- */
--#define VAL_O_NONBLOCK O_NONBLOCK
--#define VAL_EAGAIN EAGAIN
--#define RD_NODATA -1
--#define EOF_NONBLOCK
--
/* OLDARCHLIB:
* This variable, if defined, holds the name of the directory in
* which the user has perl5.000 or perl5.001 architecture-dependent
#define SITELIB "/opt/perl/lib/site_perl" /**/
#define SITELIB_EXP "/opt/perl/lib/site_perl" /**/
--/* SSize_t:
-- * This symbol holds the type used by functions that return
-- * a count of bytes or an error condition. It must be a signed type.
-- * It is usually ssize_t, but may be long or int, etc.
-- * It may be necessary to include <sys/types.h> or <unistd.h>
-- * to get any typedef'ed information.
-- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
-- */
--#define SSize_t ssize_t /* signed count of bytes */
--
/* STARTPERL:
* This variable contains the string to put in front of a perl
* script to make sure (one hopes) that it runs with perl and not
*/
#define MEM_ALIGNBYTES $alignbytes /**/
++/* ARCHNAME:
++ * This symbol holds a string representing the architecture name.
++ * It may be used to construct an architecture-dependant pathname
++ * where library files may be held under a private library, for
++ * instance.
++ */
++#define ARCHNAME "$archname" /**/
++
/* BIN:
* This symbol holds the path of the bin directory where the package will
* be installed. Program must be prepared to deal with ~name substitution.
#$d_htonl HAS_NTOHL /**/
#$d_htonl HAS_NTOHS /**/
--/* HAS_INET_ATON:
-- * This symbol, if defined, indicates to the C program that the
-- * inet_aton() function is available to parse IP address "dotted-quad"
-- * strings.
-- */
--#$d_inetaton HAS_INET_ATON /**/
--
/* HAS_ISASCII:
* This manifest constant lets the C program know that isascii
* is available.
* This symbol is defined if the FILE_cnt macro can be used as an
* lvalue.
*/
--/* FILE_filbuf:
-- * This macro is used to access the internal stdio _filbuf function
-- * (or equivalent), if STDIO_CNT_LVALUE and STDIO_PTR_LVALUE
-- * are defined. It is typically either _filbuf or __filbuf.
-- * This macro will only be defined if both STDIO_CNT_LVALUE and
-- * STDIO_PTR_LVALUE are defined.
-- */
#$d_stdstdio USE_STDIO_PTR /**/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) $stdio_ptr
#$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) $stdio_cnt
#$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/
--#if defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
--#define FILE_filbuf(fp) $stdio_filbuf /**/
--#endif
#endif
/* USE_STDIO_BASE:
*/
#define Mode_t $modetype /* file mode parameter for system calls */
++/* VAL_O_NONBLOCK:
++ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
++ * non-blocking I/O for the file descriptor. Note that there is no way
++ * back, i.e. you cannot turn it blocking again this way. If you wish to
++ * alternatively switch between blocking and non-blocking, use the
++ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
++ */
++/* VAL_EAGAIN:
++ * This symbol holds the errno error code set by read() when no data was
++ * present on the non-blocking file descriptor.
++ */
++/* RD_NODATA:
++ * This symbol holds the return code from read() when no data is present
++ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
++ * not defined, then you can't distinguish between no data and EOF by
++ * issuing a read(). You'll have to find another way to tell for sure!
++ */
++/* EOF_NONBLOCK:
++ * This symbol, if defined, indicates to the C program that a read() on
++ * a non-blocking file descriptor will return 0 on EOF, and not the value
++ * held in RD_NODATA (-1 usually, in that case!).
++ */
++#define VAL_O_NONBLOCK $o_nonblock
++#define VAL_EAGAIN $eagain
++#define RD_NODATA $rd_nodata
++#$d_eofnblk EOF_NONBLOCK
++
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* function prototypes.
*/
#define Size_t $sizetype /* length paramater for string functions */
++/* SSize_t:
++ * This symbol holds the type used by functions that return
++ * a count of bytes or an error condition. It must be a signed type.
++ * It is usually ssize_t, but may be long or int, etc.
++ * It may be necessary to include <sys/types.h> or <unistd.h>
++ * to get any typedef'ed information.
++ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
++ */
++#define SSize_t $ssizetype /* signed count of bytes */
++
/* STDCHAR:
* This symbol is defined to be the type of char used in stdio.h.
* It has the values "unsigned char" or "char".
#$d_getpgrp HAS_GETPGRP /**/
#$d_bsdgetpgrp USE_BSD_GETPGRP /**/
++/* HAS_INET_ATON:
++ * This symbol, if defined, indicates to the C program that the
++ * inet_aton() function is available to parse IP address "dotted-quad"
++ * strings.
++ */
++#$d_inetaton HAS_INET_ATON /**/
++
/* HAS_SETPGID:
* This symbol, if defined, indicates to the C program that
* the setpgid(pid, gpid) function is available to set the
*/
#$d_mymalloc MYMALLOC /**/
--/* VAL_O_NONBLOCK:
-- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
-- * non-blocking I/O for the file descriptor. Note that there is no way
-- * back, i.e. you cannot turn it blocking again this way. If you wish to
-- * alternatively switch between blocking and non-blocking, use the
-- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
-- */
--/* VAL_EAGAIN:
-- * This symbol holds the errno error code set by read() when no data was
-- * present on the non-blocking file descriptor.
-- */
--/* RD_NODATA:
-- * This symbol holds the return code from read() when no data is present
-- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
-- * not defined, then you can't distinguish between no data and EOF by
-- * issuing a read(). You'll have to find another way to tell for sure!
-- */
--/* EOF_NONBLOCK:
-- * This symbol, if defined, indicates to the C program that a read() on
-- * a non-blocking file descriptor will return 0 on EOF, and not the value
-- * held in RD_NODATA (-1 usually, in that case!).
-- */
--#define VAL_O_NONBLOCK $o_nonblock
--#define VAL_EAGAIN $eagain
--#define RD_NODATA $rd_nodata
--#$d_eofnblk EOF_NONBLOCK
--
/* OLDARCHLIB:
* This variable, if defined, holds the name of the directory in
* which the user has perl5.000 or perl5.001 architecture-dependent
#define SITELIB "$sitelib" /**/
#define SITELIB_EXP "$sitelibexp" /**/
--/* SSize_t:
-- * This symbol holds the type used by functions that return
-- * a count of bytes or an error condition. It must be a signed type.
-- * It is usually ssize_t, but may be long or int, etc.
-- * It may be necessary to include <sys/types.h> or <unistd.h>
-- * to get any typedef'ed information.
-- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
-- */
--#define SSize_t $ssizetype /* signed count of bytes */
--
/* STARTPERL:
* This variable contains the string to put in front of a perl
* script to make sure (one hopes) that it runs with perl and not
++#! /bin/sh
++#
++# $Id: configure,v 3.0.1.1 1995/07/25 14:16:21 ram Exp $
++#
++# GNU configure-like front end to metaconfig's Configure.
++#
++# Written by Andy Dougherty <doughera@lafcol.lafayette.edu>
++# and Matthew Green <mrg@mame.mu.oz.au>.
++#
++# Reformatted and modified for inclusion in the dist-3.0 package by
++# Raphael Manfredi <ram@hptnos02.grenoble.hp.com>.
++#
++# This script belongs to the public domain and may be freely redistributed.
++#
++# The remaining of this leading shell comment may be removed if you
++# include this script in your own package.
++#
++# $Log: configure,v $
++# Revision 3.0.1.1 1995/07/25 14:16:21 ram
++# patch56: created
++#
++
++(exit $?0) || exec sh $0 $argv:q
++
++case "$0" in
++*configure)
++ if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
++ echo "Your configure and Configure scripts seem to be identical."
++ echo "This can happen on filesystems that aren't fully case sensitive."
++ echo "You'll have to explicitely extract Configure and run that."
++ exit 1
++ fi
++ ;;
++esac
++
++opts=''
++verbose=''
++create='-e'
++while test $# -gt 0; do
++ case $1 in
++ --help)
++ cat <<EOM
++Usage: configure [options]
++This is GNU configure-like front end for a metaconfig-generated Configure.
++It emulates the following GNU configure options (must be fully spelled out):
++ --help
++ --no-create
++ --prefix=PREFIX
++ --quiet
++ --silent
++ --verbose
++ --version
++
++And it honours these environment variables: CC, CFLAGS and DEFS.
++EOM
++ exit 0
++ ;;
++ --no-create)
++ create='-E'
++ shift
++ ;;
++ --prefix=*)
++ arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'`
++ opts="$opts $arg"
++ shift
++ ;;
++ --quiet|--silent)
++ exec >/dev/null 2>&1
++ shift
++ ;;
++ --verbose)
++ verbose=true
++ shift
++ ;;
++ --version)
++ copt="$copt -V"
++ shift
++ ;;
++ --*)
++ opt=`echo $1 | sed 's/=.*//'`
++ echo "This GNU configure front end does not understand $opt"
++ exit 1
++ ;;
++ *)
++ opts="$opts $1"
++ shift
++ ;;
++ esac
++done
++
++case "$CC" in
++'') ;;
++*) opts="$opts -Dcc='$CC'";;
++esac
++
++# Join DEFS and CFLAGS together.
++ccflags=''
++case "$DEFS" in
++'') ;;
++*) ccflags=$DEFS;;
++esac
++case "$CFLAGS" in
++'') ;;
++*) ccflags="$ccflags $CFLAGS";;
++esac
++case "$ccflags" in
++'') ;;
++*) opts="$opts -Dccflags='$ccflags'";;
++esac
++
++# Don't use -s if they want verbose mode
++case "$verbose" in
++'') copt="$copt -ds";;
++*) copt="$copt -d";;
++esac
++
++set X sh Configure $copt $create $opts
++shift
++echo "$@"
++exec "$@"
/* We muck with cxstack_ix since _dec may call a DESTROY, overwriting cx. */
#define POPSUB(cx) \
-- if (cx->blk_sub.hasargs) { /* put back old @_ */ \
++ if (cx->blk_sub.hasargs) { \
++ /* put back old @_ */ \
SvREFCNT_dec(GvAV(defgv)); \
GvAV(defgv) = cx->blk_sub.savearray; \
++ /* destroy arg array */ \
++ av_clear(cx->blk_sub.argarray); \
++ AvREAL_off(cx->blk_sub.argarray); \
} \
if (cx->blk_sub.cv) { \
if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \
#define CVf_UNIQUE 0x10 /* can't be cloned */
#define CVf_NODEBUG 0x20 /* no DB::sub indirection for this CV
(esp. useful for special XSUBs) */
--#define CVf_FORMAT 0x40 /* is a format, not a sub */
#define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE)
#define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE)
#define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE)
#define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE)
--#define CvFORMAT(cv) (CvFLAGS(cv) & CVf_FORMAT)
--#define CvFORMAT_on(cv) (CvFLAGS(cv) |= CVf_FORMAT)
--#define CvFORMAT_off(cv) (CvFLAGS(cv) &= ~CVf_FORMAT)
--
#define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG)
#define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG)
#define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG)
MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'lib/IO/Handle.pm',
++ XS_VERSION => 1.15
);
use IO::File;
$fh = new IO::File;
-- if ($fh->open "< file") {
++ if ($fh->open("< file")) {
print <$fh>;
$fh->close;
}
-- $fh = new IO::File "> FOO";
++ $fh = new IO::File "> file";
if (defined $fh) {
print $fh "bar\n";
$fh->close;
$fh = new IO::File "file", O_WRONLY|O_APPEND;
if (defined $fh) {
print $fh "corge\n";
-- undef $fh; # automatically closes the file
-- }
-- $pos = $fh->getpos;
-- $fh->setpos $pos;
++ $pos = $fh->getpos;
++ $fh->setpos($pos);
-- $fh->setvbuf($buffer_var, _IOLBF, 1024);
++ undef $fh; # automatically closes the file
++ }
autoflush STDOUT 1;
++
package IO::Handle;
=head1 NAME
use IO::Handle;
$fh = new IO::Handle;
-- if ($fh->open "< file") {
-- print <$fh>;
-- $fh->close;
-- }
--
-- $fh = new IO::Handle "> FOO";
-- if (defined $fh) {
-- print $fh "bar\n";
++ if ($fh->fdopen(fileno(STDIN),"r")) {
++ print $fh->getline;
$fh->close;
}
-- $fh = new IO::Handle "file", "r";
-- if (defined $fh) {
-- print <$fh>;
-- undef $fh; # automatically closes the file
-- }
--
-- $fh = new IO::Handle "file", O_WRONLY|O_APPEND;
-- if (defined $fh) {
-- print $fh "corge\n";
-- undef $fh; # automatically closes the file
++ $fh = new IO::Handle;
++ if ($fh->fdopen(fileno(STDOUT),"w")) {
++ $fh->print("Some text\n");
}
-- $pos = $fh->getpos;
-- $fh->setpos $pos;
--
$fh->setvbuf($buffer_var, _IOLBF, 1024);
++ undef $fh; # automatically closes the file if it's open
++
autoflush STDOUT 1;
=head1 DESCRIPTION
--C<IO::Handle> is the base class for all other IO handle classes.
++C<IO::Handle> is the base class for all other IO handle classes. It is
++not intended that objects of C<IO::Handle> would be created directly,
++but instead C<IO::Handle> is inherited from by several other classes
++in the IO hierarchy.
++
++If you are reading this documentation, looking for a replacement for
++the C<FileHandle> package, then I suggest you read the documentation
++for C<IO::File>
++
A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
=head1 CONSTRUCTOR
L<perlfunc>,
L<perlop/"I/O Operators">,
--L<FileHandle>
++L<IO::File>
=head1 BUGS
require 5.000;
use strict;
--use vars qw($VERSION @EXPORT_OK $AUTOLOAD @ISA);
++use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
use Carp;
use Symbol;
use SelectSaver;
require Exporter;
@ISA = qw(Exporter);
--$VERSION = "1.1402";
++$VERSION = "1.1501";
++$XS_VERSION = "1.15";
@EXPORT_OK = qw(
autoflush
require DynaLoader;
@IO::ISA = qw(DynaLoader);
--bootstrap IO $VERSION;
++bootstrap IO $XS_VERSION;
sub AUTOLOAD {
if ($AUTOLOAD =~ /::(_?[a-z])/) {
sub close {
@_ == 1 or croak 'usage: $fh->close()';
my($fh) = @_;
-- my $r = close($fh);
--
-- # This may seem as though it should be in IO::Pipe, but the
-- # object gets blessed out of IO::Pipe when reader/writer is called
-- waitpid(${*$fh}{'io_pipe_pid'},0)
-- if(defined ${*$fh}{'io_pipe_pid'});
-- $r;
++ close($fh);
}
################################################
++# IO::Pipe.pm
#
++# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
++# reserved. This program is free software; you can redistribute it and/or
++# modify it under the same terms as Perl itself.
package IO::Pipe;
++require 5.000;
++
++use IO::Handle;
++use strict;
++use vars qw($VERSION);
++use Carp;
++use Symbol;
++
++$VERSION = "1.09";
++
++sub new {
++ my $type = shift;
++ my $class = ref($type) || $type || "IO::Pipe";
++ @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
++
++ my $me = bless gensym(), $class;
++
++ my($readfh,$writefh) = @_ ? @_ : $me->handles;
++
++ pipe($readfh, $writefh)
++ or return undef;
++
++ @{*$me} = ($readfh, $writefh);
++
++ $me;
++}
++
++sub handles {
++ @_ == 1 or croak 'usage: $pipe->handles()';
++ (IO::Pipe::End->new(), IO::Pipe::End->new());
++}
++
++my $do_spawn = $^O eq 'os2';
++
++sub _doit {
++ my $me = shift;
++ my $rw = shift;
++
++ my $pid = $do_spawn ? 0 : fork();
++
++ if($pid) { # Parent
++ return $pid;
++ }
++ elsif(defined $pid) { # Child or spawn
++ my $fh;
++ my $io = $rw ? \*STDIN : \*STDOUT;
++ my ($mode, $save) = $rw ? "r" : "w";
++ if ($do_spawn) {
++ require Fcntl;
++ $save = IO::Handle->new_from_fd($io, $mode);
++ # Close in child:
++ fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
++ $fh = $rw ? ${*$me}[0] : ${*$me}[1];
++ } else {
++ shift;
++ $fh = $rw ? $me->reader() : $me->writer(); # close the other end
++ }
++ bless $io, "IO::Handle";
++ $io->fdopen($fh, $mode);
++
++ if ($do_spawn) {
++ $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
++ my $err = $!;
++
++ $io->fdopen($save, $mode);
++ $save->close or croak "Cannot close $!";
++ croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
++ return $pid;
++ } else {
++ exec @_ or
++ croak "IO::Pipe: Cannot exec: $!";
++ }
++ }
++ else {
++ croak "IO::Pipe: Cannot fork: $!";
++ }
++
++ # NOT Reached
++}
++
++sub reader {
++ @_ >= 1 or croak 'usage: $pipe->reader()';
++ my $me = shift;
++ my $fh = ${*$me}[0];
++ my $pid = $me->_doit(0, $fh, @_)
++ if(@_);
++
++ close ${*$me}[1];
++ bless $me, ref($fh);
++ *{*$me} = *{*$fh}; # Alias self to handle
++ bless $fh; # Really wan't un-bless here
++ ${*$me}{'io_pipe_pid'} = $pid
++ if defined $pid;
++
++ $me;
++}
++
++sub writer {
++ @_ >= 1 or croak 'usage: $pipe->writer()';
++ my $me = shift;
++ my $fh = ${*$me}[1];
++ my $pid = $me->_doit(1, $fh, @_)
++ if(@_);
++
++ close ${*$me}[0];
++ bless $me, ref($fh);
++ *{*$me} = *{*$fh}; # Alias self to handle
++ bless $fh; # Really wan't un-bless here
++ ${*$me}{'io_pipe_pid'} = $pid
++ if defined $pid;
++
++ $me;
++}
++
++package IO::Pipe::End;
++
++use vars qw(@ISA);
++
++@ISA = qw(IO::Handle);
++
++sub close {
++ my $fh = shift;
++ my $r = $fh->SUPER::close(@_);
++
++ waitpid(${*$fh}{'io_pipe_pid'},0)
++ if(defined ${*$fh}{'io_pipe_pid'});
++
++ $r;
++}
++
++1;
++
++__END__
++
=head1 NAME
IO::pipe - supply object methods for pipes
This method is called during construction by C<IO::Pipe::new>
on the newly created C<IO::Pipe> object. It returns an array of two objects
--blessed into C<IO::Handle>, or a subclass thereof.
++blessed into C<IO::Pipe::End>, or a subclass thereof.
=back
=head1 COPYRIGHT
--Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
++Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
=cut
--
--require 5.000;
--use strict;
--use vars qw($VERSION);
--use Carp;
--use Symbol;
--require IO::Handle;
--
--$VERSION = "1.08";
--
--sub new {
-- my $type = shift;
-- my $class = ref($type) || $type || "IO::Pipe";
-- @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
--
-- my $me = bless gensym(), $class;
--
-- my($readfh,$writefh) = @_ ? @_ : $me->handles;
--
-- pipe($readfh, $writefh)
-- or return undef;
--
-- @{*$me} = ($readfh, $writefh);
--
-- $me;
--}
--
--sub handles {
-- @_ == 1 or croak 'usage: $pipe->handles()';
-- (IO::Handle->new(), IO::Handle->new());
--}
--
--sub _doit {
-- my $me = shift;
-- my $rw = shift;
--
-- my $pid = fork();
--
-- if($pid) { # Parent
-- return $pid;
-- }
-- elsif(defined $pid) { # Child
-- my $fh = $rw ? $me->reader() : $me->writer();
-- my $io = $rw ? \*STDIN : \*STDOUT;
--
-- bless $io, "IO::Handle";
-- $io->fdopen($fh, $rw ? "r" : "w");
-- exec @_ or
-- croak "IO::Pipe: Cannot exec: $!";
-- }
-- else {
-- croak "IO::Pipe: Cannot fork: $!";
-- }
--
-- # NOT Reached
--}
--
--sub reader {
-- @_ >= 1 or croak 'usage: $pipe->reader()';
-- my $me = shift;
-- my $fh = ${*$me}[0];
-- my $pid = $me->_doit(0,@_)
-- if(@_);
--
-- close(${*$me}[1]);
-- bless $me, ref($fh);
-- *{*$me} = *{*$fh}; # Alias self to handle
-- bless $fh, 'IO::Pipe::DeadEnd'; # Really wan't un-bless here
-- ${*$me}{'io_pipe_pid'} = $pid
-- if defined $pid;
--
-- $me;
--}
--
--sub writer {
-- @_ >= 1 or croak 'usage: $pipe->writer()';
-- my $me = shift;
-- my $fh = ${*$me}[1];
-- my $pid = $me->_doit(1,@_)
-- if(@_);
--
-- close(${*$me}[0]);
-- bless $me, ref($fh);
-- *{*$me} = *{*$fh}; # Alias self to handle
-- bless $fh, 'IO::Pipe::DeadEnd'; # Really wan't un-bless here
-- ${*$me}{'io_pipe_pid'} = $pid
-- if defined $pid;
--
-- $me;
--}
--
--1;
--
++# IO::Socket.pm
#
++# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
++# reserved. This program is free software; you can redistribute it and/or
++# modify it under the same terms as Perl itself.
package IO::Socket;
@ISA = qw(IO::Handle);
--$VERSION = "1.15";
++$VERSION = "1.16";
sub import {
my $pkg = shift;
sub register_domain {
my($p,$d) = @_;
-- $domain2pkg[$d] = bless \$d, $p;
--}
--
--sub _domain2pkg {
-- my $domain = shift;
--
-- croak "Unsupported socket domain"
-- unless defined $domain2pkg[$domain];
--
-- $domain2pkg[$domain]
++ $domain2pkg[$d] = $p;
}
sub configure {
croak 'IO::Socket: Cannot configure a generic socket'
unless defined $domain;
-- my $class = ref(_domain2pkg($domain));
++ croak "IO::Socket: Unsupported socket domain"
++ unless defined $domain2pkg[$domain];
croak "IO::Socket: Cannot configure socket in domain '$domain'"
unless ref($fh) eq "IO::Socket";
-- bless($fh, $class);
++ bless($fh, $domain2pkg[$domain]);
$fh->configure;
}
@_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
my($fh,$domain,$type,$protocol) = @_;
socket($fh,$domain,$type,$protocol) or
return undef;
-- ${*$fh}{'io_socket_type'} = $type;
-- ${*$fh}{'io_socket_proto'} = $protocol;
++ ${*$fh}{'io_socket_domain'} = $domain;
++ ${*$fh}{'io_socket_type'} = $type;
++ ${*$fh}{'io_socket_proto'} = $protocol;
++
$fh;
}
sub sockdomain {
@_ == 1 or croak 'usage: $fh->sockdomain()';
my $fh = shift;
-- ${${*$fh}{'io_socket_domain'}}
++ ${*$fh}{'io_socket_domain'};
}
sub socktype {
my $pname = (getprotobynumber($proto))[0];
$type = $arg->{Type} || $socket_type{$pname};
-- my $domain = AF_INET;
-- ${*$fh}{'io_socket_domain'} = bless \$domain;
--
$fh->socket(AF_INET, $type, $proto) or
return _error($fh,"$!");
my $type = $arg->{Type} || SOCK_STREAM;
-- my $domain = AF_UNIX;
-- ${*$fh}{'io_socket_domain'} = bless \$domain;
--
$fh->socket(AF_UNIX, $type, 0) or
return undef;
=head1 COPYRIGHT
--Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
++Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
dirent_h => [qw()],
-- errno_h => [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM
-- EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE
-- EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK
-- ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO
-- EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)],
++ errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
++ EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
++ ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
++ EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
++ EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
++ EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
++ ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
++ ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
++ ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
++ EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
++ ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
++ ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
++ EUSERS EWOULDBLOCK EXDEV errno)],
fcntl_h => [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)],
-- signal_h => [qw(SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE
-- SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV
-- SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2
-- SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
-- raise sigaction signal sigpending sigprocmask
-- sigsuspend)],
++ signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
++ SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
++ SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
++ SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
++ SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
++ SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
++ sigpending sigprocmask sigsuspend)],
stdarg_h => [qw()],
=item Constants
--E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV
++E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
++EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ
++EDOM EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR
++EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG
++ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC
++ENOLCK ENOMEM ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
++ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE
++EPROCLIM EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS
++ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS
++ETXTBSY EUSERS EWOULDBLOCK EXDEV
=back
=item Constants
--SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
++SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART
++SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT
++SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
++SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK
++SIG_UNBLOCK
=back
# include <libdef.h> /* LIB$_INVARG constant */
# include <lib$routines.h> /* prototype for lib$ediv() */
# include <starlet.h> /* prototype for sys$gettim() */
++# if DECC_VERSION < 50000000
++# define pid_t int /* old versions of DECC miss this in types.h */
++# endif
# undef mkfifo /* #defined in perl.h */
# define mkfifo(a,b) (not_here("mkfifo"),-1)
#else
goto not_there;
#endif
++ if (strEQ(name, "EADDRINUSE"))
++#ifdef EADDRINUSE
++ return EADDRINUSE;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "EADDRNOTAVAIL"))
++#ifdef EADDRNOTAVAIL
++ return EADDRNOTAVAIL;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "EAFNOSUPPORT"))
++#ifdef EAFNOSUPPORT
++ return EAFNOSUPPORT;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EAGAIN"))
#ifdef EAGAIN
return EAGAIN;
#else
goto not_there;
#endif
++ if (strEQ(name, "EALREADY"))
++#ifdef EALREADY
++ return EALREADY;
++#else
++ goto not_there;
++#endif
break;
case 'B':
if (strEQ(name, "EBADF"))
#else
goto not_there;
#endif
++ if (strEQ(name, "ECONNABORTED"))
++#ifdef ECONNABORTED
++ return ECONNABORTED;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ECONNREFUSED"))
++#ifdef ECONNREFUSED
++ return ECONNREFUSED;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ECONNRESET"))
++#ifdef ECONNRESET
++ return ECONNRESET;
++#else
++ goto not_there;
++#endif
break;
case 'D':
if (strEQ(name, "EDEADLK"))
#else
goto not_there;
#endif
++ if (strEQ(name, "EDESTADDRREQ"))
++#ifdef EDESTADDRREQ
++ return EDESTADDRREQ;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EDOM"))
#ifdef EDOM
return EDOM;
#else
goto not_there;
#endif
++ if (strEQ(name, "EDQUOT"))
++#ifdef EDQUOT
++ return EDQUOT;
++#else
++ goto not_there;
++#endif
break;
case 'E':
if (strEQ(name, "EEXIST"))
goto not_there;
#endif
break;
++ case 'H':
++ if (strEQ(name, "EHOSTDOWN"))
++#ifdef EHOSTDOWN
++ return EHOSTDOWN;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "EHOSTUNREACH"))
++#ifdef EHOSTUNREACH
++ return EHOSTUNREACH;
++#else
++ goto not_there;
++#endif
++ break;
case 'I':
++ if (strEQ(name, "EINPROGRESS"))
++#ifdef EINPROGRESS
++ return EINPROGRESS;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EINTR"))
#ifdef EINTR
return EINTR;
#else
goto not_there;
#endif
++ if (strEQ(name, "EISCONN"))
++#ifdef EISCONN
++ return EISCONN;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EISDIR"))
#ifdef EISDIR
return EISDIR;
#else
goto not_there;
#endif
++ if (strEQ(name, "ELOOP"))
++#ifdef ELOOP
++ return ELOOP;
++#else
++ goto not_there;
++#endif
break;
case 'M':
if (strEQ(name, "EMFILE"))
#else
goto not_there;
#endif
++ if (strEQ(name, "EMSGSIZE"))
++#ifdef EMSGSIZE
++ return EMSGSIZE;
++#else
++ goto not_there;
++#endif
break;
case 'N':
++ if (strEQ(name, "ENETDOWN"))
++#ifdef ENETDOWN
++ return ENETDOWN;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ENETRESET"))
++#ifdef ENETRESET
++ return ENETRESET;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ENETUNREACH"))
++#ifdef ENETUNREACH
++ return ENETUNREACH;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ENOBUFS"))
++#ifdef ENOBUFS
++ return ENOBUFS;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ENOEXEC"))
++#ifdef ENOEXEC
++ return ENOEXEC;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "ENOMEM"))
#ifdef ENOMEM
return ENOMEM;
#else
goto not_there;
#endif
++ if (strEQ(name, "ENOPROTOOPT"))
++#ifdef ENOPROTOOPT
++ return ENOPROTOOPT;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "ENOSPC"))
#ifdef ENOSPC
return ENOSPC;
#else
goto not_there;
#endif
-- if (strEQ(name, "ENOEXEC"))
--#ifdef ENOEXEC
-- return ENOEXEC;
++ if (strEQ(name, "ENOTBLK"))
++#ifdef ENOTBLK
++ return ENOTBLK;
#else
goto not_there;
#endif
-- if (strEQ(name, "ENOTTY"))
--#ifdef ENOTTY
-- return ENOTTY;
++ if (strEQ(name, "ENOTCONN"))
++#ifdef ENOTCONN
++ return ENOTCONN;
#else
goto not_there;
#endif
#else
goto not_there;
#endif
++ if (strEQ(name, "ENOTSOCK"))
++#ifdef ENOTSOCK
++ return ENOTSOCK;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ENOTTY"))
++#ifdef ENOTTY
++ return ENOTTY;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "ENFILE"))
#ifdef ENFILE
return ENFILE;
#else
goto not_there;
#endif
++ if (strEQ(name, "EOPNOTSUPP"))
++#ifdef EOPNOTSUPP
++ return EOPNOTSUPP;
++#else
++ goto not_there;
++#endif
break;
case 'P':
if (strEQ(name, "EPERM"))
#else
goto not_there;
#endif
++ if (strEQ(name, "EPFNOSUPPORT"))
++#ifdef EPFNOSUPPORT
++ return EPFNOSUPPORT;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EPIPE"))
#ifdef EPIPE
return EPIPE;
#else
goto not_there;
#endif
++ if (strEQ(name, "EPROCLIM"))
++#ifdef EPROCLIM
++ return EPROCLIM;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "EPROTONOSUPPORT"))
++#ifdef EPROTONOSUPPORT
++ return EPROTONOSUPPORT;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "EPROTOTYPE"))
++#ifdef EPROTOTYPE
++ return EPROTOTYPE;
++#else
++ goto not_there;
++#endif
break;
case 'R':
if (strEQ(name, "ERANGE"))
#else
goto not_there;
#endif
++ if (strEQ(name, "EREMOTE"))
++#ifdef EREMOTE
++ return EREMOTE;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ERESTART"))
++#ifdef ERESTART
++ return ERESTART;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "EROFS"))
#ifdef EROFS
return EROFS;
#endif
break;
case 'S':
++ if (strEQ(name, "ESHUTDOWN"))
++#ifdef ESHUTDOWN
++ return ESHUTDOWN;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ESOCKTNOSUPPORT"))
++#ifdef ESOCKTNOSUPPORT
++ return ESOCKTNOSUPPORT;
++#else
++ goto not_there;
++#endif
if (strEQ(name, "ESPIPE"))
#ifdef ESPIPE
return ESPIPE;
#else
goto not_there;
#endif
++ if (strEQ(name, "ESTALE"))
++#ifdef ESTALE
++ return ESTALE;
++#else
++ goto not_there;
++#endif
break;
++ case 'T':
++ if (strEQ(name, "ETIMEDOUT"))
++#ifdef ETIMEDOUT
++ return ETIMEDOUT;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ETOOMANYREFS"))
++#ifdef ETOOMANYREFS
++ return ETOOMANYREFS;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "ETXTBSY"))
++#ifdef ETXTBSY
++ return ETXTBSY;
++#else
++ goto not_there;
++#endif
++ break;
++ case 'U':
++ if (strEQ(name, "EUSERS"))
++#ifdef EUSERS
++ return EUSERS;
++#else
++ goto not_there;
++#endif
++ break;
++ case 'W':
++ if (strEQ(name, "EWOULDBLOCK"))
++#ifdef EWOULDBLOCK
++ return EWOULDBLOCK;
++#else
++ goto not_there;
++#endif
++ break;
case 'X':
if (strEQ(name, "EXIT_FAILURE"))
#ifdef EXIT_FAILURE
#else
goto not_there;
#endif
-- if (strEQ(name, "SA_NOCLDSTOP"))
++ if (strnEQ(name, "SA_", 3)) {
++ if (strEQ(name, "SA_NOCLDSTOP"))
#ifdef SA_NOCLDSTOP
-- return SA_NOCLDSTOP;
++ return SA_NOCLDSTOP;
#else
-- goto not_there;
++ goto not_there;
#endif
++ if (strEQ(name, "SA_NOCLDWAIT"))
++#ifdef SA_NOCLDWAIT
++ return SA_NOCLDWAIT;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "SA_NODEFER"))
++#ifdef SA_NODEFER
++ return SA_NODEFER;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "SA_ONSTACK"))
++#ifdef SA_ONSTACK
++ return SA_ONSTACK;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "SA_RESETHAND"))
++#ifdef SA_RESETHAND
++ return SA_RESETHAND;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "SA_RESTART"))
++#ifdef SA_RESTART
++ return SA_RESTART;
++#else
++ goto not_there;
++#endif
++ if (strEQ(name, "SA_SIGINFO"))
++#ifdef SA_SIGINFO
++ return SA_SIGINFO;
++#else
++ goto not_there;
++#endif
++ break;
++ }
if (strEQ(name, "SCHAR_MAX"))
#ifdef SCHAR_MAX
return SCHAR_MAX;
if ( cp = (char *)AMG_names[0] ) {
/* Try to find via inheritance. */
- gv = gv_fetchmeth(stash, "()", 2, 0); /* A cooky: "()". */
- gv = gv_fetchmeth(stash, "()", 2, -1); /* A cooky: "()". */
++ gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
if (gv) sv = GvSV(gv);
- if (!sv) /* Empty */;
- if (!gv) goto notable;
++ if (!gv) goto no_table;
else if (SvTRUE(sv)) amt.fallback=AMGfallYES;
else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
}
cv = 0;
cp = (char *)AMG_names[i];
-- *buf = '('; /* A cooky: "(". */
++ *buf = '('; /* A cookie: "(". */
strcpy(buf + 1, cp);
DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
cp, HvNAME(stash)) );
}
}
/* Here we have no table: */
- notable:
++ no_table:
AMT_AMAGIC_off(&amt);
sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
return FALSE;
} else if (cvp && (cv=cvp[nomethod_amg])) {
notfound = 1; lr = 1;
} else {
-- if (off==-1) off=method;
- sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
- sprintf(buf, "Operation `%s': no method found,%sargument %s%.256s%s%.256s",
++ if (off==-1) off=method;
++ sprintf(buf,
++ "Operation `%s': no method found,%sargument %s%.256s%s%.256s",
AMG_names[method + assignshift],
+ (flags & AMGf_unary ? " " : "\n\tleft "),
SvAMAGIC(left)?
"in overloaded package ":
"has no overloaded magic",
}
}
if (!notfound) {
-- DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
++ DEBUG_o( deb(
++ "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
AMG_names[off],
method+assignshift==off? "" :
" (initially `",
alignbytes=8
selecttype='int *'
++# When HP-UX runs a script with "#!", it sets argv[0] to the script name.
++toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"'
++
# If your compile complains about FLT_MIN, uncomment the next line
# POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"'
#
cc='gcc'
--ccflags='-D_filbuf=_fillbuf'
so='none'
usemymalloc='n'
# Author: Charles Bailey bailey@genetics.upenn.edu
package ExtUtils::MM_VMS;
--$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.38 (19-Nov-1996)';
++$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (16-Jan-1997)';
unshift @MM::ISA, 'ExtUtils::MM_VMS';
use Config;
MV = $self->{MV}
RM_F = $self->{RM_F}
RM_RF = $self->{RM_RF}
++SAY = Write Sys\$Output
UMASK_NULL = $self->{UMASK_NULL}
NOOP = $self->{NOOP}
NOECHO = $self->{NOECHO}
qq!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 '=head2 ',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);"
++UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
!);
}
# we use touch to prevent make continually trying to remake it.
# The DynaLoader only reads a non-empty file.
$(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
-- $(NOECHO) Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
++ $(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
$(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
$(NOECHO) $(TOUCH) $(MMS$TARGET)
$(NOECHO) $(NOOP)
install_ :: install_site
-- $(NOECHO) Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
++ $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
pure_install :: pure_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
doc_install :: doc_$(INSTALLDIRS)_install
-- $(NOECHO) Write Sys$Output "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
++ $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
pure__install : pure_site_install
-- $(NOECHO) Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
++ $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
doc__install : doc_site_install
-- $(NOECHO} Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
++ $(NOECHO} $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
# This hack brought to you by DCL's 255-character command line limit
pure_perl_install ::
uninstall_from_perldirs ::
$(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
++ $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
++ $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
++ $(NOECHO) $(SAY) "the appropriate files. Sorry for the inconvenience."
uninstall_from_sitedirs ::
-- $(NOECHO) $(UNINSTALL) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist')."\n";
++ $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[
++ $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
++ $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
++ $(NOECHO) $(SAY) "the appropriate files. Sorry for the inconvenience."
++];
join('',@m);
}
# We take a very conservative approach here, but it\'s worth it.
# We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
$(MAKEFILE) : Makefile.PL $(CONFIGDEP)
-- $(NOECHO) Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
-- $(NOECHO) Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..."
++ $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
++ $(NOECHO) $(SAY) "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(' ',map(qq["$_"],@ARGV)),q[
-- $(NOECHO) Write Sys$Output "$(MAKEFILE) has been rebuilt."
-- $(NOECHO) Write Sys$Output "Please run $(MMS) to build the extension."
++ $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
++ $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
];
join('',@m);
push(@m, ' If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
'; print `$(MMS) $(PASTHRU2) test`'."\n");
}
-- push(@m, "\t\$(NOECHO) Write Sys\$Output \"No tests defined for \$(NAME) extension.\"\n")
++ push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
unless $tests or -f "test.pl" or @{$self->{DIR}};
push(@m, "\n");
unless ($self->{MAKEAPERL}) {
push @m, q{
$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
-- $(NOECHO) Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
++ $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
$(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
Makefile.PL DIR=}, $dir, q{ \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
-- $(NOECHO) Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say"
-- $(NOECHO) Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
-- $(NOECHO) Write Sys$Output "To remove the intermediate files, say
-- $(NOECHO) Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
++ $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
++ $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
++ $(NOECHO) $(SAY) "To remove the intermediate files, say
++ $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
';
push @m,'
',"${tmp}perlmain.c",' : $(MAKEFILE)
=cut
--# Global Constants
--$XSUBPP_version = "1.940";
require 5.002;
++use Cwd;
use vars '$cplusplus';
++# Global Constants
++$XSUBPP_version = "1.94001";
++$Is_VMS = $^O eq 'VMS';
++
sub Q ;
$FH = 'File0000' ;
or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
or ($dir, $filename) = ('.', $ARGV[0]);
chdir($dir);
--# Check for VMS; Config.pm may not be installed yet, but this routine
--# is built into VMS perl
--if (defined(&VMS::Filespec::vmsify)) { $Is_VMS = 1; $pwd = $ENV{DEFAULT}; }
--else { $Is_VMS = 0; chomp($pwd = `pwd`); }
++$pwd = cwd();
++ $IncludedFiles{$ARGV[0]} ;
my $bad = 0;
my $good = 0;
my $total = @tests;
++
++ # pass -I flags to children
my $old5lib = $ENV{PERL5LIB};
-- local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); # pass -I flags to children
++ local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC);
++
++ if ($Is_VMS) { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g }
my $t_start = new Benchmark;
while ($test = shift(@tests)) {
}
my $t_total = timediff(new Benchmark, $t_start);
-- if ($^O eq 'VMS' and defined($old5lib)) { $ENV{PERL5LIB} = $old5lib; }
++ if ($^O eq 'VMS') {
++ if (defined $old5lib) {
++ $ENV{PERL5LIB} = $old5lib;
++ }
++ else {
++ delete $ENV{PERL5LIB};
++ }
++ }
if ($bad == 0 && $totmax) {
print "All tests successful.\n";
} elsif ($total==0){
sub shorten {
my $line = $_[0];
- if (length $line > 79) {
- if (length $line > 79 and index $line, "\n" == -1) {
++ if (length($line) > 79 and index($line, "\n") == -1) {
my $space_place = rindex($line, ' ', 79);
if ($space_place != -1) {
substr($line, $space_place, 1) = "\n\t";
package lib;
++use vars qw(@ORIG_INC);
use Config;
my $archname = $Config{'archname'};
--@ORIG_INC = (); # (avoid typo warning)
@ORIG_INC = @INC; # take a handy copy of 'original' value
next unless defined($_);
if ($_ eq '') {
require Carp;
-- Carp::carp("Empty compile time value given to use lib"); # at foo.pl line ...
++ Carp::carp("Empty compile time value given to use lib");
++ # at foo.pl line ...
}
unshift(@INC, $_);
# Put a corresponding archlib directory infront of $_ if it
# looks like $_ has an archlib directory below it.
-- unshift(@INC, "$_/$archname/$]") if -d "$_/$archname/$]/auto";
-- unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
++ if (-d "$_/$archname") {
++ unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
++ unshift(@INC, "$_/$archname/$]") if -d "$_/$archname/$]/auto";
++ }
}
}
that later C<use> or C<require> statements will find modules which are
not located on perl's default search path.
--
=head2 ADDING DIRECTORIES TO @INC
The parameters to C<use lib> are added to the start of the perl search
If LIST includes both $dir and $dir/$archname then $dir/$archname will
be added to @INC twice (if $dir/$archname/auto exists).
--
=head2 DELETING DIRECTORIES FROM @INC
You should normally only add directories to @INC. If you need to
If LIST includes both $dir and $dir/$archname then $dir/$archname will
be deleted from @INC twice (if $dir/$archname/auto exists).
--
=head2 RESTORING ORIGINAL @INC
When the lib module is first loaded it records the current value of @INC
methods refer to methods triggered by an overloaded mathematical
operator.)
-Since overloading respects @ISA hierarchy, in fact the above
-declaration would also trigger overloading of C<+> and C<*=> in all
-the packages which inherit from C<Number>.
++Since overloading respects inheritance via the @ISA hierarchy, the
++above declaration would also trigger overloading of C<+> and C<*=> in
++all the packages which inherit from C<Number>.
+
=head2 Calling Conventions for Binary Operations
The functions specified in the C<use overload ...> directive are called
See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
-There are two ways how inheritance interacts with overloading.
+ =head2 Inheritance and overloading
+
-If the value of
++Inheritance interacts with overloading in two ways.
+
+ =over
+
+ =item Strings as values of C<use overload> directive
+
-directive is a string, it is interpreted as a method name.
++If C<value> in
+
+ use overload key => value;
+
-If any of ancestors is overloaded, so is the derived class. The set of
-overloaded methods is the union of overloaded methods of all the
-ancestors. If some method is overloaded in several ancestor, then
++is a string, it is interpreted as a method name.
+
+ =item Overloading of an operation is inherited by derived classes
+
-rules:
++Any class derived from an overloaded class is also overloaded. The
++set of overloaded methods is the union of overloaded methods of all
++the ancestors. If some method is overloaded in several ancestor, then
+ which description will be used is decided by the usual inheritance
-If C<A> inherits from C<B> and C<C> (in this order), and C<B>
-overloads C<+> by C<\&D::plus_sub>, C<C> overloads C<+> by
-C<"plus_meth">, then the subroutine C<D::plus_sub> will be called to
-implement operation C<+> for an object in package C<A>.
++rules:
+
-Note that since the value of C<fallback> key is not a subroutine, its
-inheritance is not governed by the above rules. Current implementation
-is that the value of C<fallback> in the first overloaded ancestor is
-taken, but this may be subject to change.
++If C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
++C<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
++then the subroutine C<D::plus_sub> will be called to implement
++operation C<+> for an object in package C<A>.
+
+ =back
+
++Note that since the value of the C<fallback> key is not a subroutine,
++its inheritance is not governed by the above rules. In the current
++implementation, the value of C<fallback> in the first overloaded
++ancestor is used, but this is accidental and subject to change.
+
=head1 SPECIAL SYMBOLS FOR C<use overload>
Three keys are recognized by Perl that are not covered by the above
description.
--=head2 Last Resort
++=head2 Last Resort
C<"nomethod"> should be followed by a reference to a function of four
parameters. If defined, it is called when the overloading mechanism
flag. Thus the only speed penalty during arithmetic operations without
overloading is the checking of this flag.
--In fact, if C<use overload> is not present, there is almost no overhead for
--overloadable operations, so most programs should not suffer measurable
--performance penalties. A considerable effort was made to minimize the overhead
- when overload is used and the current operation is overloadable but
-when overload is used in some package, but
--the arguments in question do not belong to packages using overload. When
--in doubt, test your speed with C<use overload> and without it. So far there
--have been no reports of substantial speed degradation if Perl is compiled
--with optimization turned on.
-
- There is no size penalty for data if overload is not used.
++In fact, if C<use overload> is not present, there is almost no overhead
++for overloadable operations, so most programs should not suffer
++measurable performance penalties. A considerable effort was made to
++minimize the overhead when overload is used in some package, but the
++arguments in question do not belong to packages using overload. When
++in doubt, test your speed with C<use overload> and without it. So far
++there have been no reports of substantial speed degradation if Perl is
++compiled with optimization turned on.
+
+ There is no size penalty for data if overload is not used. The only
+ size penalty if overload is used in some package is that I<all> the
+ packages acquire a magic during the next C<bless>ing into the
+ package. This magic is three-words-long for packages without
+ overloading, and carries the cache tabel if the package is overloaded.
Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
carried out before any operation that can imply an assignment to the
SvNVX(sv) = (double)curcop->cop_seq;
SvIVX(sv) = 999999999; /* A ref, intro immediately */
SvFLAGS(sv) |= SVf_FAKE;
-- if (CvANON(compcv) || CvFORMAT(compcv)) {
++ if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
CvCLONE_on(compcv);
if (cv != startcv) {
if (CvANON(bcv))
CvCLONE_on(bcv);
else {
-- if (dowarn)
++ if (dowarn && !CvUNIQUE(cv))
warn(
"Variable \"%s\" may be unavailable",
name);
if (expr) {
if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
return block; /* do {} while 0 does once */
-- else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
-- expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
++ if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) {
++ expr = newUNOP(OP_DEFINED, 0,
++ newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
++ }
}
listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
----- perl5.003_06/Configure Fri Oct 4 11:08:50 1996
--+++ Configure Wed Oct 9 17:53:14 1996
--@@ -1451,7 +1451,7 @@
++--- Configure.dist Fri Jan 24 10:22:24 1997
+++++ Configure Fri Jan 24 10:22:27 1997
++@@ -1465,7 +1465,7 @@
*)
echo "I don't know where '$file' is, and my life depends on it." >&4
echo "Go find a public domain implementation or fix your PATH setting!" >&4
;;
esac
done
--@@ -1460,7 +1460,9 @@
++@@ -1474,7 +1474,9 @@
say=offhand
for file in $trylist; do
xxx=`./loc $file $file $pth`
eval _$file=$xxx
case "$xxx" in
/*)
--@@ -3091,7 +3093,7 @@
++@@ -3161,7 +3163,7 @@
exit(0);
}
EOM
gccversion=`./gccvers`
case "$gccversion" in
'') echo "You are not using GNU cc." ;;
--@@ -3275,6 +3277,12 @@
++@@ -3364,6 +3366,12 @@
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
else
echo "No -l$thislib."
fi
--@@ -3387,7 +3395,7 @@
++@@ -3912,7 +3920,7 @@
esac
;;
esac
case "$libs" in
'') ;;
*) for thislib in $libs; do
--@@ -3583,6 +3593,10 @@
++@@ -4114,6 +4122,10 @@
eval $xscan;\
$contains '^fprintf$' libc.list >/dev/null 2>&1; then
eval $xrun
else
nm -p $* 2>/dev/null >libc.tmp
$grep fprintf libc.tmp > libc.ptf
--@@ -3593,23 +3607,33 @@
++@@ -4124,23 +4136,33 @@
eval $xrun
else
echo " "
done
echo "Ok." >&4
else
--@@ -5606,7 +5630,7 @@
++@@ -5738,7 +5760,7 @@
exit(0);
}
EOCP
intsize=`./try`
echo "Your integers are $intsize bytes long."
else
--@@ -5686,7 +5710,7 @@
++@@ -5818,7 +5840,7 @@
exit(result);
}
EOCP
./try
yyy=$?
else
--@@ -5767,7 +5791,7 @@
++@@ -5899,7 +5921,7 @@
}
EOCP
./try
castflags=$?
else
--@@ -5806,7 +5830,7 @@
++@@ -5938,7 +5960,7 @@
exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
}
EOF
echo "Your vsprintf() returns (int)." >&4
val2="$undef"
else
--@@ -6148,7 +6172,7 @@
++@@ -6283,7 +6305,7 @@
EOCP
: check sys/file.h first to get FREAD on Sun
if $test `./findhdr sys/file.h` && \
h_sysfile=true;
echo "<sys/file.h> defines the O_* constants..." >&4
if ./open3; then
--@@ -6159,7 +6183,7 @@
++@@ -6294,7 +6316,7 @@
val="$undef"
fi
elif $test `./findhdr fcntl.h` && \
h_fcntl=true;
echo "<fcntl.h> defines the O_* constants..." >&4
if ./open3; then
--@@ -6642,7 +6666,7 @@
++@@ -6800,7 +6822,7 @@
y*|true)
usemymalloc='y'
mallocsrc='malloc.c'
d_mymalloc="$define"
case "$libs" in
*-lmalloc*)
--@@ -7867,7 +7891,7 @@
++@@ -8053,7 +8075,7 @@
printf("%d\n", (char *)&try.bar - (char *)&try.foo);
}
EOCP
dflt=`./try`
else
dflt='8'
--@@ -7915,7 +7939,7 @@
++@@ -8101,7 +8123,7 @@
}
EOCP
xxx_prompt=y
dflt=`./try`
case "$dflt" in
[1-4][1-4][1-4][1-4]|12345678|87654321)
--@@ -8337,7 +8361,7 @@
++@@ -8523,7 +8545,7 @@
printf("%d\n",i);
}
EOCP
dflt=`try`
else
dflt='?'
--@@ -8447,7 +8471,7 @@
++@@ -8633,7 +8655,7 @@
'') $echo $n ".$c"
if $cc $ccflags \
$i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
set X $i_time $i_systime $i_systimek $sysselect $s_timeval
shift
flags="$*"
--@@ -8517,7 +8541,7 @@
++@@ -8702,7 +8724,7 @@
#endif
}
EOCP
d_fds_bits="$define"
d_fd_set="$define"
echo "Well, your system knows about the normal fd_set typedef..." >&4
--@@ -8534,7 +8558,7 @@
++@@ -8719,7 +8741,7 @@
$cat <<'EOM'
Hmm, your compiler has some difficulty with fd_set. Checking further...
EOM
d_fds_bits="$undef"
d_fd_set="$define"
echo "Well, your system has some sort of fd_set available..." >&4
--@@ -9272,7 +9296,7 @@
++@@ -9458,7 +9480,7 @@
else
echo "false"
fi
EOP
chmod +x varargs
--@@ -9596,7 +9620,7 @@
++@@ -9785,7 +9807,7 @@
echo " "
echo "Stripping down executable paths..." >&4
for file in $loclist $trylist; do
/* This guy is needed for quick stdstd */
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
--# define _filbuf _fill
/* Perl uses ungetc only with successful return */
# define ungetc(c,fp) \
(FILE_ptr(fp) > FILE_base(fp) && c == (int)*(FILE_ptr(fp) - 1) \
#define PATCHLEVEL 3
--#define SUBVERSION 22
++#define SUBVERSION 23
/*
local_patches -- list of locally applied less-than-subversion patches.
static void find_beginning _((void));
static void forbid_setid _((char *));
--static void incpush _((char *));
++static void incpush _((char *, int));
static void init_ids _((void));
static void init_debugger _((void));
static void init_lexer _((void));
sv_catpv(sv,s);
sv_catpv(sv," ");
if (*++s) {
-- av_push(GvAVn(incgv),newSVpv(s,0));
++ incpush(s, TRUE);
}
else if (argv[1]) {
-- av_push(GvAVn(incgv),newSVpv(argv[1],0));
++ incpush(argv[1], TRUE);
sv_catpv(sv,argv[1]);
argc--,argv++;
sv_catpv(sv," ");
{
GV* gv = gv_fetchpv(name, create, SVt_PVCV);
if (create && !GvCVu(gv))
-- return newSUB(start_subparse(0),
++ return newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
Nullop,
Nullop);
sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
}
--#if defined(DOSISH)
--# define PERLLIB_SEP ';'
--#else
--# if defined(VMS)
--# define PERLLIB_SEP '|'
--# else
--# define PERLLIB_SEP ':'
--# endif
--#endif
--#ifndef PERLLIB_MANGLE
--# define PERLLIB_MANGLE(s,n) (s)
--#endif
--
--static void
--incpush(p)
--char *p;
--{
-- char *s;
--
-- if (!p)
-- return;
--
-- /* Break at all separators */
-- while (*p) {
-- /* First, skip any consecutive separators */
-- while ( *p == PERLLIB_SEP ) {
-- /* Uncomment the next line for PATH semantics */
-- /* av_push(GvAVn(incgv), newSVpv(".", 1)); */
-- p++;
-- }
-- if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
-- av_push(GvAVn(incgv), newSVpv(PERLLIB_MANGLE(p, (STRLEN)(s - p)),
-- (STRLEN)(s - p)));
-- p = s + 1;
-- } else {
-- av_push(GvAVn(incgv), newSVpv(PERLLIB_MANGLE(p, 0), 0));
-- break;
-- }
-- }
--}
--
static void
usage(name) /* XXX move this out into a module ? */
char *name;
case 'I':
forbid_setid("-I");
if (*++s) {
-- char *e;
++ char *e, *p;
for (e = s; *e && !isSPACE(*e); e++) ;
-- av_push(GvAVn(incgv),newSVpv(s,e-s));
++ p = savepvn(s, e-s);
++ incpush(p, TRUE);
++ Safefree(p);
if (*e)
return e;
}
#endif
printf("\n\nCopyright 1987-1997, Larry Wall\n");
-- printf("\n\t+ suidperl security patch");
#ifdef MSDOS
printf("\n\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
#ifndef VMS
s = getenv("PERL5LIB");
if (s)
-- incpush(s);
++ incpush(s, TRUE);
else
-- incpush(getenv("PERLLIB"));
++ incpush(getenv("PERLLIB"), FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
char buf[256];
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
-- do { incpush(buf); } while (my_trnlnm("PERL5LIB",buf,++idx));
++ do { incpush(buf,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
-- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf);
++ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE);
#endif /* VMS */
}
ARCHLIB PRIVLIB SITEARCH SITELIB and OLDARCHLIB
*/
#ifdef APPLLIB_EXP
-- incpush(APPLLIB_EXP);
++ incpush(APPLLIB_EXP, FALSE);
#endif
#ifdef ARCHLIB_EXP
-- incpush(ARCHLIB_EXP);
++ incpush(ARCHLIB_EXP, FALSE);
#endif
#ifndef PRIVLIB_EXP
#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
-- incpush(PRIVLIB_EXP);
++ incpush(PRIVLIB_EXP, FALSE);
#ifdef SITEARCH_EXP
-- incpush(SITEARCH_EXP);
++ incpush(SITEARCH_EXP, FALSE);
#endif
#ifdef SITELIB_EXP
-- incpush(SITELIB_EXP);
++ incpush(SITELIB_EXP, FALSE);
#endif
#ifdef OLDARCHLIB_EXP /* 5.00[01] compatibility */
-- incpush(OLDARCHLIB_EXP);
++ incpush(OLDARCHLIB_EXP, FALSE);
#endif
if (!tainting)
-- incpush(".");
++ incpush(".", FALSE);
++}
++
++#if defined(DOSISH)
++# define PERLLIB_SEP ';'
++#else
++# if defined(VMS)
++# define PERLLIB_SEP '|'
++# else
++# define PERLLIB_SEP ':'
++# endif
++#endif
++#ifndef PERLLIB_MANGLE
++# define PERLLIB_MANGLE(s,n) (s)
++#endif
++
++static void
++incpush(p, addsubdirs)
++char *p;
++int addsubdirs;
++{
++ SV *subdir = Nullsv;
++ static char *archpat_auto;
++
++ if (!p)
++ return;
++
++ if (addsubdirs) {
++ subdir = newSV(0);
++ if (!archpat_auto) {
++ STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
++ + sizeof("//auto"));
++ New(55, archpat_auto, len, char);
++ sprintf(archpat_auto, "/%s/%s/auto", ARCHNAME, patchlevel);
++ }
++ }
++
++ /* Break at all separators */
++ while (p && *p) {
++ SV *libdir = newSV(0);
++ char *s;
++
++ /* skip any consecutive separators */
++ while ( *p == PERLLIB_SEP ) {
++ /* Uncomment the next line for PATH semantics */
++ /* av_push(GvAVn(incgv), newSVpv(".", 1)); */
++ p++;
++ }
++
++ if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
++ sv_setpvn(libdir, PERLLIB_MANGLE(p, (STRLEN)(s - p)),
++ (STRLEN)(s - p));
++ p = s + 1;
++ }
++ else {
++ sv_setpv(libdir, PERLLIB_MANGLE(p, 0));
++ p = Nullch; /* break out */
++ }
++
++ /*
++ * BEFORE pushing libdir onto @INC we may first push version- and
++ * archname-specific sub-directories.
++ */
++ if (addsubdirs) {
++ struct stat tmpstatbuf;
++
++ /* .../archname/version if -d .../archname/auto */
++ sv_setsv(subdir, libdir);
++ sv_catpv(subdir, archpat_auto);
++ if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
++ S_ISDIR(tmpstatbuf.st_mode))
++ av_push(GvAVn(incgv),
++ newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
++
++ /* .../archname/version if -d .../archname/version/auto */
++ sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
++ strlen(patchlevel) + 1, "", 0);
++ if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
++ S_ISDIR(tmpstatbuf.st_mode))
++ av_push(GvAVn(incgv),
++ newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
++ }
++
++ /* finally push this lib directory on the end of @INC */
++ av_push(GvAVn(incgv), libdir);
++ }
++
++ SvREFCNT_dec(subdir);
}
void
break;
case 53:
#line 280 "perly.y"
--{ yyval.ival = start_subparse(0); }
++{ yyval.ival = start_subparse(FALSE, 0); }
break;
case 54:
#line 284 "perly.y"
--{ yyval.ival = start_subparse(CVf_ANON); }
++{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
break;
case 55:
#line 288 "perly.y"
--{ yyval.ival = start_subparse(CVf_FORMAT); }
++{ yyval.ival = start_subparse(TRUE, 0); }
break;
case 56:
#line 291 "perly.y"
;
startsub: /* NULL */ /* start a regular subroutine scope */
-- { $$ = start_subparse(0); }
++ { $$ = start_subparse(FALSE, 0); }
;
startanonsub: /* NULL */ /* start an anonymous subroutine scope */
-- { $$ = start_subparse(CVf_ANON); }
++ { $$ = start_subparse(FALSE, CVf_ANON); }
;
startformsub: /* NULL */ /* start a format subroutine scope */
-- { $$ = start_subparse(CVf_FORMAT); }
++ { $$ = start_subparse(TRUE, 0); }
;
subname : WORD { char *name = SvPVx(((SVOP*)$1)->op_sv, na);
*/
#define BIN "/_P9P_OBJTYPE/bin" /* */
++/* BINCOMPAT3:
++ * This symbol, if defined, indicates that Perl 5.004 should be
++ * binary-compatible with Perl 5.003.
++ */
++#undef BINCOMPAT3 /**/
++
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
* the C preprocessor on the standard input and produce to standard
*/
#undef HAS_GETPRIORITY /**/
++/* HAS_GETTIMEOFDAY:
++ * This symbol, if defined, indicates that the gettimeofday() system
++ * call is available for a sub-second accuracy clock. Usually, the file
++ * <sys/resource.h> needs to be included (see I_SYS_RESOURCE).
++ * The type "Timeval" should be used to refer to "struct timeval".
++ */
++#define HAS_GETTIMEOFDAY /**/
++#define Timeval struct timeval /* Structure used by gettimeofday() */ /* config-skip */
++
/* HAS_HTONL:
* This symbol, if defined, indicates that the htonl() routine (and
* friends htons() ntohl() ntohs()) are available to do network
#define HAS_NTOHS /**/
++/* HAS_INET_ATON:
++ * This symbol, if defined, indicates to the C program that the
++ * inet_aton() function is available to parse IP address "dotted-quad"
++ * strings.
++ */
++#undef HAS_INET_ATON /**/
++
/* HAS_ISASCII:
* This manifest constant lets the C program know that isascii
* is available.
*/
#define HAS_READDIR /**/
++/* HAS_SANE_MEMCMP:
++ * This symbol, if defined, indicates that the memcmp routine is available
++ * and can be used to compare relative magnitudes of chars with their high
++ * bits set. If it is not defined, roll your own version.
++ */
++#define HAS_SANE_MEMCMP /**/
++
/* HAS_SEEKDIR:
* This symbol, if defined, indicates that the seekdir routine is
* available. You may have to include <dirent.h>. See I_DIRENT.
#define HAS_SOCKET /**/
#define HAS_SOCKETPAIR /**/
++/* HAS_STRTOD:
++ * This symbol, if defined, indicates that the strtod routine is
++ * available to provide better numeric string conversion than atof().
++ */
++#define HAS_STRTOD /**/
++
++/* HAS_STRTOL:
++ * This symbol, if defined, indicates that the strtol routine is available
++ * to provide better numeric string conversion than atoi() and friends.
++ */
++#define HAS_STRTOL /**/
++
++/* HAS_STRTOUL:
++ * This symbol, if defined, indicates that the strtoul routine is
++ * available to provide conversion of strings to unsigned long.
++ */
++#define HAS_STRTOUL /**/
++
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
#endif
--/* FILE_filbuf:
-- * This macro is used to access the internal stdio _filbuf function
-- * (or equivalent), if STDIO_CNT_LVALUE and STDIO_PTR_LVALUE
-- * are defined. It is typically either _filbuf or __filbuf.
-- * This macro will only be defined if both STDIO_CNT_LVALUE and
-- * STDIO_PTR_LVALUE are defined.
-- */
--#undef FILE_filbuf
--
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching. If not, try the
#define ARCHLIB_EXP "/_P9P_OBJTYPE/lib/perl/_P9P_VERSION"
#define ARCHLIB "/_P9P_OBJTYPE/lib/perl/_P9P_VERSION"
++/* ARCHNAME:
++ * This symbol holds a string representing the architecture name.
++ * It may be used to construct an architecture-dependant pathname
++ * where library files may be held under a private library, for
++ * instance.
++ */
++#define ARCHNAME "plan9__P9P_OBJTYPE" /**/
++
/* BYTEORDER:
* This symbol hold the hexadecimal constant defined in byteorder,
* i.e. 0x1234 or 0x4321, etc...
perlpods = $libpods
--extensions = IO Socket Opcode DynaLoader Fcntl FileHandle POSIX
--ext_xs = IO.xs Socket.xs Opcode.xs dl_none.xs Fcntl.xs FileHandle.xs POSIX.xs
++extensions = IO Socket Opcode DynaLoader Fcntl POSIX
++ext_xs = IO.xs Socket.xs Opcode.xs dl_none.xs Fcntl.xs POSIX.xs
ext_c = ${ext_xs:%.xs=%.c}
ext_obj = ${ext_xs:%.xs=%.$O}
./miniperl $privlib/ExtUtils/xsubpp -noprototypes -typemap $privlib/ExtUtils/typemap ext/Fcntl/Fcntl.xs > $target
cp ext/Fcntl/Fcntl.pm $privlib
--FileHandle.c: miniperl ext/FileHandle/FileHandle.xs
-- ./miniperl $privlib/ExtUtils/xsubpp -noprototypes -typemap $privlib/ExtUtils/typemap ext/FileHandle/FileHandle.xs > $target
-- cp ext/FileHandle/FileHandle.pm $privlib
--
POSIX.c: miniperl ext/POSIX/POSIX.xs
./miniperl $privlib/ExtUtils/xsubpp -noprototypes -typemap $privlib/ExtUtils/typemap ext/POSIX/POSIX.xs > $target
cp ext/POSIX/POSIX.pm $privlib
POD = \
perl.pod \
-- perlnews.pod \
++ perldelta.pod \
perldata.pod \
perlsyn.pod \
perlop.pod \
MAN = \
perl.man \
-- perlnews.man \
++ perldelta.man \
perldata.man \
perlsyn.man \
perlop.man \
HTML = \
perl.html \
-- perlnews.html \
++ perldelta.html \
perldata.html \
perlsyn.html \
perlop.html \
TEX = \
perl.tex \
-- perlnews.tex \
++ perldelta.tex \
perldata.tex \
perlsyn.tex \
perlop.tex \
sub output ($);
@pods = qw(
-- perl perlnews perldata perlsyn perlop perlre perlrun perlfunc
++ perl perldelta perldata perlsyn perlop perlre perlrun perlfunc
perlvar perlsub perlmod perlform perllocale perlref perldsc
perllol perltoot perlobj perltie perlbot perlipc perldebug
-- perldiag perlsec perltrap perlstyle perlpod perlbook
-- perlembed perlapio perlxs perlxstut perlguts perlcall
++ perldiag perlsec perltrap perlstyle perlpod perlbook perlembed
++ perlapio perlxs perlxstut perlguts perlcall
);
for (@pods) { s/$/.pod/ }
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
of sections:
perl Perl overview (this section)
-- perlnews Perl news about changes from previous version
++ perldelta Perl changes since previous version
perldata Perl data structures
perlsyn Perl syntax
statement, descending into subroutine calls. If an expression is
supplied that includes function calls, it too will be single-stepped.
- =item n
+ =item n [expr]
Next. Executes over subroutine calls, until it reaches the beginning
- of the next statement.
-of the next statement. If an expression is
-supplied that includes function calls, it too will be executed with
-stops before each statement.
++of the next statement. If an expression is supplied that includes
++function calls, those functions will be executed with stops before
++each statement.
=item E<lt>CRE<gt>
=item l min-max
- List lines C<min> through C<max>.
-List lines C<min> through C<max>. C<l -> is synonymous to C<->.
++List lines C<min> through C<max>. C<l -> is synonymous to C<->.
=item l line
=item f filename
- Switch to viewing a different file.
-Switch to viewing a different file or eval statement. If C<filename>
++Switch to viewing a different file or eval statement. If C<filename>
+ is not a full filename as found in values of %INC, it is considered as
+ a regexp.
=item /pattern/
=item b load filename
- Set breakpoint at the first executed line of the file.
-Set breakpoint at the first executed line of the file. Filename should
++Set breakpoint at the first executed line of the file. Filename should
+ be a full name as found in values of %INC.
+
+ =item b compile subname
+
+ Sets breakpoint at the first statement executed after the subroutine
+ is compiled.
=item d [line]
Run Tk while prompting (with ReadLine).
- =item signalLevel, warnLevel, dieLevel
+ =item C<signalLevel>, C<warnLevel>, C<dieLevel>
+
-Level of verbosity. By default the debugger is in a sane verbose mode,
++Level of verbosity. By default the debugger is in a sane verbose mode,
+ thus it will print backtraces on all the warnings and die-messages
+ which are going to be printed out, and will print a message when
+ interesting uncaught signals arrive.
- Level of verbosity.
-To disable this behaviour, set these values to 0. If C<dieLevel> is 2,
++To disable this behaviour, set these values to 0. If C<dieLevel> is 2,
+ then the messages which will be caught by surrounding C<eval> are also
+ printed.
- =item AutoTrace
+ =item C<AutoTrace>
- Where to print all the breakable points in the executed program
-
(similar to C<t> command, but can be put into C<PERLDB_OPTS>).
+ Trace mode (similar to C<t> command, but can be put into
+ C<PERLDB_OPTS>).
- =item LineInfo
+ =item C<LineInfo>
- File or pipe to print line number info to. If it is a
- pipe, then a short, "emacs like" message is used.
+ File or pipe to print line number info to. If it is a pipe (say,
+ C<|visual_perl_db>), then a short, "emacs like" message is used.
=item C<inhibit_exit>
on exit may be useful if inter(di)spersed with other messages.)
If C<frame & 4>, arguments to functions are printed as well as the
- context and caller info.
-context and caller info. If C<frame & 8>, overloaded C<stringify> and
-C<tie>d C<FETCH> are enabled on the printed arguments. The length at
++context and caller info. If C<frame & 8>, overloaded C<stringify> and
++C<tie>d C<FETCH> are enabled on the printed arguments. The length at
+ which the argument list is truncated is governed by the next option:
+
+ =item C<maxTraceLen>
+
+ length at which the argument list is truncated when C<frame> option's
+ bit 4 is set.
=back
Print only first N elements ('' for all).
- =item compactDump, veryCompact
+ =item C<compactDump>, C<veryCompact>
- Change style of array and hash dump.
-Change style of array and hash dump. If C<compactDump>, short array
++Change style of array and hash dump. If C<compactDump>, short array
+ may be printed on one line.
- =item globPrint
+ =item C<globPrint>
Whether to print contents of globs.
Dump symbol tables of packages.
- =item quote, HighBit, undefPrint
+ =item C<quote>, C<HighBit>, C<undefPrint>
+
-Change style of string dump. Default value of C<quote> is C<auto>, one
++Change style of string dump. Default value of C<quote> is C<auto>, one
+ can enable either double-quotish dump, or single-quotish by setting it
-to C<"> or C<'>. By default, characters with high bit set are printed
++to C<"> or C<'>. By default, characters with high bit set are printed
+ I<as is>.
+
+ =item C<UsageOnly>
- Change style of string dump.
-I<very> rudimentally per-package memory usage dump. Calculates total
++I<very> rudimentally per-package memory usage dump. Calculates total
+ size of strings in variables in the package.
=back
The TTY to use for debugging I/O.
- =item noTTY
-
- If set, goes in C<NonStop> mode. On interrupt if TTY is not set uses the
- value of C<noTTY> or "/tmp/perldbtty$$" to find TTY using
- C<Term::Rendezvous>. Current variant is to have the name of TTY in this
- file.
-
=item C<noTTY>
--If set, goes in C<NonStop> mode, and would not connect to a TTY. If
++If set, goes in C<NonStop> mode, and would not connect to a TTY. If
interrupt (or if control goes to debugger via explicit setting of
$DB::signal or $DB::single from the Perl script), connects to a TTY
specified by the C<TTY> option at startup, or to a TTY found at
This module should implement a method C<new> which returns an object
with two methods: C<IN> and C<OUT>, returning two filehandles to use
--for debugging input and output correspondingly. Method C<new> may
++for debugging input and output correspondingly. Method C<new> may
inspect an argument which is a value of C<$ENV{PERLDB_NOTTY}> at
startup, or is C<"/tmp/perldbtty$$"> otherwise.
will run the script C<myprogram> without human intervention, printing
out the call tree with entry and exit points. Note that C<N f=2> is
--equivalent to C<NonStop=1 frame=2>. Note also that at the moment when
++equivalent to C<NonStop=1 frame=2>. Note also that at the moment when
this documentation was written all the options to the debugger could
be uniquely abbreviated by the first letter (with exception of
C<Dump*> options).
"interactive"!)
- $ env "PERLDB_OPTS=R=0 TTY=/dev/ttyc" perl -d myprogram
+ $ env "PERLDB_OPTS=R=0 TTY=/dev/ttyc" perl -d myprogram
may be useful for debugging a program which uses C<Term::ReadLine>
--itself. Do not forget detach shell from the TTY in the window which
++itself. Do not forget detach shell from the TTY in the window which
corresponds to F</dev/ttyc>, say, by issuing a command like
- $ sleep 1000000
+ $ sleep 1000000
See L<"Debugger Internals"> below for more details.
to exit the debugger, though typing C<exit> twice may do it too.
Set an C<O>ption C<inhibit_exit> to 0 if you want to be able to I<step
--off> the end the script. You may also need to set C<$finished> to 0 at
++off> the end the script. You may also need to set C<$finished> to 0 at
some moment if you want to step through global destruction.
=item R
command. The C<$DB::trace> variable should be set to 1 to simulate
having typed the C<t> command.
-and restart debugger by C<R> command (if possible). One can use C<b
+ Another way to debug compile-time code is to start debugger, set a
+ breakpoint on I<load> of some module thusly
+
+ DB<7> b load f:/perllib/lib/Carp.pm
+ Will stop on load of `f:/perllib/lib/Carp.pm'.
+
++and restart debugger by C<R> command (if possible). One can use C<b
+ compile subname> for the same purpose.
+
=head2 Debugger Customization
Most probably you not want to modify the debugger, it contains enough
--hooks to satisfy most needs. You may change the behaviour of debugger
++hooks to satisfy most needs. You may change the behaviour of debugger
from the debugger itself, using C<O>ptions, from the command line via
C<PERLDB_OPTS> environment variable, and from I<customization files>.
parse_options("NonStop=1 LineInfo=db.out AutoTrace=1 frame=2");
--(the code is executed in the package C<DB>). Note that F<.perldb> is
--processed before processing C<PERLDB_OPTS>. If F<.perldb> defines the
++(the code is executed in the package C<DB>). Note that F<.perldb> is
++processed before processing C<PERLDB_OPTS>. If F<.perldb> defines the
subroutine C<afterinit>, it is called after all the debugger
--initialization ends. F<.perldb> may be contained in the current
++initialization ends. F<.perldb> may be contained in the current
directory, or in the C<LOGDIR>/C<HOME> directory.
If you want to modify the debugger, copy F<perl5db.pl> from the Perl
=item *
The array C<@{"_<$filename"}> is the line-by-line contents of
--$filename for all the compiled files. Same for C<eval>ed strings which
--contain subroutines, or which are currently executed. The C<$filename>
++$filename for all the compiled files. Same for C<eval>ed strings which
++contain subroutines, or which are currently executed. The C<$filename>
for C<eval>ed strings looks like C<(eval 34)>.
=item *
The hash C<%{"_<$filename"}> contains breakpoints and action (it is
keyed by line number), and individual entries are settable (as opposed
--to the whole hash). Only true/false is important to Perl, though the
++to the whole hash). Only true/false is important to Perl, though the
values used by F<perl5db.pl> have the form
--C<"$break_condition\0$action">. Values are magical in numeric context:
++C<"$break_condition\0$action">. Values are magical in numeric context:
they are zeros if the line is not breakable.
Same for evaluated strings which contain subroutines, or which are
--currently executed. The C<$filename> for C<eval>ed strings looks like
++currently executed. The C<$filename> for C<eval>ed strings looks like
C<(eval 34)>.
=item *
--The scalar C<${"_<$filename"}> contains C<"_<$filename">. Same for
++The scalar C<${"_<$filename"}> contains C<"_<$filename">. Same for
evaluated strings which contain subroutines, or which are currently
--executed. The C<$filename> for C<eval>ed strings looks like C<(eval
++executed. The C<$filename> for C<eval>ed strings looks like C<(eval
34)>.
=item *
After each C<require>d file is compiled, but before it is executed,
C<DB::postponed(*{"_<$filename"})> is called (if subroutine
--C<DB::postponed> exists). Here the $filename is the expanded name of
++C<DB::postponed> exists). Here the $filename is the expanded name of
the C<require>d file (as found in values of C<%INC>).
=item *
After each subroutine C<subname> is compiled existence of
--C<$DB::postponed{subname}> is checked. If this key exists,
++C<$DB::postponed{subname}> is checked. If this key exists,
C<DB::postponed(subname)> is called (if subroutine C<DB::postponed>
exists).
=item *
A hash C<%DB::sub> is maintained, with keys being subroutine names,
--values having the form C<filename:startline-endline>. C<filename> has
++values having the form C<filename:startline-endline>. C<filename> has
the form C<(eval 31)> for subroutines defined inside C<eval>s.
=item *
=back
Note that no subroutine call is possible until C<&DB::sub> is defined
- (for subroutines outside of package C<DB>). (In fact, for the
- standard debugger the same is true if C<$DB::deep> (how many levels of
- recursion deep into the debugger you can go before a mandatory break)
- is not defined.)
+ (for subroutines outside of package C<DB>). (This restriction is
+ recently lifted.)
+
+ (In fact, for the standard debugger the same is true if C<$DB::deep>
+ (how many levels of recursion deep into the debugger you can go before
+ a mandatory break) is not defined.)
+
+ With the recent updates the minimal possible debugger consists of one
+ line
+
+ sub DB::DB {}
+
+ which is quite handy as contents of C<PERL5DB> environment
+ variable:
+
+ env "PERL5DB=sub DB::DB {}" perl -d your-script
+
+ Another (a little bit more useful) minimal debugger can be created
+ with the only line being
+
+ sub DB::DB {print ++$i; scalar <STDIN>}
+
+ This debugger would print the sequential number of encountered
+ statement, and would wait for your C<CR> to continue.
+
+ The following debugger is quite functional:
+
+ {
+ package DB;
+ sub DB {}
+ sub sub {print ++$i, " $sub\n"; &$sub}
+ }
+
+ It prints the sequential number of subroutine call and the name of the
-called subroutine. Note that C<&DB::sub> should be compiled into the
++called subroutine. Note that C<&DB::sub> should be compiled into the
+ package C<DB>.
=head2 Debugger Internals
It also maintains magical internal variables, such as C<@DB::dbline>,
C<%DB::dbline>, which are aliases for C<@{"::_<current_file"}>
--C<%{"::_<current_file"}>. Here C<current_file> is the currently
++C<%{"::_<current_file"}>. Here C<current_file> is the currently
selected (with the debugger's C<f> command, or by flow of execution)
file.
--Some functions are provided to simplify customization. See L<"Debugger
--Customization"> for description of C<DB::parse_options(string)>. The
++Some functions are provided to simplify customization. See L<"Debugger
++Customization"> for description of C<DB::parse_options(string)>. The
function C<DB::dump_trace(skip[, count])> skips the specified number
of frames, and returns an array containing info about the caller
--frames (all if C<count> is missing). Each entry is a hash with keys
++frames (all if C<count> is missing). Each entry is a hash with keys
C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about
eval), C<args> (C<undef> or a reference to an array), C<file>, and
C<line>.
The function C<DB::print_trace(FH, skip[, count[, short]])> prints
--formatted info about caller frames. The last two functions may be
++formatted info about caller frames. The last two functions may be
convenient as arguments to C<E<lt>>, C<E<lt>E<lt>> commands.
=head2 Other resources
=head1 NAME
--perlnews - what's new for perl5.004
++perldelta - what's new for perl5.004
=head1 DESCRIPTION
binary compatibility with Perl 5.003. If you choose binary
compatibility, you do not have to recompile your extensions, but you
might have symbol conflicts if you embed Perl in another application,
--just as in the 5.003 release.
++just as in the 5.003 release. By default, binary compatibility
++is preserved at the expense of symbol table pollution.
=head2 New Opcode Module and Revised Safe Module
and is implemented using the new Opcode module. Please read the new
Opcode and Safe documentation.
++=head2 Extended Fcntl Module
++
++The Fcntl module now supports these new constants
++
++ F_GETOWN F_SETOWN
++ O_ASYNC O_DEFER O_DSYNC O_RSYNC O_SYNC
++ O_EXLOCK O_SHLOCK
++
++provided that your operating system supports these constants. The
++constants are for use with the Perl sysopen() and fcntl(). These
++constants are also visible for the basic database modules like the
++SDBM_File. For the exact meaning of these contants and other Fcntl
++constants please refer to the fcntl() documentation of your operating
++system. Unsupported constants will cause run-time errors.
++
=head2 Internal Change: FileHandle Deprecated
Filehandles are now stored internally as type IO::Handle.
Although C<use FileHandle> and C<*STDOUT{FILEHANDLE}>
--are still supported for backwards compatibility
++are still supported for backwards compatibility,
C<use IO::Handle> (or C<IO::Seekable> or C<IO::File>) and
C<*STDOUT{IO}> are the way of the future.
$^M = 'a' x (1<<16);
--would allocate 64K buffer for use when in emergency.
++would allocate a 64K buffer for use when in emergency.
See the F<INSTALL> file for information on how to enable this option.
As a disincentive to casual use of this advanced feature,
there is no C<use English> long name for this variable.
print $line;
}
-- if ((my $answer = <STDIN>) =~ /^yes$/i) {
++ if ((my $answer = <STDIN>) =~ /^y(es)?$/i) {
user_agrees();
-- } elsif ($answer =~ /^no$/i) {
++ } elsif ($answer =~ /^n(o)?$/i) {
user_disagrees();
} else {
chomp $answer;
-- die "'$answer' is neither 'yes' nor 'no'";
++ die "`$answer' is neither `yes' nor `no'";
}
Also, you can declare a foreach loop control variable as lexical by
If the first argument to C<use> is a number, it is treated as a version
number instead of a module name. If the version of the Perl interpreter
is less than VERSION, then an error message is printed and Perl exits
--immediately. This is often useful if you need to check the current
--Perl version before C<use>ing library modules which have changed in
--incompatible ways from older versions of Perl. (We try not to do
--this more than we have to.)
++immediately. Because C<use> occurs at compile time, this check happens
++immediately during the compilation process, unlike C<require VERSION>,
++which waits until run-time for the check. This is often useful if you
++need to check the current Perl version before C<use>ing library modules
++which have changed in incompatible ways from older versions of Perl.
++(We try not to do this more than we have to.)
=item use Module VERSION LIST
Functions documented in the Camel to default to $_ now in
fact do, and all those that do are so documented in L<perlfunc>.
--=head2 C<m//g> does not trigger a pos() reset on failure
++=item C<m//g> does not trigger a pos() reset on failure
The C<m//g> match iteration construct used to reset the iteration
when it failed to match (so that the next C<m//g> match would start at
matches together in conjunction with ordinary matches using the C<\G>
zero-width assertion. See L<perlop> and L<perlre>.
++=item nested C<sub{}> closures work now
++
++Prior to the 5.004 release, nested anonymous functions
++didn't work right. They do now.
++
++=item formats work right on changing lexicals
++
++Just like anonymous functions that contain lexical variables
++that change (like a lexical index variable for a C<foreach> loop),
++formats now work properly. For example, this silently failed
++before, and is fine now:
++
++ my $i;
++ foreach $i ( 1 .. 10 ) {
++ format =
++ my i is @#
++ $i
++ .
++ write;
++ }
++
=back
=head2 New Built-in Methods
$ref = bless [], 'A';
$ref->is_instance(); # True
++This can be useful for methods that wish to easily distinguish
++whether they were invoked as class or as instance methods.
++
++ sub some_meth {
++ my $classname = shift;
++ if ($classname->is_instance()) {
++ die "unexpectedly called as instance not class method";
++ }
++ .....
++ }
++
=back
B<NOTE:> C<can> directly uses Perl's internal code for method lookup, and
--C<isa> uses a very similar method and cache-ing strategy. This may cause
++C<isa> uses a very similar method and caching strategy. This may cause
strange effects if the Perl code dynamically changes @ISA in any package.
You may add other methods to the UNIVERSAL class via Perl or XS code.
=head2 TIEHANDLE Now Supported
++See L<perltie> for other kinds of tie()s.
++
=over
=item TIEHANDLE classname, LIST
return an object of some sort. The reference can be used to
hold some internal information.
-- sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
++ sub TIEHANDLE {
++ print "<shout>\n";
++ my $i;
++ return bless \$i, shift;
++ }
=item PRINT this, LIST
Beyond its self reference it also expects the list that was passed to
the print function.
-- sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
++ sub PRINT {
++ $r = shift;
++ $$r++;
++ return print join( $, => map {uc} @_), $\;
++ }
=item READLINE this
This method will be called when the handle is read from. The method
should return undef when there is no more data.
-- sub READLINE { $r = shift; "PRINT called $$r times\n"; }
++ sub READLINE {
++ $r = shift;
++ return "PRINT called $$r times\n";
++ }
=item DESTROY this
tied handle is about to be destroyed. This is useful for debugging and
possibly for cleaning up.
-- sub DESTROY { print "</shout>\n" }
++ sub DESTROY {
++ print "</shout>\n";
++ }
=back
++=item Efficiency Enhancements
++
++All hash keys with the same string are only allocated once, so
++even if you have 100 copies of the same hash, the immutable keys
++never have to be re-allocated.
++
++Functions that have an empty prototype and that do nothing but return
++a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>).
++
=head1 Pragmata
Three new pragmatic modules exist:
=item use blib
++=item use blib 'dir'
++
Looks for MakeMaker-like I<'blib'> directory structure starting in
I<dir> (or current directory) and working back up to five levels of
parent directories.
=head1 Modules
++=head2 Fcntl
++
++New constants in the existing Fcntl modules are now supported,
++provided that your operating system happens to support them:
++
++ F_GETOWN F_SETOWN
++ O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC
++ O_EXLOCK O_SHLOCK
++
=head2 Module Information Summary
--Brand new modules:
++Brand new modules, arranged by topic rather than strictly
++alphabetically:
++
++ CPAN interface to Comprehensive Perl Archive Network
++ CPAN::FirstTime create a CPAN configuration file
++ CPAN::Nox run CPAN while avoiding compiled extensions
IO.pm Top-level interface to IO::* classes
IO/File.pm IO::File extension Perl module
User/grent.pm Object-oriented wrapper around CORE::getgr*
User/pwent.pm Object-oriented wrapper around CORE::getpw*
-- lib/Tie/RefHash.pm Base class for tied hashes with references as keys
++ Tie/RefHash.pm Base class for tied hashes with references as keys
UNIVERSAL.pm Base class for *ALL* classes
use User::pwent;
$his = (stat($filename)->st_uid == pwent($whoever)->pw_uid);
--=head1 Efficiency Enhancements
++=head1 Utility Changes
--All hash keys with the same string are only allocated once, so
--even if you have 100 copies of the same hash, the immutable keys
--never have to be re-allocated.
++=head2 xsubpp
--Functions that have an empty prototype and that do nothing but return
--a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>).
++=item C<void> XSUBs now default to returning nothing
++
++Due to a documentation/implementation bug in previous versions of
++Perl, XSUBs with a return type of C<void> have actually been
++returning one value. Usually that value was the GV for the XSUB,
++but sometimes it was some already freed or reused value, which would
++sometimes lead to program failure.
++
++In Perl 5.004, if an XSUB is declared as returning C<void>, it
++actually returns no value, i.e. an empty list (though there is a
++backward-compatibility exception; see below). If your XSUB really
++does return an SV, you should give it a return type of C<SV *>.
++
++For backward compatibility, I<xsubpp> tries to guess whether a
++C<void> XSUB is really C<void> or if it wants to return an C<SV *>.
++It does so by examining the text of the XSUB: if I<xsubpp> finds
++what looks like an assignment to C<ST(0)>, it assumes that the
++XSUB's return type is really C<SV *>.
=head1 Documentation Changes
=over 4
--=item L<perlnews>
++=item L<perldelta>
This document.
Several new conditions will trigger warnings that were
silent before. Some only affect certain platforms.
--The following new warnings and errors
--outline these:
++The following new warnings and errors outline these.
++These messages are classified as follows (listed in
++increasing order of desperation):
++
++ (W) A warning (optional).
++ (D) A deprecation (optional).
++ (S) A severe warning (mandatory).
++ (F) A fatal error (trappable).
++ (P) An internal error you should never see (trappable).
++ (X) A very fatal error (non-trappable).
++ (A) An alien error message (not generated by Perl).
=over 4
until the end of the scope or until all closure referents to it are
destroyed.
++=item %s argument is not a HASH element or slice
++
++(F) The argument to delete() must be either a hash element, such as
++
++ $foo{$bar}
++ $ref->[12]->{"susie"}
++
++or a hash slice, such as
++
++ @foo{$bar, $baz, $xyzzy}
++ @{$ref->[12]}{"susie", "queue"}
++
=item Allocation too large: %lx
(X) You can't allocate more than 64K on an MSDOS machine.
might directly modify logical name tables and introduce non-standard names,
or it may indicate that a logical name table has been corrupted.
++=item Can't use bareword ("%s") as %s ref while "strict refs" in use
++
++(F) Only hard references are allowed by "strict refs". Symbolic references
++are disallowed. See L<perlref>.
++
++=item Constant subroutine %s redefined
++
++(S) You redefined a subroutine which had previously been eligible for
++inlining. See L<perlsub/"Constant Functions"> for commentary and
++workarounds.
++
++=item Died
++
++(F) You passed die() an empty string (the equivalent of C<die "">) or
++you called it with no args and both C<$@> and C<$_> were empty.
++
=item Integer overflow in hex number
(S) The literal hex number you have specified is too big for your
architecture. On a 32-bit architecture the largest octal literal is
037777777777.
++=item Name "%s::%s" used only once: possible typo
++
++(W) Typographical errors often show up as unique variable names.
++If you had a good reason for having a unique name, then just mention
++it again somehow to suppress the message (the C<use vars> pragma is
++provided for just this purpose).
++
=item Null picture in formline
(F) The first argument to formline must be a valid format picture
The sole exception to this is that C<sysread()>ing past the buffer
will extend the buffer and zero pad the new area.
++=item Stub found while resolving method `%s' overloading `%s' in package `%s'
++
++(P) Overloading resolution over @ISA tree may be broken by importing stubs.
++Stubs should never be implicitely created, but explicit calls to C<can>
++may break this.
++
++=item Cannot resolve method `%s' overloading `%s' in package `s'
++
++(P) Internal error trying to resolve overloading specified by a method
++name (as opposed to a subroutine reference).
++
=item Out of memory!
(X|F) The malloc() function returned 0, indicating there was insufficient
=item Possible attempt to put comments in qw() list
--(W) You probably wrote something like this:
++(W) qw() lists contain items separated by whitespace; as with literal
++strings, comment characters are not ignored, but are instead treated
++as literal data. (You may have used different delimiters than the
++exclamation marks parentheses shown here; braces are also frequently
++used.)
++
++You probably wrote something like this:
-- qw( a # a comment
++ @list = qw(
++ a # a comment
b # another comment
-- ) ;
++ );
when you should have written this:
-- qw( a
++ @list = qw(
++ a
b
-- ) ;
++ );
++
++If you really want comments, build your list the
++old-fashioned way, with quotes and commas:
++
++ @list = (
++ 'a', # a comment
++ 'b', # another comment
++ );
=item Possible attempt to separate words with commas
--(W) You probably wrote something like this:
++(W) qw() lists contain items separated by whitespace; therefore commas
++aren't needed to separate the items. (You may have used different
++delimiters than the parentheses shown here; braces are also frequently
++used.)
-- qw( a, b, c );
++You probably wrote something like this:
--when you should have written this:
++ qw! a, b, c !;
++
++which puts literal commas into some of the list items. Write it without
++commas if you don't want them to appear in your data:
++
++ qw! a b c !;
-- qw( a b c );
++=item Scalar value @%s{%s} better written as $%s{%s}
++
++(W) You've used a hash slice (indicated by @) to select a single element of
++a hash. Generally it's better to ask for a scalar value (indicated by $).
++The difference is that C<$foo{&bar}> always behaves like a scalar, both when
++assigning to it and when evaluating its argument, while C<@foo{&bar}> behaves
++like a list when you assign to it, and provides a list context to its
++subscript, which can do weird things if you're expecting only one subscript.
=item untie attempted while %d inner references still exist
(W) A copy of the object returned from C<tie> (or C<tied>) was still
valid when C<untie> was called.
--=item Got an error from DosAllocMem:
++=item Value of %s construct can be "0"; test with defined()
++
++(W) In a conditional expression, you used <HANDLE>, <*> (glob), or
++C<readdir> as a boolean value. Each of these constructs can return a
++value of "0"; that would make the conditional expression false, which
++is probably not what you intended. When using these constructs in
++conditional expressions, test their values with the C<defined> operator.
++
++=item Variable "%s" may be unavailable
++
++(W) An inner (nested) I<anonymous> subroutine is inside a I<named>
++subroutine, and outside that is another subroutine; and the anonymous
++(innermost) subroutine is referencing a lexical variable defined in
++the outermost subroutine. For example:
++
++ sub outermost { my $a; sub middle { sub { $a } } }
++
++If the anonymous subroutine is called or referenced (directly or
++indirectly) from the outermost subroutine, it will share the variable
++as you would expect. But if the anonymous subroutine is called or
++referenced when the outermost subroutine is not active, it will see
++the value of the shared variable as it was before and during the
++*first* call to the outermost subroutine, which is probably not what
++you want.
++
++In these circumstances, it is usually best to make the middle
++subroutine anonymous, using the C<sub {}> syntax. Perl has specific
++support for shared variables in nested anonymous subroutines; a named
++subroutine in between interferes with this feature.
++
++=item Variable "%s" will not stay shared
++
++(W) An inner (nested) I<named> subroutine is referencing a lexical
++variable defined in an outer subroutine.
++
++When the inner subroutine is called, it will probably see the value of
++the outer subroutine's variable as it was before and during the
++*first* call to the outer subroutine; in this case, after the first
++call to the outer subroutine is complete, the inner and outer
++subroutines will no longer share a common value for the variable. In
++other words, the variable will no longer be shared.
++
++Furthermore, if the outer subroutine is anonymous and references a
++lexical variable outside itself, then the outer and inner subroutines
++will I<never> share the given variable.
++
++This problem can usually be solved by making the inner subroutine
++anonymous, using the C<sub {}> syntax. When inner anonymous subs that
++reference variables in outer subroutines are called or referenced,
++they are automatically re-bound to the current values of such
++variables.
++
++=item Warning: something's wrong
++
++(W) You passed warn() an empty string (the equivalent of C<warn "">) or
++you called it with no args and C<$_> was empty.
++
++=item Got an error from DosAllocMem
--(P) An error peculiar to OS/2. Most probably you use an obsolete version
--of Perl, and should not happen anyway.
++(P) An error peculiar to OS/2. Most probably you're using an obsolete
++version of Perl, and this should not happen anyway.
=item Malformed PERLLIB_PREFIX
=head1 BUGS
--If you find what you think is a bug, you might check the headers
--of recently posted articles
--in the comp.lang.perl.misc newsgroup. There may also be
--information at http://www.perl.com/perl/, the Perl Home Page.
++If you find what you think is a bug, you might check the headers of
++recently posted articles in the comp.lang.perl.misc newsgroup.
++There may also be information at http://www.perl.com/perl/, the Perl
++Home Page.
If you believe you have an unreported bug, please run the B<perlbug>
program included with your release. Make sure you trim your bug
=item Possible attempt to put comments in qw() list
--(W) You probably wrote something like this:
++(W) qw() lists contain items separated by whitespace; as with literal
++strings, comment characters are not ignored, but are instead treated
++as literal data. (You may have used different delimiters than the
++exclamation marks parentheses shown here; braces are also frequently
++used.)
-- qw( a # a comment
++You probably wrote something like this:
++
++ @list = qw(
++ a # a comment
b # another comment
-- ) ;
++ );
when you should have written this:
-- qw( a
++ @list = qw(
++ a
b
-- ) ;
++ );
++
++If you really want comments, build your list the
++old-fashioned way, with quotes and commas:
++
++ @list = (
++ 'a', # a comment
++ 'b', # another comment
++ );
=item Possible attempt to separate words with commas
--(W) You probably wrote something like this:
++(W) qw() lists contain items separated by whitespace; therefore commas
++aren't needed to separate the items. (You may have used different
++delimiters than the parentheses shown here; braces are also frequently
++used.)
-- qw( a, b, c );
++You probably wrote something like this:
--when you should have written this:
++ qw! a, b, c !;
++
++which puts literal commas into some of the list items. Write it without
++commas if you don't want them to appear in your data:
-- qw( a b c );
++ qw! a b c !;
=item Possible memory corruption: %s overflowed 3rd argument
}
close OUT;
--=item Got an error from DosAllocMem:
++=item Got an error from DosAllocMem
--(P) An error peculiar to OS/2. Most probably you use an obsolete version
--of perl, and this should not happen anyway.
++(P) An error peculiar to OS/2. Most probably you're using an obsolete
++version of Perl, and this should not happen anyway.
=item Malformed PERLLIB_PREFIX
% perl -MExtUtils::Embed -e xsinit -o perlxsi.c
% cc -c perlxsi.c `perl -MExtUtils::Embed -e ccopts`
% cc -c interp.c `perl -MExtUtils::Embed -e ccopts`
-- % cc -o interp perlxsi.o interp.o `perl -MExtUtils::Embed -e ldopts`
++ % cc -o interp perlxsi.o interp.o \
++ `perl -MExtUtils::Embed -e ccdlflags -e ldopts`
Consult L<perlxs> and L<perlguts> for more details.
See also exit() and warn().
++You can arrange for a callback to be called just before the die() does
++its deed, by setting the C<$SIG{__DIE__}> hook. The associated handler
++will be called with the error text and can change the error message, if
++it sees fit, by calling die() again. See L<perlvar> for details on
++setting C<%SIG> entries, and eval() for some examples.
++
=item do BLOCK
Not really a function. Returns the value of the last command in the
If there is a syntax error or runtime error, or a die() statement is
executed, an undefined value is returned by eval(), and C<$@> is set to the
error message. If there was no error, C<$@> is guaranteed to be a null
--string. If EXPR is omitted, evaluates $_. The final semicolon, if
--any, may be omitted from the expression.
++string. If EXPR is omitted, evaluates C<$_>. The final semicolon, if
++any, may be omitted from the expression. Beware that using eval()
++neither silences perl from printing warnings to STDERR, nor does it
++stuff the text of warning messages into C<$@>. To do either of those,
++you have to use the C<$SIG{__WARN__}> facility. See warn() and L<perlvar>.
Note that, because eval() traps otherwise-fatal errors, it is useful for
determining whether a particular feature (such as socket() or symlink())
# a run-time error
eval '$answer ='; # sets $@
++When using the eval{} form as an exception trap in libraries, you may
++wish not to trigger any C<__DIE__> hooks that user code may have
++installed. You can use the C<local $SIG{__DIE__}> construct for this
++purpose, as shown in this example:
++
++ # a very private exception trap for divide-by-zero
++ eval { local $SIG{'__DIE__'}; $answer = $a / $b; }; warn $@ if $@;
++
++This is especially significant, given that C<__DIE__> hooks can call
++die() again, which has the effect of changing their error messages:
++
++ # __DIE__ hooks may modify error messages
++ {
++ local $SIG{'__DIE__'} = sub { (my $x = $_[0]) =~ s/foo/bar/g; die $x };
++ eval { die "foo foofs here" };
++ print $@ if $@; # prints "bar barfs here"
++ }
++
With an eval(), you should be especially careful to remember what's
being looked at when:
size total size of file, in bytes
atime last access time since the epoch
mtime last modify time since the epoch
-- ctime inode change time (NOT creation type!) since the epoch
++ ctime inode change time (NOT creation time!) since the epoch
blksize preferred block size for file system I/O
blocks actual number of blocks allocated
=item warn LIST
--Produces a message on STDERR just like die(), but doesn't exit or
--on an exception.
++Produces a message on STDERR just like die(), but doesn't exit or throw
++an exception.
++
++No message is printed if there is a C<$SIG{__WARN__}> handler
++installed. It is the handler's responsibility to deal with the message
++as it sees fit (like, for instance, converting it into a die()). Most
++handlers must therefore make arrangements to actually display the
++warnings that they are not prepared to deal with, by calling warn()
++again in the handler. Note that this is quite safe and will not
++produce an endless loop, since C<__WARN__> hooks are not called from
++inside one.
++
++You will find this behavior is slightly different from that of
++C<$SIG{__DIE__}> handlers (which don't suppress the error text, but can
++instead call die() again to change it).
++
++Using a C<__WARN__> handler provides a powerful way to silence all
++warnings (even the so-called mandatory ones). An example:
++
++ # wipe out *all* compile-time warnings
++ BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }
++ my $foo = 10;
++ my $foo = 20; # no warning about duplicate my $foo,
++ # but hey, you asked for it!
++ # no compile-time or run-time warnings before here
++ $DOWARN = 1;
++
++ # run-time warnings enabled after here
++ warn "\$foo is alive and $foo!"; # does show up
++
++See L<perlvar> for details on setting C<%SIG> entries, and for more
++examples.
=item write FILEHANDLE
scalar variables that are used before being set. Also warns about
redefined subroutines, and references to undefined filehandles or
filehandles opened read-only that you are attempting to write on. Also
--warns you if you use values as a number that doesn't look like numbers, using
--an array as though it were a scalar, if
--your subroutines recurse more than 100 deep, and innumerable other things.
--See L<perldiag> and L<perltrap>.
++warns you if you use values as a number that doesn't look like numbers,
++using an array as though it were a scalar, if your subroutines recurse
++more than 100 deep, and innumerable other things.
++
++You can disable specific warnings using C<__WARN__> hooks, as described
++in L<perlvar> and L<perlfunc/warn>. See also L<perldiag> and L<perltrap>.
=item B<-x> I<directory>
You probably shouldn't rely upon the warn() being podded out forever.
Not all pod translators are well-behaved in this regard, and perhaps
the compiler will become pickier.
++
++One may also use pod directives to quickly comment out a section
++of code.
++
++=head2 Plain Old Comments (Not!)
++
++Much like the C preprocessor, perl can process line directives. Using
++this, one can control perl's idea of filenames and line numbers in
++error or warning messages (especially for strings that are processed
++with eval()). The syntax for this mechanism is the same as for most
++C preprocessors: it matches the regular expression
++C</^#\s*line\s+(\d+)\s*(?:\s"([^"])*")?/> with C<$1> being the line
++number for the next line, and C<$2> being the optional filename
++(specified within quotes).
++
++Here are some examples that you should be able to type into your command
++shell:
++
++ % perl
++ # line 200 "bzzzt"
++ # the `#' on the previous line must be the first char on line
++ die 'foo';
++ __END__
++ foo at bzzzt line 201.
++
++ % perl
++ # line 200 "bzzzt"
++ eval qq[\n#line 2001 ""\ndie 'foo']; print $@;
++ __END__
++ foo at - line 2001.
++
++ % perl
++ eval qq[\n#line 200 "foo bar"\ndie 'foo']; print $@;
++ __END__
++ foo at foo bar line 200.
++
++ % perl
++ # line 345 "goop"
++ eval "\n#line " . __LINE__ . ' "' . __FILE__ ."\"\ndie 'foo'";
++ print $@;
++ __END__
++ foo at goop line 345.
++
++=cut
=item NOTES
--=head2 perlnews - what's new for perl5.004
++=head2 perldelta - what's new for perl5.004
=item DESCRIPTION
=item New Opcode Module and Revised Safe Module
++=item Extended Fcntl Module
++
=item Internal Change: FileHandle Deprecated
=item Internal Change: PerlIO internal IO abstraction interface
delete on slices, flock, keys as an lvalue, my() in Control Structures,
unpack() and pack(), use VERSION, use Module VERSION LIST,
--prototype(FUNCTION), $_ as Default
--
--=item C<m//g> does not trigger a pos() reset on failure
++prototype(FUNCTION), $_ as Default, C<m//g> does not trigger a pos() reset
++on failure, nested C<sub{}> closures work now, formats work right on
++changing lexicals
=item New Built-in Methods
=item TIEHANDLE Now Supported
--TIEHANDLE classname, LIST, PRINT this, LIST, READLINE this, DESTROY this
++TIEHANDLE classname, LIST, PRINT this, LIST, READLINE this, DESTROY this,
++Efficiency Enhancements
=back
=item Pragmata
--use blib, use locale, use ops
++use blib, use blib 'dir', use locale, use ops
=item Modules
=over
++=item Fcntl
++
=item Module Information Summary
=item IO
=back
--=item Efficiency Enhancements
++=item Utility Changes
++
++=over
++
++=item xsubpp
++
++C<void> XSUBs now default to returning nothing
++
++=back
=item Documentation Changes
--L<perl
news>, L<perllocale>, L<perltoot>, L<perlapio>, L<perldebug>,
++L<perl
delta>, L<perllocale>, L<perltoot>, L<perlapio>, L<perldebug>,
L<perlsec>
=item New Diagnostics
--"my" variable %s masks earlier declaration in same scope, Allocation too
--large: %lx, Allocation too large, Attempt to free non-existent shared
--string, Attempt to use reference as lvalue in substr, Unsupported function
--fork, Ill-formed logical name |%s| in prime_env_iter, Integer overflow in
--hex number, Integer overflow in octal number, Null picture in formline,
--Offset outside string, Out of memory!, Out of memory during request for %s,
--Possible attempt to put comments in qw() list, Possible attempt to separate
--words with commas, untie attempted while %d inner references still exist,
--Got an error from DosAllocMem:, Malformed PERLLIB_PREFIX, PERL_SH_DIR too
--long, Process terminated by SIG%s
++"my" variable %s masks earlier declaration in same scope, %s argument is
++not a HASH element or slice, Allocation too large: %lx, Allocation too
++large, Attempt to free non-existent shared string, Attempt to use reference
++as lvalue in substr, Unsupported function fork, Ill-formed logical name
++|%s| in prime_env_iter, Can't use bareword ("%s") as %s ref while "strict
++refs" in use, Constant subroutine %s redefined, Died, Integer overflow in
++hex number, Integer overflow in octal number, Name "%s::%s" used only once:
++possible typo, Null picture in formline, Offset outside string, Stub found
++while resolving method `%s' overloading `%s' in package `%s', Cannot
++resolve method `%s' overloading `%s' in package `s', Out of memory!, Out of
++memory during request for %s, Possible attempt to put comments in qw()
++list, Possible attempt to separate words with commas, Scalar value @%s{%s}
++better written as $%s{%s}, untie attempted while %d inner references still
++exist, Value of %s construct can be "0"; test with defined(), Variable "%s"
++may be unavailable, Variable "%s" will not stay shared, Warning:
++something's wrong, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX,
++PERL_SH_DIR too long, Process terminated by SIG%s
=item BUGS
=item PODs: Embedded Documentation
++=item Plain Old Comments (Not!)
++
=back
=head2 perlop - Perl operators and precedence
=item Debugger Commands
--h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n,
--E<lt>CRE<gt>, c [line|sub], l, l min+incr, l min-max, l line, l subname, -,
--w [line], f filename, /pattern/, ?pattern?, L, S [[!]pattern], t, t expr, b
--[line] [condition], b subname [condition], b postpone subname [condition],
--b load filename, d [line], D, a [line] command, A, O [opt[=val]] [opt"val"]
--[opt?].., recallCommand, ShellBang, pager, tkRunning, signalLevel,
--warnLevel, dieLevel, AutoTrace, LineInfo, C<inhibit_exit>, C<PrintRet>,
--C<frame>, arrayDepth, hashDepth, compactDump, veryCompact, globPrint,
--DumpDBFiles, DumpPackages, quote, HighBit, undefPrint, C<TTY>, noTTY,
--C<noTTY>, C<ReadLine>, C<NonStop>, E<lt> [ command ], E<lt>E<lt> command,
--E<gt> command, E<gt>E<gt> command, { [ command ], {{ command, ! number, !
---number, ! pattern, !! cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, =
--[alias value], command, p expr
++h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n
++[expr], E<lt>CRE<gt>, c [line|sub], l, l min+incr, l min-max, l line, l
++subname, -, w [line], f filename, /pattern/, ?pattern?, L, S [[!]pattern],
++t, t expr, b [line] [condition], b subname [condition], b postpone subname
++[condition], b load filename, b compile subname, d [line], D, a [line]
++command, A, O [opt[=val]] [opt"val"] [opt?].., C<recallCommand>,
++C<ShellBang>, C<pager>, C<tkRunning>, C<signalLevel>, C<warnLevel>,
++C<dieLevel>, C<AutoTrace>, C<LineInfo>, C<inhibit_exit>, C<PrintRet>,
++C<frame>, C<maxTraceLen>, C<arrayDepth>, C<hashDepth>, C<compactDump>,
++C<veryCompact>, C<globPrint>, C<DumpDBFiles>, C<DumpPackages>, C<quote>,
++C<HighBit>, C<undefPrint>, C<UsageOnly>, C<TTY>, C<noTTY>, C<ReadLine>,
++C<NonStop>, E<lt> [ command ], E<lt>E<lt> command, E<gt> command,
++E<gt>E<gt> command, { [ command ], {{ command, ! number, ! -number, !
++pattern, !! cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, = [alias value],
++command, m expr, m package
++
++=item Debugger input/output
++
++Prompt, Multi-line commands, Stack backtrace, Listing, Frame listing
++
++=item Debugging compile-time statements
=item Debugger Customization
DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32,
dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME,
G_NOARGS, G_SCALAR, gv_fetchmeth, gv_fetchmethod, gv_stashpv, gv_stashsv,
--he_free, he_delayfree, hv_clear, hv_delete, hv_exists, hv_fetch,
++GvSV, he_delayfree, he_free, hv_clear, hv_delete, hv_exists, hv_fetch,
hv_iterinit, hv_iterkey, hv_iternext, hv_iternextsv, hv_iterval, hv_magic,
HvNAME, hv_store, hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE,
isUPPER, items, ix, LEAVE, MARK, mg_clear, mg_copy, mg_find, mg_free,
I<Increment and decrement>, I<Transcendental functions>, I<Boolean, string
and numeric conversion>, I<Special>
++=item Inheritance and overloading
++
++Strings as values of C<use overload> directive, Overloading of an operation
++is inherited by derived classes
++
=back
=item SPECIAL SYMBOLS FOR C<use overload>
=over
--=item Last Resort
++=item Last Resort
=item Fallback
=item Interactive Mode
Searching for authors, bundles, distribution files and modules, make, test,
--install, clean modules or distributions
++install, clean modules or distributions, readme, look module or
++distribution
=item CPAN::Shell
++=item autobundle
++
++=item recompile
++
=item ProgrammerE<39>s interface
=item Cache Manager
=item Bundles
--=item autobundle
++=item Prerequisites
--=item recompile
++=item Debugging
++
++=item Floppy, Zip, and all that Jazz
=back
=item EXPORT
--=item Debugging
--
--=over
--
--=item Prerequisites
--
--=back
++=item BUGS
=item AUTHOR
=item DESCRIPTION
--@dl_library_path, @dl_resolve_using, @dl_require_symbols, dl_error(),
--$dl_debug, dl_findfile(), dl_expandspec(), dl_load_file(),
--dl_find_symbol(), dl_undef_symbols(), dl_install_xsub(), bootstrap()
++@dl_library_path, @dl_resolve_using, @dl_require_symbols, @dl_librefs,
++@dl_modules, dl_error(), $dl_debug, dl_findfile(), dl_expandspec(),
++dl_load_file(), dl_loadflags(), dl_find_symbol(),
++dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(),
++bootstrap()
=item AUTHOR
argument. When a __DIE__ hook routine returns, the exception
processing continues as it would have in the absence of the hook,
unless the hook routine itself exits via a C<goto>, a loop exit, or a die().
--The __DIE__ handler is explicitly disabled during the call, so that you
--can die from a __DIE__ handler. Similarly for __WARN__.
++The C<__DIE__> handler is explicitly disabled during the call, so that you
++can die from a C<__DIE__> handler. Similarly for C<__WARN__>. See
++L<perlfunc/die>, L<perlfunc/warn> and L<perlfunc/eval>.
=back
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
sub pre_escapes { # twiddle these, and stay up late :-)
my($thing) = @_;
for ($$thing) {
-- s/([\200-\377])/noremap("&".ord($1).";")/ge;
++ s/([\200-\377])/noremap("&#".ord($1).";")/ge;
s/"(.*?)"/``$1''/gs;
s/&/noremap("&")/ge;
s/<</noremap("<<")/eg;
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
toroff=`
echo \
$mandir/perl.1 \
-- $mandir/perlnews.1 \
++ $mandir/perldelta.1 \
$mandir/perldata.1 \
$mandir/perlsyn.1 \
$mandir/perlop.1 \
dSP;
SV *sv;
-- if (!op->op_private)
++ if (!op->op_private) {
++ EXTEND(SP, 1);
RETPUSHUNDEF;
++ }
sv = POPs;
if (!sv)
PP(pp_int)
{
dSP; dTARGET;
-- double value;
-- value = POPn;
-- if (value >= 0.0)
-- (void)modf(value, &value);
-- else {
-- (void)modf(-value, &value);
-- value = -value;
++ {
++ double value = TOPn;
++ IV iv;
++
++ if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
++ iv = SvIVX(TOPs);
++ SETi(iv);
++ }
++ else {
++ if (value >= 0.0)
++ (void)modf(value, &value);
++ else {
++ (void)modf(-value, &value);
++ value = -value;
++ }
++ iv = I_V(value);
++ if (iv == value)
++ SETi(iv);
++ else
++ SETn(value);
++ }
}
-- XPUSHn(value);
RETURN;
}
{
dSP; dTARGET; tryAMAGICun(abs);
{
-- double value;
-- value = POPn;
--
-- if (value < 0.0)
-- value = -value;
--
-- XPUSHn(value);
-- RETURN;
++ double value = TOPn;
++ IV iv;
++
++ if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
++ (iv = SvIVX(TOPs)) != IV_MIN) {
++ if (iv < 0)
++ iv = -iv;
++ SETi(iv);
++ }
++ else {
++ if (value < 0.0)
++ value = -value;
++ SETn(value);
++ }
}
++ RETURN;
}
PP(pp_hex)
/* in case LEAVE wipes old return values */
}
-- if (cx->blk_sub.hasargs) { /* You don't exist; go away. */
-- AV* av = cx->blk_sub.argarray;
--
-- av_clear(av);
-- AvREAL_off(av);
-- }
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
HEK* share_hek _((char* sv, I32 len, U32 hash));
Signal_t sighandler _((int sig));
SV** stack_grow _((SV** sp, SV**p, int n));
--int start_subparse _((U32 flags));
++int start_subparse _((I32 is_format, U32 flags));
void sub_crush_depth _((CV* cv));
bool sv_2bool _((SV* sv));
CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref));
regkind[(U8)OP(first)] == NBOUND)
r->regstclass = first;
else if (regkind[(U8)OP(first)] == BOL) {
-- r->reganch = ROPT_ANCH;
++ r->reganch |= ROPT_ANCH_BOL;
first = NEXTOPER(first);
-- goto again;
++ goto again;
++ }
++ else if (OP(first) == GPOS) {
++ r->reganch |= ROPT_ANCH_GPOS;
++ first = NEXTOPER(first);
++ goto again;
}
else if ((OP(first) == STAR &&
regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
!(r->reganch & ROPT_ANCH) )
{
/* turn .* into ^.* with an implied $*=1 */
-- r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
++ r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
first = NEXTOPER(first);
-- goto again;
++ goto again;
}
if (sawplus && (!sawopen || !regsawback))
r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
nextchar();
break;
case 'G':
-- ret = regnode(GBOL);
++ ret = regnode(GPOS);
*flagp |= SIMPLE;
nextchar();
break;
PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
if (r->regstclass)
PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
-- if (r->reganch & ROPT_ANCH)
-- PerlIO_printf(Perl_debug_log, "anchored ");
++ if (r->reganch & ROPT_ANCH) {
++ PerlIO_printf(Perl_debug_log, "anchored");
++ if (r->reganch & ROPT_ANCH_BOL)
++ PerlIO_printf(Perl_debug_log, "(BOL)");
++ if (r->reganch & ROPT_ANCH_GPOS)
++ PerlIO_printf(Perl_debug_log, "(GPOS)");
++ PerlIO_putc(Perl_debug_log, ' ');
++ }
if (r->reganch & ROPT_SKIP)
PerlIO_printf(Perl_debug_log, "plus ");
if (r->reganch & ROPT_IMPLICIT)
case MINMOD:
p = "MINMOD";
break;
-- case GBOL:
-- p = "GBOL";
++ case GPOS:
++ p = "GPOS";
break;
case UNLESSM:
p = "UNLESSM";
#define OPEN 25 /* num Mark this point in input as start of #n. */
#define CLOSE 26 /* num Analogous to OPEN. */
#define MINMOD 27 /* no Next operator is not greedy. */
--#define GBOL 28 /* no Matches where last m//g left off. */
++#define GPOS 28 /* no Matches where last m//g left off. */
#define IFMATCH 29 /* no Succeeds if the following matches. */
#define UNLESSM 30 /* no Fails if the following matches. */
#define SUCCEED 31 /* no Return from a subroutine, basically. */
OPEN,
CLOSE,
MINMOD,
-- BOL,
++ GPOS,
BRANCH,
BRANCH,
END,
/* If there is a "must appear" string, look for it. */
s = startpos;
if (prog->regmust != Nullsv &&
-- (!(prog->reganch & ROPT_ANCH)
++ !(prog->reganch & ROPT_ANCH_GPOS) &&
++ (!(prog->reganch & ROPT_ANCH_BOL)
|| (multiline && prog->regback >= 0)) )
{
if (stringarg == strbeg && screamer) {
regtill = startpos+minend;
/* Simplest case: anchored match need be tried only once. */
-- /* [unless multiline is set] */
++ /* [unless only anchor is BOL and multiline is set] */
if (prog->reganch & ROPT_ANCH) {
if (regtry(prog, startpos))
goto got_it;
-- else if (multiline || (prog->reganch & ROPT_IMPLICIT)) {
++ else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
++ (multiline || (prog->reganch & ROPT_IMPLICIT)))
++ {
if (minlen)
dontbother = minlen - 1;
strend -= dontbother;
if (locinput == regbol && regprev == '\n')
break;
sayNO;
-- case GBOL:
++ case GPOS:
if (locinput == regbol)
break;
sayNO;
char program[1]; /* Unwarranted chumminess with compiler. */
} regexp;
--#define ROPT_ANCH 1
--#define ROPT_SKIP 2
--#define ROPT_IMPLICIT 4
++#define ROPT_ANCH 3
++#define ROPT_ANCH_BOL 1
++#define ROPT_ANCH_GPOS 2
++#define ROPT_SKIP 4
++#define ROPT_IMPLICIT 8
PerlIO_get_ptr(fp), PerlIO_get_cnt(fp),
PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0));
/* This used to call 'filbuf' in stdio form, but as that behaves like
-- getc when cnt <= 0 we use PerlIO_getc here to avoid another
-- abstraction. This may also avoid issues with different named
-- 'filbuf' equivalents, though Configure tries to handle them now
-- anyway.
-- */
++ getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
++ another abstraction. */
i = PerlIO_getc(fp); /* get more characters */
DEBUG_P(PerlIO_printf(Perl_debug_log,
"Screamer: post: FILE * thinks ptr=%d, cnt=%d, base=%d\n",
ENTER;
tmpsv = NEWSV(704,0);
gv_efullname3(tmpsv, gv, Nullch);
-- newSUB(start_subparse(0),
++ newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, tmpsv),
Nullop,
Nullop);
switch (type) {
case SVt_PVCV:
-- if (CvANON(sv)) strcat(d, "ANON,");
-- if (CvCLONE(sv)) strcat(d, "CLONE,");
-- if (CvCLONED(sv)) strcat(d, "CLONED,");
++ case SVt_PVFM:
++ if (CvANON(sv)) strcat(d, "ANON,");
++ if (CvUNIQUE(sv)) strcat(d, "UNIQUE,");
++ if (CvCLONE(sv)) strcat(d, "CLONE,");
++ if (CvCLONED(sv)) strcat(d, "CLONED,");
++ if (CvNODEBUG(sv)) strcat(d, "NODEBUG,");
break;
case SVt_PVHV:
if (HvSHAREKEYS(sv)) strcat(d, "SHAREKEYS,");
have to worry about removing the extra print statements later since TEST
ignores lines beginning with '#'.
- If you come up with new tests, send them to larry@wall.org.
-If you know that "basic" features work and expect that some test are going
-to fail, it is adviced to run tests via Test::Harness thusly:
++If you know that Perl is basically working but expect that some tests
++will fail, you may want to use Test::Harness thusly:
+ ./perl -I../lib harness
-This would pinpoint failed tests with better granularity.
++This method pinpoints failed tests automatically.
+
-If you come up with new tests, send them to larry@wall.org.
++If you come up with new tests, please send them to larry@wall.org.
else
{print "not ok 5\n";}
--`/bin/rm -f Io.argv.tmp` if -x '/bin/rm';
+ unlink 'Io.argv.tmp';
# $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
++BEGIN {
++ chdir 't' if -d 't';
++ @INC = '../lib';
++ require Config; import Config;
++ unless ($Config{'d_fork'}) {
++ print "1..0\n";
++ exit 0;
++ }
++}
++
$| = 1;
print "1..8\n";
($rd,$wr) = FileHandle::pipe;
--if ($^O eq 'VMS' || $^O eq 'os2') {
++if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos') {
$wr->autoflush;
$wr->printf("ok %d\n",11);
print $rd->getline;
#!./perl
--
BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
BEGIN {
if(-d "lib" && -f "TEST") {
-- if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
++ if (! $Config{'d_fork'} ||
++ ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'))
++ {
print "1..0\n";
exit 0;
}
use IO::Pipe;
++my $perl = './perl';
++
$| = 1;
--print "1..6\n";
++print "1..10\n";
++
++$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
++while (<$pipe>) {
++ s/^not //;
++ print;
++}
++$pipe->close or print "# \$!=$!\nnot ";
++print "ok 2\n";
++
++$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
++$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
++print $pipe "not ok 3\n" ;
++$pipe->close or print "# \$!=$!\nnot ";
++print "ok 4\n";
$pipe = new IO::Pipe;
if($pid)
{
$pipe->writer;
-- print $pipe "Xk 1\n";
-- print $pipe "oY 2\n";
++ print $pipe "Xk 5\n";
++ print $pipe "oY 6\n";
$pipe->close;
wait;
}
}
else
{
-- die;
++ die "# error = $!";
}
$pipe = new IO::Pipe;
$stdout = bless \*STDOUT, "IO::Handle";
$stdout->fdopen($pipe,"w");
-- print STDOUT "not ok 3\n";
-- exec 'echo', 'not ok 4';
++ print STDOUT "not ok 7\n";
++ exec 'echo', 'not ok 8';
}
else
{
$SIG{'PIPE'} = 'broken_pipe';
sub broken_pipe {
-- print "ok 5\n";
++ print "ok 9\n";
}
--print $pipe "not ok 5\n";
++print $pipe "not ok 9\n";
$pipe->close;
--print "ok 6\n";
++print "ok 10\n";
use Config;
BEGIN {
-- if(-d "lib" && -f "TEST") {
-- if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
-- $Config{'extensions'} !~ /\bIO\b/) &&
-- !(($^O eq 'VMS') && $Config{d_socket})) {
++ if (-d "lib" && -f "TEST") {
++ if (!$Config{'d_fork'} ||
++ (($Config{'extensions'} !~ /\bSocket\b/ ||
++ $Config{'extensions'} !~ /\bIO\b/) &&
++ !(($^O eq 'VMS') && $Config{d_socket}))) {
print "1..0\n";
exit 0;
}
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
++ require Config; import Config;
++ unless ($Config{'d_fork'}) {
++ print "1..0\n";
++ exit 0;
++ }
# make warnings fatal
$SIG{__WARN__} = sub { die @_ };
}
use IPC::Open2;
#require 'open2.pl'; use subs 'open2';
++my $perl = './perl';
++
sub ok {
my ($n, $result, $info) = @_;
if ($result) {
print "1..7\n";
--ok 1, $pid = open2 'READ', 'WRITE', $^X, '-e', 'print scalar <STDIN>';
++ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', 'print scalar <STDIN>';
ok 2, print WRITE "hi kid\n";
ok 3, <READ> eq "hi kid\n";
ok 4, close(WRITE), $!;
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
++ require Config; import Config;
++ unless ($Config{'d_fork'}) {
++ print "1..0\n";
++ exit 0;
++ }
# make warnings fatal
$SIG{__WARN__} = sub { die @_ };
}
use IPC::Open3;
#require 'open3.pl'; use subs 'open3';
++my $perl = './perl';
++
sub ok {
my ($n, $result, $info) = @_;
if ($result) {
print "1..21\n";
# basic
--ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $^X, '-e', <<'EOF';
++ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', <<'EOF';
$| = 1;
print scalar <STDIN>;
print STDERR "hi error\n";
ok 9, $? == 0, $?;
# read and error together, both named
--$pid = open3 'WRITE', 'READ', 'READ', $^X, '-e', <<'EOF';
++$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', <<'EOF';
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
waitpid $pid, 0;
# read and error together, error empty
--$pid = open3 'WRITE', 'READ', '', $^X, '-e', <<'EOF';
++$pid = open3 'WRITE', 'READ', '', $perl, '-e', <<'EOF';
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
# dup writer
ok 14, pipe PIPE_READ, PIPE_WRITE;
$pid = open3 '<&PIPE_READ', 'READ', '',
-- $^X, '-e', 'print scalar <STDIN>';
++ $perl, '-e', 'print scalar <STDIN>';
close PIPE_READ;
print PIPE_WRITE "ok 15\n";
close PIPE_WRITE;
# dup reader
$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
-- $^X, '-e', 'print scalar <STDIN>';
++ $perl, '-e', 'print scalar <STDIN>';
print WRITE "ok 16\n";
waitpid $pid, 0;
# stdout but putting stdout somewhere else, is a good case because it
# used not to work.
$pid = open3 'WRITE', 'READ', '>&STDOUT',
-- $^X, '-e', 'print STDERR scalar <STDIN>';
++ $perl, '-e', 'print STDERR scalar <STDIN>';
print WRITE "ok 17\n";
waitpid $pid, 0;
# dup reader and error together, both named
--$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $^X, '-e', <<'EOF';
++$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', <<'EOF';
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
waitpid $pid, 0;
# dup reader and error together, error empty
--$pid = open3 'WRITE', '>&STDOUT', '', $^X, '-e', <<'EOF';
++$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', <<'EOF';
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $
++BEGIN {
++ chdir 't' if -d 't';
++ @INC = '../lib';
++ require Config; import Config;
++ unless ($Config{'d_fork'}) {
++ print "1..0\n";
++ exit 0;
++ }
++}
++
$| = 1;
print "1..2\n";
$| = 1;
chdir 't' if -d 't';
@INC = '../lib';
- $SIG{__WARN__} = sub { die @_ };
- $SIG{__WARN__} = sub { die "dying on warning: ", @_ };
++ $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
}
sub ok {
ok 18, $$ > 0, $$;
# $^X and $0
--$script = './show-shebang';
++if ($^O eq 'qnx') {
++ chomp($wd = `pwd`);
++}
++else {
++ $wd = '.';
++}
++$script = "$wd/show-shebang";
++if ($^O eq 'os2') {
++ # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
++ $s = "\$^X is $wd/perl.exe, \$0 is $script.\n";
++}
++else {
++ $s = "\$^X is $wd/perl, \$0 is $script\n";
++}
ok 19, open(SCRIPT, ">$script"), $!;
--ok 20, print(SCRIPT <<'EOF'), $!;
--#!./perl
++ok 20, print(SCRIPT <<EOB . <<'EOF'), $!;
++#!$wd/perl
++EOB
print "\$^X is $^X, \$0 is $0\n";
EOF
ok 21, close(SCRIPT), $!;
ok 22, chmod(0755, $script), $!;
--$s = "\$^X is ./perl, \$0 is $script\n";
$_ = `$script`;
- ok 23, $_ eq $s, ":$_:";
-ok 23, $_ eq $s, ":$_:!=:$s:" if $^O ne 'os2';
-# Started by ksh, which sets adds suffixes '.exe' and '.' to perl and script :
-ok 23, $_ eq "\$^X is ./perl.exe, \$0 is $script.\n", ":$_:" if $^O eq 'os2';
--$_ = `./perl $script`;
- ok 24, $_ eq $s, ":$_:";
++s{is perl}{is $wd/perl}; # for systems where $^X is only a basename
++ok 23, $_ eq $s, ":$_:!=:$s:";
++$_ = `$wd/perl $script`;
+ ok 24, $_ eq $s, ":$_:!=:$s:";
ok 25, unlink($script), $!;
# $], $^O, $^T
eval { my $x = 'peace'; eval q[ print "$x\n" ] }
EXPECT
inner peace
++########
++-w
++$| = 1;
++sub foo {
++ print "In foo1\n";
++ eval 'sub foo { print "In foo2\n" }';
++ print "Exiting foo1\n";
++}
++foo;
++foo;
++EXPECT
++In foo1
++Subroutine foo redefined at (eval 1) line 1.
++Exiting foo1
++In foo2
++########
++$s = 0;
++map {#this newline here tickles the bug
++$s += $_} (1,2,4);
++print "eat flaming death\n" unless ($s == 7);
# Find places where the collation order differs from the default locale.
++print "# testing 102\n";
{
my (@k, $i, $j, @d);
for (@d) {
($i, $j) = @$_;
if ($i gt $j) {
++ print "# failed 102 at:\n";
print "# i = $i, j = $j, i ",
$i le $j ? 'le' : 'gt', " j\n";
print 'not ';
# Cross-check whole character set.
++print "# testing 103\n";
for (map { chr } 0..255) {
if (/\w/ and /\W/) { print 'not '; last }
if (/\d/ and /\D/) { print 'not '; last }
if (/\s/ and /\S/) { print 'not '; last }
if (/\w/ and /\D/ and not /_/ and
not (exists $UPPER{$_} or exists $lower{$_})) {
++ print "# failed 103 at:\n";
++ print "# ", ord($_), " '$_'\n";
print 'not ';
last;
}
# The @Locale should be internally consistent.
++print "# testing 104\n";
{
-- my ($from, $to, , $lesser, $greater);
++ my ($from, $to, $lesser, $greater, @test, %test, $test);
for (0..9) {
# Select a slice.
$from++; $to++;
$to = $#Locale if ($to > $#Locale);
$greater = join('', @Locale[$from..$to]);
-- if (not ($lesser lt $greater) or
-- not ($lesser le $greater) or
-- not ($lesser ne $greater) or
-- ($lesser eq $greater) or
-- ($lesser ge $greater) or
-- ($lesser gt $greater) or
-- ($greater lt $lesser ) or
-- ($greater le $lesser ) or
-- not ($greater ne $lesser ) or
-- ($greater eq $lesser ) or
-- not ($greater ge $lesser ) or
-- not ($greater gt $lesser ) or
-- # Well, these two are sort of redundant because @Locale
-- # was derived using cmp.
-- not (($lesser cmp $greater) == -1) or
-- not (($greater cmp $lesser ) == 1)
-- ) {
++ @test =
++ (
++ 'not ($lesser lt $greater)', # 0
++ 'not ($lesser le $greater)', # 1
++ 'not ($lesser ne $greater)', # 2
++ ' ($lesser eq $greater)', # 3
++ ' ($lesser ge $greater)', # 4
++ ' ($lesser gt $greater)', # 5
++ ' ($greater lt $lesser )', # 6
++ ' ($greater le $lesser )', # 7
++ 'not ($greater ne $lesser )', # 8
++ ' ($greater eq $lesser )', # 9
++ 'not ($greater ge $lesser )', # 10
++ 'not ($greater gt $lesser )', # 11
++ # Well, these two are sort of redundant
++ # because @Locale was derived using cmp.
++ 'not (($lesser cmp $greater) == -1)', # 12
++ 'not (($greater cmp $lesser ) == 1)' # 13
++ );
++ @test{@test} = 0 x @test;
++ $test = 0;
++ for my $ti (@test) { $test{$ti} = eval $ti ; $test ||= $test{$ti} }
++ if ($test) {
++ print "# failed 104 at:\n";
++ print "# lesser = '$lesser'\n";
++ print "# greater = '$greater'\n";
++ print "# (greater) from = $from, to = $to\n";
++ for my $ti (@test) {
++ printf("# %-40s %-4s", $ti,
++ $test{$ti} ? 'FAIL' : 'ok');
++ if ($ti =~ /\(\.*(\$.+ +cmp +\$[^\)]+)\.*\)/) {
++ printf("(%s == %4d)", $1, eval $1);
++ }
++ print "\n";
++ }
++
print 'not ';
last;
}
#endif /* ALTERNATE_SHEBANG */
}
if (d) {
-- /*
-- * HP-UX (at least) sets argv[0] to the script name,
-- * which makes $^X incorrect. And Digital UNIX and Linux,
-- * at least, set argv[0] to the basename of the Perl
-- * interpreter. So, having found "#!", we'll set it right.
-- */
-- SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
char *ipath;
-- char *ibase;
++ char *ipathend;
-- while (*d == ' ' || *d == '\t')
++ while (isSPACE(*d))
d++;
ipath = d;
-- ibase = Nullch;
-- while (*d && !isSPACE(*d)) {
-- if (*d++ == '/')
-- ibase = d;
++ while (*d && !isSPACE(*d))
++ d++;
++ ipathend = d;
++
++#ifdef ARG_ZERO_IS_SCRIPT
++ if (ipathend > ipath) {
++ /*
++ * HP-UX (at least) sets argv[0] to the script name,
++ * which makes $^X incorrect. And Digital UNIX and Linux,
++ * at least, set argv[0] to the basename of the Perl
++ * interpreter. So, having found "#!", we'll set it right.
++ */
++ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
++ assert(SvPOK(x) || SvGMAGICAL(x));
++ if (sv_eq(x, GvSV(curcop->cop_filegv)))
++ sv_setpvn(x, ipath, ipathend - ipath);
++ TAINT_NOT; /* $^X is always tainted, but that's OK */
}
-- assert(SvPOK(x) || SvGMAGICAL(x));
-- if (sv_eq(x, GvSV(curcop->cop_filegv))
-- || (ibase
-- && SvCUR(x) == (d - ibase)
-- && strnEQ(SvPVX(x), ibase, d - ibase)))
-- sv_setpvn(x, ipath, d - ipath);
-- /*
-- * $^X is always tainted, but taintedness must be off
-- * when parsing code, so forget we ever saw it.
-- */
-- TAINT_NOT;
++#endif /* ARG_ZERO_IS_SCRIPT */
/*
* Look for options.
* other interpreter. Similarly, if "perl" is there, but
* not in the first 'word' of the line, we assume the line
* contains the start of the Perl program.
-- * This isn't foolproof, but it's generally a good guess.
*/
if (d && *s != '#') {
-- char *c = s;
++ char *c = ipath;
while (*c && !strchr("; \t\r\n\f\v#", *c))
c++;
if (c < d)
else
*s = '#'; /* Don't try to parse shebang line */
}
--#endif
++#endif /* ALTERNATE_SHEBANG */
if (!d &&
*s == '#' &&
++ ipathend > ipath &&
!minus_c &&
!instr(s,"indir") &&
instr(origargv[0],"perl"))
{
char **newargv;
-- char *cmd;
-- s += 2;
-- if (*s == ' ')
-- s++;
-- cmd = s;
-- while (s < bufend && !isSPACE(*s))
-- s++;
-- *s++ = '\0';
++ *ipathend = '\0';
++ s = ipathend + 1;
while (s < bufend && isSPACE(*s))
s++;
if (s < bufend) {
}
else
newargv = origargv;
-- newargv[0] = cmd;
-- execv(cmd,newargv);
-- croak("Can't exec %s", cmd);
++ newargv[0] = ipath;
++ execv(ipath, newargv);
++ croak("Can't exec %s", ipath);
}
if (d) {
int oldpdb = perldb;
return;
}
}
-- if (!pm->op_pmshort || /* promote the better string */
-- ((pm->op_pmflags & PMf_SCANFIRST) &&
-- (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
++ /* promote the better string */
++ if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
++ ((pm->op_pmflags & PMf_SCANFIRST) &&
++ (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
SvREFCNT_dec(pm->op_pmshort); /* ok if null */
pm->op_pmshort = pm->op_pmregexp->regmust;
pm->op_pmslen = SvCUR(pm->op_pmshort);
}
int
--start_subparse(flags)
++start_subparse(is_format, flags)
++I32 is_format;
U32 flags;
{
int oldsavestack_ix = savestack_ix;
SAVEI32(pad_reset_pending);
compcv = (CV*)NEWSV(1104,0);
-- sv_upgrade((SV *)compcv, (flags & CVf_FORMAT) ? SVt_PVFM : SVt_PVCV);
++ sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
CvFLAGS(compcv) |= flags;
comppad = newAV();
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
-- SV *msg = sv_2mortal(newSVpv(message, 0));
++ SV *msg;
++
++ ENTER;
++ msg = newSVpv(message, 0);
++ SvREADONLY_on(msg);
++ SAVEFREESV(msg);
PUSHMARK(sp);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
-- /* It's okay for the __DIE__ hook to modify the message. */
-- message = SvPV(msg, na);
++ LEAVE;
}
}
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
-- SV *msg = sv_2mortal(newSVpv(message, 0));
++ SV *msg;
++
++ ENTER;
++ msg = newSVpv(message, 0);
++ SvREADONLY_on(msg);
++ SAVEFREESV(msg);
PUSHMARK(sp);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
-- /* It's okay for the __DIE__ hook to modify the message. */
-- message = SvPV(msg, na);
++ LEAVE;
}
}
if (in_eval) {
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
++ SV *msg;
++
++ ENTER;
++ msg = newSVpv(message, 0);
++ SvREADONLY_on(msg);
++ SAVEFREESV(msg);
++
PUSHMARK(sp);
-- XPUSHs(sv_2mortal(newSVpv(message,0)));
++ XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
++
++ LEAVE;
return;
}
}
$(plextract):
$(PERL) -I../lib $@.PL
--splain: ../lib/diagnostics.pm
++c2ph: c2ph.PL
++
++h2ph: h2ph.PL
++
++perlbug: perlbug.PL
++
++perldoc: perldoc.PL
++
++pl2pm: pl2pm.PL
++
++splain: splain.PL ../lib/diagnostics.pm
clean:
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
sub paraprint;
--my($Version) = "1.15";
++my($Version) = "1.16";
# 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.
# helpful information. Also let file read fail gracefully.
# Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
# Also report selected environment variables.
++# Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
# TODO: Allow the user to re-name the file on mail failure, and
# make sure failure (transmission-wise) of Mail::Send is
my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
$subject, $from, $verbose, $ed,
-- $fh, $me, $Is_VMS, $msg, $body, $andcc );
++ $fh, $me, $Is_VMS, $msg, $body, $andcc, %REP);
Init();
paraprint <<EOF;
First of all, please provide a subject for the
message. It should be a concise description of
--the bug or problem.
++the bug or problem. "perl bug" or "perl problem"
++is not a concise description.
EOF
print "Subject: ";
}
close(F);
} else {
-- print REP "[Please enter your report here]\n";
++ print REP <<EOF;
++
++-----------------------------------------------------------------
++[Please enter your report here]
++
++
++
++[Please do not change anything below this line]
++-----------------------------------------------------------------
++EOF
}
Dump(*REP);
close(REP);
++ # read in the report template once so that
++ # we can track whether the user does any editing.
++ # yes, *all* whitespace is ignored.
++ open(REP, "<$filename");
++ while (<REP>) {
++ s/\s+//g;
++ $REP{$_}++;
++ }
++ close(REP);
++
}
sub Dump {
print OUT <<EOF;
--
--
++---
Site configuration information for perl $]:
EOF
}
print OUT <<EOF;
++---
++\@INC for perl $]:
++EOF
++ for my $i (@INC) {
++ print OUT "\t$i\n";
++ }
++
++ print OUT <<EOF;
++---
Environment for perl $]:
EOF
for my $env (qw(PATH LD_LIBRARY_PATH
}
}
}
++
++ # Check that we have a report that has some, eh, report in it.
++
++ my $unseen = 0;
++
++ open(REP, "<$filename");
++ # a strange way to check whether any significant editing
++ # have been done: check whether any new non-empty lines
++ # have been added. Yes, the below code ignores *any* space
++ # in *any* line.
++ while (<REP>) {
++ s/\s+//g;
++ $unseen++ if ($_ ne '' and not exists $REP{$_});
++ }
++
++ while ($unseen == 0) {
++ paraprint <<EOF;
++
++I am sorry but it looks like you did not report anything.
++
++EOF
++ print "Action (Retry Edit/Cancel) ";
++ my ($action) = scalar(<>);
++ if ($action =~ /^[re]/i) { # <R>etry <E>dit
++ goto tryagain;
++ } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
++ Cancel();
++ }
++ }
++
++}
++
++sub Cancel {
++ 1 while unlink($filename); # remove all versions under VMS
++ print "\nCancelling.\n";
++ exit(0);
}
sub NowWhat {
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);
++ Cancel();
} elsif( $action =~ /^s/ ) {
paraprint <<EOF;
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
# Open input file before creating output file.
$IN = '../lib/diagnostics.pm';
OBJVAL = $@
# Updated by fndvers.com -- do not edit by hand
--PERL_VERSION = 5_00321#
++PERL_VERSION = 5_00323#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
$(XSUBPP) $< >$(MMS$SOURCE_NAME).c
$(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
++utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com [.utils]h2xs.com [.lib]perlbug.com
++utils2 = [.lib]splain.com [.utils]pl2pm.com
--all : base extras libmods utils podxform archcorefiles preplibrary perlpods
++all : base extras x2p archcorefiles preplibrary perlpods
@ $(NOOP)
base : miniperl perl
@ $(NOOP)
@ $(NOOP)
libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm
@ $(NOOP)
--utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug
++utils : $(utils1) $(utils2)
@ $(NOOP)
--podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man
++podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com [.lib.pod]pod2man.com
++ @ $(NOOP)
++x2p : [.x2p]a2p$(E) [.x2p]s2p.com [.x2p]find2perl.com
@ $(NOOP)
pod1 = [.lib.pod]perl.pod [.lib.pod]perlapio.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod
[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm
@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) [.utils]perldoc.PL
-- Copy/Log [.utils]perldoc $@
++ Copy/Log [.utils]perldoc.com $@
[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm
$(MINIPERL) Minimod.PL >$@
--[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm
++[.utils]c2ph.com : [.utils]c2ph.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]c2ph.PL
--[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm
++[.utils]h2ph.com : [.utils]h2ph.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]h2ph.PL
--[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm
++[.utils]h2xs.com : [.utils]h2xs.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]h2xs.PL
--[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm
++[.lib]perlbug.com : [.utils]perlbug.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]perlbug.PL
-- Rename/Log [.utils]perlbug $@
++ Rename/Log [.utils]perlbug.com $@
--[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
++[.utils]pl2pm.com : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]pl2pm.PL
--[.lib]splain : [.utils]splain.PL $(ARCHDIR)Config.pm
++[.lib]splain.com : [.utils]splain.PL $(ARCHDIR)Config.pm
$(MINIPERL) [.utils]splain.PL
-- Rename/Log [.utils]splain $@
++ Rename/Log [.utils]splain.com $@
++
++[.x2p]find2perl.com : [.x2p]find2perl.PL $(ARCHDIR)Config.pm
++ $(MINIPERL) [.x2p]find2perl.PL
++
++[.x2p]s2p.com : [.x2p]s2p.PL $(ARCHDIR)Config.pm
++ $(MINIPERL) [.x2p]s2p.PL
--[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm
++[.x2p]$(DBG)a2p$(E) : [.x2p]a2p$(O), [.x2p]hash$(O), [.x2p]str$(O), [.x2p]util$(O), [.x2p]walk$(O)
++ Link $(LINKFLAGS) /Exe=$@ $(MMS$SOURCE_LIST) $(CRTLOPTS)
++
++[.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) [.pod]pod2html.PL
-- Rename/Log [.pod]pod2html $@
++ Rename/Log [.pod]pod2html.com $@
--[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2latex.com : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) [.pod]pod2latex.PL
-- Rename/Log [.pod]pod2latex $@
++ Rename/Log [.pod]pod2latex.com $@
--[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2man.com : [.pod]pod2man.PL $(ARCHDIR)Config.pm
@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) [.pod]pod2man.PL
-- Rename/Log [.pod]pod2man $@
++ Rename/Log [.pod]pod2man.com $@
--[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2text.com : [.pod]pod2text.PL $(ARCHDIR)Config.pm
@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) [.pod]pod2text.PL
-- Rename/Log [.pod]pod2text $@
++ Rename/Log [.pod]pod2text.com $@
preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM)
@ Write sys$$Output "Autosplitting Perl library . . ."
perly$(O) : perly.c, perly.h, $(h)
$(CC) $(CFLAGS) perly.c
++[.t.lib]vmsfspec.t : [.vms.ext]filespec.t
++ Copy/Log/NoConfirm [.vms.ext]filespec.t $@
++
test : all
- @[.VMS]Test.Com "$(E)"
globals$(O) : sv.h
globals$(O) : vmsish.h
globals$(O) : util.h
++[.x2p]a2p$(O) : [.x2p]a2p.c
++[.x2p]a2p$(O) : [.x2p]a2py.c
++[.x2p]a2p$(O) : [.x2p]INTERN.h
++[.x2p]a2p$(O) : [.x2p]a2p.h
++[.x2p]a2p$(O) : [.x2p]hash.h
++[.x2p]a2p$(O) : [.x2p]str.h
++[.x2p]a2p$(O) : handy.h
++[.x2p]hash$(O) : [.x2p]hash.c
++[.x2p]hash$(O) : [.x2p]EXTERN.h
++[.x2p]hash$(O) : [.x2p]a2p.h
++[.x2p]hash$(O) : [.x2p]hash.h
++[.x2p]hash$(O) : [.x2p]str.h
++[.x2p]hash$(O) : handy.h
++[.x2p]hash$(O) : [.x2p]util.h
++[.x2p]str$(O) : [.x2p]str.c
++[.x2p]str$(O) : [.x2p]EXTERN.h
++[.x2p]str$(O) : [.x2p]a2p.h
++[.x2p]str$(O) : [.x2p]hash.h
++[.x2p]str$(O) : [.x2p]str.h
++[.x2p]str$(O) : handy.h
++[.x2p]str$(O) : [.x2p]util.h
++[.x2p]util$(O) : [.x2p]util.c
++[.x2p]util$(O) : [.x2p]EXTERN.h
++[.x2p]util$(O) : [.x2p]a2p.h
++[.x2p]util$(O) : [.x2p]hash.h
++[.x2p]util$(O) : [.x2p]str.h
++[.x2p]util$(O) : handy.h
++[.x2p]util$(O) : [.x2p]INTERN.h
++[.x2p]util$(O) : [.x2p]util.h
++[.x2p]walk$(O) : [.x2p]walk.c
++[.x2p]walk$(O) : [.x2p]EXTERN.h
++[.x2p]walk$(O) : [.x2p]a2p.h
++[.x2p]walk$(O) : [.x2p]hash.h
++[.x2p]walk$(O) : [.x2p]str.h
++[.x2p]walk$(O) : handy.h
++[.x2p]walk$(O) : [.x2p]util.h
config.h : [.vms]config.vms
Copy/Log/NoConfirm [.vms]config.vms []config.h
- $(MMS) clean
Set Default [--]
- If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
-- - If f$$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);*
++ - If f$$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*
- If f$$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
- If f$$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;*
- If f$$Search(f$$Parse("sys$$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);*
- If f$$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;*
- If f$$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;*
- If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*/Exclude=Makefile.
++ - If f$$Search("[.x2p]*.").nes."" Then Delete/NoConfirm/Log [.x2p]*.;*/Exclude=Makefile.
- 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*.;*
-- - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
++ - If f$$Search("[.lib.pod]pod2*.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.com;*
++ - If f$$Search("[...]*$(E)").nes."" Then Delete/NoConfirm/Log [...]*$(E);*
cleansrc : clean
- If f$$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C
* when Perl is built. Please do not change it by hand; make
* any changes to FndVers.Com instead.
*/
--#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00321" /**/
++#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00323" /**/
#define ARCHLIB ARCHLIB_EXP /*config-skip*/
++/* ARCHNAME:
++ * This symbol holds a string representing the architecture name.
++ * It may be used to construct an architecture-dependant pathname
++ * where library files may be held under a private library, for
++ * instance.
++ */
++#define ARCHNAME "VMS_VAX" /**/
++
/* BINCOMPAT3:
* This symbol, if defined, indicates that Perl 5.004 should be
* binary-compatible with Perl 5.003.
# define FILE_cnt(fp) ((*fp)->_cnt)
#endif
--/* FILE_filbuf:
-- * This macro is used to access the internal stdio _filbuf function
-- * (or equivalent), if STDIO_CNT_LVALUE and STDIO_PTR_LVALUE
-- * are defined. It is typically either _filbuf or __filbuf.
-- * This macro will only be defined if both STDIO_CNT_LVALUE and
-- * STDIO_PTR_LVALUE are defined.
-- */
--#define FILE_filbuf(fp) do { register int c; if ((c = fgetc(fp)) != EOF) \
-- ungetc(c,(fp)); } while (0);
--
/* FILE_base:
* This macro is used to access the _base field (or equivalent) of the
* FILE structure pointed to by its argument. This macro will always be
.endif
# Updated by fndvers.com -- do not edit by hand
--PERL_VERSION = 5_00321#
++PERL_VERSION = 5_00323#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
$(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
.endif
++utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com [.utils]h2xs.com [.lib]perlbug.com
++utils2 = [.lib]splain.com [.utils]pl2pm.com
--all : base extras libmods utils podxform archcorefiles preplibrary perlpods
++all : base extras x2p archcorefiles preplibrary perlpods
@ $(NOOP)
base : miniperl perl
@ $(NOOP)
@ $(NOOP)
libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm
@ $(NOOP)
--utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug
++utils : $(utils1) $(utils2)
@ $(NOOP)
--podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man
++podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com [.lib.pod]pod2man.com
++ @ $(NOOP)
++x2p : [.x2p]a2p$(E) [.x2p]s2p.com [.x2p]find2perl.com
@ $(NOOP)
pod1 = [.lib.pod]perl.pod [.lib.pod]perlapio.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod
[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
-- Copy/Log [.utils]perldoc $(MMS$TARGET)
++ Copy/Log [.utils]perldoc.com $(MMS$TARGET)
[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE) >$(MMS$TARGET)
--[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm
++[.utils]c2ph.com : [.utils]c2ph.PL $(ARCHDIR)Config.pm
++ $(MINIPERL) $(MMS$SOURCE)
++
++[.utils]h2ph.com : [.utils]h2ph.PL $(ARCHDIR)Config.pm
++ $(MINIPERL) $(MMS$SOURCE)
++
++[.utils]h2xs.com : [.utils]h2xs.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
--[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm
++[.lib]perlbug.com : [.utils]perlbug.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
++ Rename/Log [.utils]perlbug.com $(MMS$TARGET)
--[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm
++[.utils]pl2pm.com : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
--[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm
++[.lib]splain.com : [.utils]splain.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.utils]perlbug $(MMS$TARGET)
++ Rename/Log [.utils]splain.com $(MMS$TARGET)
--[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
++[.x2p]find2perl.com : [.x2p]find2perl.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
--[.lib]splain : [.utils]splain.PL $(ARCHDIR)Config.pm
++[.x2p]s2p.com : [.x2p]s2p.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.utils]splain $(MMS$TARGET)
--[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm
++[.x2p]$(DBG)a2p$(E) : [.x2p]a2p$(O), [.x2p]hash$(O), [.x2p]str$(O), [.x2p]util$(O), [.x2p]walk$(O)
++ Link $(LINKFLAGS) /Exe=$(MMS$TARGET) $(MMS$SOURCE_LIST) $(CRTLOPTS)
++
++[.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.pod]pod2html $(MMS$TARGET)
++ Rename/Log [.pod]pod2html.com $(MMS$TARGET)
--[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2latex.com : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.pod]pod2latex $(MMS$TARGET)
++ Rename/Log [.pod]pod2latex.com $(MMS$TARGET)
--[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2man.com : [.pod]pod2man.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.pod]pod2man $(MMS$TARGET)
++ Rename/Log [.pod]pod2man.com $(MMS$TARGET)
--[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm
++[.lib.pod]pod2text.com : [.pod]pod2text.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
-- Rename/Log [.pod]pod2text $(MMS$TARGET)
++ Rename/Log [.pod]pod2text.com $(MMS$TARGET)
preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM)
@ Write Sys$Output "Autosplitting Perl library . . ."
$(CC) $(CFLAGS) $(MMS$SOURCE)
.endif
++[.t.lib]vmsfspec.t : [.vms.ext]filespec.t
++ Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET)
++
test : all
- @[.VMS]Test.Com "$(E)"
globals$(O) : sv.h
globals$(O) : vmsish.h
globals$(O) : util.h
++[.x2p]a2p$(O) : [.x2p]a2p.c
++[.x2p]a2p$(O) : [.x2p]a2py.c
++[.x2p]a2p$(O) : [.x2p]INTERN.h
++[.x2p]a2p$(O) : [.x2p]a2p.h
++[.x2p]a2p$(O) : [.x2p]hash.h
++[.x2p]a2p$(O) : [.x2p]str.h
++[.x2p]a2p$(O) : handy.h
++[.x2p]hash$(O) : [.x2p]hash.c
++[.x2p]hash$(O) : [.x2p]EXTERN.h
++[.x2p]hash$(O) : [.x2p]a2p.h
++[.x2p]hash$(O) : [.x2p]hash.h
++[.x2p]hash$(O) : [.x2p]str.h
++[.x2p]hash$(O) : handy.h
++[.x2p]hash$(O) : [.x2p]util.h
++[.x2p]str$(O) : [.x2p]str.c
++[.x2p]str$(O) : [.x2p]EXTERN.h
++[.x2p]str$(O) : [.x2p]a2p.h
++[.x2p]str$(O) : [.x2p]hash.h
++[.x2p]str$(O) : [.x2p]str.h
++[.x2p]str$(O) : handy.h
++[.x2p]str$(O) : [.x2p]util.h
++[.x2p]util$(O) : [.x2p]util.c
++[.x2p]util$(O) : [.x2p]EXTERN.h
++[.x2p]util$(O) : [.x2p]a2p.h
++[.x2p]util$(O) : [.x2p]hash.h
++[.x2p]util$(O) : [.x2p]str.h
++[.x2p]util$(O) : handy.h
++[.x2p]util$(O) : [.x2p]INTERN.h
++[.x2p]util$(O) : [.x2p]util.h
++[.x2p]walk$(O) : [.x2p]walk.c
++[.x2p]walk$(O) : [.x2p]EXTERN.h
++[.x2p]walk$(O) : [.x2p]a2p.h
++[.x2p]walk$(O) : [.x2p]hash.h
++[.x2p]walk$(O) : [.x2p]str.h
++[.x2p]walk$(O) : handy.h
++[.x2p]walk$(O) : [.x2p]util.h
.endif # !LINK_ONLY
config.h : [.vms]config.vms
Set Default [--]
.endif
- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
-- - If F$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);*
++ - If F$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*
- If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
- If F$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;*
- If F$Search(F$Parse("Sys$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);*
- If F$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;*
- If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;*
- If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*/Exclude=Makefile.
++ - If F$Search("[.x2p]*.").nes."" Then Delete/NoConfirm/Log [.x2p]*.;*/Exclude=Makefile.
- 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*.;*
-- - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
++ - If F$Search("[.lib.pod]pod2*.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.com;*
++ - If F$Search("[...]*$(E)").nes."" Then Delete/NoConfirm/Log [...]*$(E);*
cleansrc : clean
- If F$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C
$!
$ If teststs.ne.1 ! current values in config.vms are appropriate
$ Then
++$ token = """""""""VMS_''arch' /**/"""""""""
++$ Call update_file "''p2'" "#define ARCHNAME" "''token'"
++$ teststs = $Status
++$ If .not.teststs Then Exit teststs
++$!
$ token = """""""""/perl_root/lib/VMS_''arch'"""""""" /**/"
$ Call update_file "''p2'" "#define OLDARCHLIB_EXP" "''token'"
$ If .not.$Status Then Exit $Status
installarchlib='$installarchlib'
installsitelib='$installsitelib'
installsitearch='$installsitearch'
--startperl='\$ perl 'f\$env("procedure")' - ! q#
-- 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8'
--$ exit !#
--'
++path_sep='|'
++startperl='\$ perl 'f\$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
++$ exit++ + ++$status != 0 and $exit = $status = undef;
EndOfIntro
foreach (@ARGV) {
dEXT int yychar;
dEXT YYSTYPE yyval;
dEXT YYSTYPE yylval;
--#line 626 "perly.y"
++#line 624 "perly.y"
/* PROGRAM */
#line 1315 "perly.c"
#define YYABORT goto yyabort
break;
case 53:
#line 280 "perly.y"
--{ yyval.ival = start_subparse(); }
++{ yyval.ival = start_subparse(FALSE, 0); }
break;
case 54:
#line 284 "perly.y"
--{ yyval.ival = start_subparse();
-- CvANON_on(compcv); }
++{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
break;
case 55:
--#line 289 "perly.y"
--{ yyval.ival = start_subparse();
-- CvFORMAT_on(compcv); }
++#line 288 "perly.y"
++{ yyval.ival = start_subparse(TRUE, 0); }
break;
case 56:
--#line 293 "perly.y"
++#line 291 "perly.y"
{ char *name = SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na);
if (strEQ(name, "BEGIN") || strEQ(name, "END"))
CvUNIQUE_on(compcv);
yyval.opval = yyvsp[0].opval; }
break;
case 57:
--#line 300 "perly.y"
++#line 298 "perly.y"
{ yyval.opval = Nullop; }
break;
case 59:
--#line 304 "perly.y"
++#line 302 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 60:
--#line 305 "perly.y"
++#line 303 "perly.y"
{ yyval.opval = Nullop; expect = XSTATE; }
break;
case 61:
--#line 309 "perly.y"
++#line 307 "perly.y"
{ package(yyvsp[-1].opval); }
break;
case 62:
--#line 311 "perly.y"
++#line 309 "perly.y"
{ package(Nullop); }
break;
case 63:
--#line 315 "perly.y"
++#line 313 "perly.y"
{ CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
break;
case 64:
--#line 317 "perly.y"
++#line 315 "perly.y"
{ utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
break;
case 65:
--#line 321 "perly.y"
++#line 319 "perly.y"
{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 66:
--#line 323 "perly.y"
++#line 321 "perly.y"
{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 68:
--#line 328 "perly.y"
++#line 326 "perly.y"
{ yyval.opval = yyvsp[-1].opval; }
break;
case 69:
--#line 330 "perly.y"
++#line 328 "perly.y"
{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 71:
--#line 335 "perly.y"
++#line 333 "perly.y"
{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
break;
case 72:
--#line 338 "perly.y"
++#line 336 "perly.y"
{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
break;
case 73:
--#line 341 "perly.y"
++#line 339 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
break;
case 74:
--#line 346 "perly.y"
++#line 344 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
break;
case 75:
--#line 351 "perly.y"
++#line 349 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
break;
case 76:
--#line 356 "perly.y"
++#line 354 "perly.y"
{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 77:
--#line 358 "perly.y"
++#line 356 "perly.y"
{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
case 78:
--#line 360 "perly.y"
++#line 358 "perly.y"
{ yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 79:
--#line 362 "perly.y"
++#line 360 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); }
break;
case 82:
--#line 372 "perly.y"
++#line 370 "perly.y"
{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
break;
case 83:
--#line 374 "perly.y"
++#line 372 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 84:
--#line 376 "perly.y"
++#line 374 "perly.y"
{ if (yyvsp[-1].ival != OP_REPEAT)
scalar(yyvsp[-2].opval);
yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
break;
case 85:
--#line 380 "perly.y"
++#line 378 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 86:
--#line 382 "perly.y"
++#line 380 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 87:
--#line 384 "perly.y"
++#line 382 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 88:
--#line 386 "perly.y"
++#line 384 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 89:
--#line 388 "perly.y"
++#line 386 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 90:
--#line 390 "perly.y"
++#line 388 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 91:
--#line 392 "perly.y"
++#line 390 "perly.y"
{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
break;
case 92:
--#line 394 "perly.y"
++#line 392 "perly.y"
{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 93:
--#line 396 "perly.y"
++#line 394 "perly.y"
{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 94:
--#line 398 "perly.y"
++#line 396 "perly.y"
{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 95:
--#line 400 "perly.y"
++#line 398 "perly.y"
{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 96:
--#line 403 "perly.y"
++#line 401 "perly.y"
{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
break;
case 97:
--#line 405 "perly.y"
++#line 403 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 98:
--#line 407 "perly.y"
++#line 405 "perly.y"
{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 99:
--#line 409 "perly.y"
++#line 407 "perly.y"
{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
break;
case 100:
--#line 411 "perly.y"
++#line 409 "perly.y"
{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
break;
case 101:
--#line 413 "perly.y"
++#line 411 "perly.y"
{ yyval.opval = newUNOP(OP_POSTINC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
break;
case 102:
--#line 416 "perly.y"
++#line 414 "perly.y"
{ yyval.opval = newUNOP(OP_POSTDEC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
break;
case 103:
--#line 419 "perly.y"
++#line 417 "perly.y"
{ yyval.opval = newUNOP(OP_PREINC, 0,
mod(scalar(yyvsp[0].opval), OP_PREINC)); }
break;
case 104:
--#line 422 "perly.y"
++#line 420 "perly.y"
{ yyval.opval = newUNOP(OP_PREDEC, 0,
mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
break;
case 105:
--#line 425 "perly.y"
++#line 423 "perly.y"
{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
break;
case 106:
--#line 427 "perly.y"
++#line 425 "perly.y"
{ yyval.opval = sawparens(yyvsp[-1].opval); }
break;
case 107:
--#line 429 "perly.y"
++#line 427 "perly.y"
{ yyval.opval = sawparens(newNULLLIST()); }
break;
case 108:
--#line 431 "perly.y"
++#line 429 "perly.y"
{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
break;
case 109:
--#line 433 "perly.y"
++#line 431 "perly.y"
{ yyval.opval = newANONLIST(Nullop); }
break;
case 110:
--#line 435 "perly.y"
++#line 433 "perly.y"
{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
break;
case 111:
--#line 437 "perly.y"
++#line 435 "perly.y"
{ yyval.opval = newANONHASH(Nullop); }
break;
case 112:
--#line 439 "perly.y"
++#line 437 "perly.y"
{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 113:
--#line 441 "perly.y"
++#line 439 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 114:
--#line 443 "perly.y"
++#line 441 "perly.y"
{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
break;
case 115:
--#line 445 "perly.y"
++#line 443 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 116:
--#line 447 "perly.y"
++#line 445 "perly.y"
{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
break;
case 117:
--#line 449 "perly.y"
++#line 447 "perly.y"
{ yyval.opval = newBINOP(OP_AELEM, 0,
ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
scalar(yyvsp[-1].opval));}
break;
case 118:
--#line 453 "perly.y"
++#line 451 "perly.y"
{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
scalar(yyvsp[-1].opval));}
break;
case 119:
--#line 457 "perly.y"
++#line 455 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 120:
--#line 459 "perly.y"
++#line 457 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 121:
--#line 461 "perly.y"
++#line 459 "perly.y"
{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
break;
case 122:
--#line 463 "perly.y"
++#line 461 "perly.y"
{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
expect = XOPERATOR; }
break;
case 123:
--#line 466 "perly.y"
++#line 464 "perly.y"
{ yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
expect = XOPERATOR; }
break;
case 124:
--#line 471 "perly.y"
++#line 469 "perly.y"
{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
expect = XOPERATOR; }
break;
case 125:
--#line 476 "perly.y"
++#line 474 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
break;
case 126:
--#line 478 "perly.y"
++#line 476 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
break;
case 127:
--#line 480 "perly.y"
++#line 478 "perly.y"
{ yyval.opval = prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
ref(yyvsp[-3].opval, OP_ASLICE))); }
break;
case 128:
--#line 486 "perly.y"
++#line 484 "perly.y"
{ yyval.opval = prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
expect = XOPERATOR; }
break;
case 129:
--#line 493 "perly.y"
++#line 491 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 130:
--#line 495 "perly.y"
++#line 493 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
break;
case 131:
--#line 497 "perly.y"
++#line 495 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
break;
case 132:
--#line 499 "perly.y"
++#line 497 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
break;
case 133:
--#line 502 "perly.y"
++#line 500 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
case 134:
--#line 505 "perly.y"
++#line 503 "perly.y"
{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
break;
case 135:
--#line 507 "perly.y"
++#line 505 "perly.y"
{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
break;
case 136:
--#line 509 "perly.y"
++#line 507 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
)),Nullop)); dep();}
break;
case 137:
--#line 517 "perly.y"
++#line 515 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
append_elem(OP_LIST,
)))); dep();}
break;
case 138:
--#line 526 "perly.y"
++#line 524 "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 139:
--#line 530 "perly.y"
++#line 528 "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 140:
--#line 535 "perly.y"
++#line 533 "perly.y"
{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
hints |= HINT_BLOCK_SCOPE; }
break;
case 141:
--#line 538 "perly.y"
++#line 536 "perly.y"
{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 142:
--#line 540 "perly.y"
++#line 538 "perly.y"
{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 143:
--#line 542 "perly.y"
++#line 540 "perly.y"
{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
case 144:
--#line 544 "perly.y"
++#line 542 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 145:
--#line 546 "perly.y"
++#line 544 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 146:
--#line 548 "perly.y"
++#line 546 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
case 147:
--#line 551 "perly.y"
++#line 549 "perly.y"
{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
case 148:
--#line 553 "perly.y"
++#line 551 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, 0); }
break;
case 149:
--#line 555 "perly.y"
++#line 553 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar(yyvsp[0].opval)); }
break;
case 150:
--#line 558 "perly.y"
++#line 556 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
break;
case 151:
--#line 560 "perly.y"
++#line 558 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
case 152:
--#line 562 "perly.y"
++#line 560 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
break;
case 153:
--#line 564 "perly.y"
++#line 562 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
break;
case 156:
--#line 570 "perly.y"
++#line 568 "perly.y"
{ yyval.opval = Nullop; }
break;
case 157:
--#line 572 "perly.y"
++#line 570 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 158:
--#line 576 "perly.y"
++#line 574 "perly.y"
{ yyval.opval = Nullop; }
break;
case 159:
--#line 578 "perly.y"
++#line 576 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 160:
--#line 580 "perly.y"
++#line 578 "perly.y"
{ yyval.opval = yyvsp[-1].opval; }
break;
case 161:
--#line 583 "perly.y"
++#line 581 "perly.y"
{ yyval.ival = 0; }
break;
case 162:
--#line 584 "perly.y"
++#line 582 "perly.y"
{ yyval.ival = 1; }
break;
case 163:
--#line 588 "perly.y"
++#line 586 "perly.y"
{ in_my = 0; yyval.opval = my(yyvsp[0].opval); }
break;
case 164:
--#line 592 "perly.y"
++#line 590 "perly.y"
{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 165:
--#line 596 "perly.y"
++#line 594 "perly.y"
{ yyval.opval = newSVREF(yyvsp[0].opval); }
break;
case 166:
--#line 600 "perly.y"
++#line 598 "perly.y"
{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 167:
--#line 604 "perly.y"
++#line 602 "perly.y"
{ yyval.opval = newHVREF(yyvsp[0].opval); }
break;
case 168:
--#line 608 "perly.y"
++#line 606 "perly.y"
{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 169:
--#line 612 "perly.y"
++#line 610 "perly.y"
{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
break;
case 170:
--#line 616 "perly.y"
++#line 614 "perly.y"
{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 171:
--#line 618 "perly.y"
++#line 616 "perly.y"
{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 172:
--#line 620 "perly.y"
++#line 618 "perly.y"
{ yyval.opval = scope(yyvsp[0].opval); }
break;
case 173:
--#line 623 "perly.y"
++#line 621 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
--#line 2217 "perly.c"
++#line 2215 "perly.c"
}
yyssp -= yym;
yystate = *yyssp;
#include <unixio.h>
#include <unixlib.h>
#include <file.h> /* it's not <sys/file.h>, so don't use I_SYS_FILE */
--#ifdef __DECC
++#if defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000
# include <unistd.h> /* DECC has this; VAXC and gcc don't */
#endif
/* Macros to set errno using the VAX thread-safe calls, if present */
#if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
# define set_errno(v) (cma$tis_errno_set_value(v))
++ void cma$tis_errno_set_value(int __value); /* missing in some errno.h */
# define set_vaxc_errno(v) (vaxc$errno = (v))
#else
# define set_errno(v) (errno = (v))
*/
#define VOIDUSED 1
--#include "../config.h"
++#ifdef VMS
++# include "config.h"
++#else
++# include "../config.h"
++#endif
#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
# define STANDARD_C 1
#else
# if defined(VMS)
# define NO_PERL_TYPEDEFS
--# include "[-]vmsish.h"
++# include "vmsish.h"
# endif
#endif
char *strcpy(), *strcat();
#endif /* ! STANDARD_C */
--#include "../handy.h"
++#ifdef VMS
++# include "handy.h"
++#else
++# include "../handy.h"
++#endif
#undef Nullfp
#define Nullfp Null(FILE*)
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
++$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
https://perl5.git.perl.org / perl5.git / commitdiff