To give due honor to those who have made Perl what is is today,
here are some of the more common names in the Changes file, and their
-current addresses (as of July 1998):
+current addresses (as of February 2000):
Gisle Aas <gisle@aas.no>
Abigail <abigail@delanet.com>
Kenneth Albanowski <kjahds@kjahds.com>
Russ Allbery <rra@stanford.edu>
+ Brad Appleton <bradapp@enteract.com>
+ Greg Bacon <gbacon@itsc.uah.edu>
+ Robin Barker <rmb1@cise.npl.co.uk>
+ Vishal Bhatia <vishal@gol.com>
Spider Boardman <spider@orb.nashua.nh.us>
Tom Christiansen <tchrist@perl.com>
- Jan Dubois <jan.dubois@ibm.net>
+ Mark-Jason Dominus <mjd@plover.com>
+ Jan Dubois <jand@activestate.com>
+ Dominic Dunlop <domo@computer.org>
+ Eric Fifer <efifer@sanwaint.com>
Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
M. J. T. Guy <mjtg@cus.cam.ac.uk>
Jarkko Hietaniemi <jhi@iki.fi>
+ Tom Hughes <tom@compton.nu>
Nick Ing-Simmons <nik@tiuk.ti.com>
Andreas Koenig <a.koenig@mind.de>
+ Douglas Lankshear <dougl@activestate.com>
Doug MacEachern <dougm@opengroup.org>
+ Raphael Manfredi <Raphael.Manfredi@st.com>
Paul Marquess <Paul.Marquess@btinternet.com>
Stephen McCamant <alias@mcs.com>
Laszlo Molnar <laszlo.molnar@eth.ericsson.se>
Hans Mulder <hansmu@xs4all.nl>
+ Chris Nandor <pudge@pobox.com>
Matthias Neeracher <neeri@iis.ee.ethz.ch>
Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
Tom Phoenix <rootbeer@teleport.com>
Joshua Pritikin <joshua.pritikin@db.com>
+ Peter Prymmer <pvhp@forte.com>
Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de>
Dean Roehrich <roehrich@cray.com>
Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Michael G Schwern <schwern@pobox.com>
Roderick Schertler <roderick@argon.org>
Kurt D. Starsinic <kstar@isinet.com>
+ Benjamin Stuhl <sho_pi@hotmail.com>
Dan Sugalski <sugalskd@osshe.edu>
+ Nathan Torkington <gnat@frii.com>
Larry W. Virden <lvirden@cas.org>
+ Johan Vromans <jvromans@squirrel.nl>
Ilya Zakharevich <ilya@math.ohio-state.edu>
And the Keepers of the Patch Pumpkin:
----------------
____________________________________________________________________________
+[ 5167] By: gsar on 2000/02/20 18:54:27
+ Log: avoid reading out-of-bounds memory when matching against reference
+ Branch: perl
+ ! regexec.c
+____________________________________________________________________________
+[ 5166] By: gsar on 2000/02/20 17:59:41
+ Log: byte mode chop() should clear UTF8 (from Gisle Aas)
+ Branch: perl
+ ! doop.c
+____________________________________________________________________________
+[ 5165] By: gsar on 2000/02/20 17:57:08
+ Log: test fix needed by change#5164
+ Branch: perl
+ ! t/pragma/warn/toke
+____________________________________________________________________________
+[ 5164] By: gsar on 2000/02/20 17:50:38
+ Log: default mkdir() mode argument to 0777
+ Branch: perl
+ ! opcode.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp_sys.c
+ ! t/op/mkdir.t toke.c
+____________________________________________________________________________
+[ 5163] By: gsar on 2000/02/20 16:34:33
+ Log: glob() takes one or no user arguments and a non-user-visible second
+ hidden argument, fix its prototype-checking accordingly
+ Branch: perl
+ ! op.c opcode.h opcode.pl
+____________________________________________________________________________
+[ 5162] By: gsar on 2000/02/20 16:07:38
+ Log: make change#3386 a build-time option (avoids problems due to
+ perl_run() longjmping out)
+ Branch: perl
+ ! Todo-5.6 embed.h embed.pl embedvar.h intrpvar.h objXSUB.h
+ ! perl.c perl.h perlapi.c perlvars.h pp_ctl.c proto.h scope.c
+ ! scope.h sv.c thrdvar.h util.c
+____________________________________________________________________________
+[ 5161] By: gsar on 2000/02/20 12:13:37
+ Log: IO::Socket now sets $!, avoids eval/die (patch from Graham Barr
+ modified to use Errno more portably)
+ Branch: perl
+ ! ext/IO/lib/IO/Socket.pm ext/IO/lib/IO/Socket/INET.pm
+____________________________________________________________________________
+[ 5160] By: gsar on 2000/02/20 11:53:28
+ Log: mention portability caveat about C<use Errno 'EFOO'>
+ Branch: perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 5159] By: gsar on 2000/02/20 11:14:36
+ Log: revise docs on @+ and @- (from Tom "Camel" Christiansen)
+ Branch: perl
+ ! pod/perlvar.pod
+____________________________________________________________________________
+[ 5158] By: gsar on 2000/02/20 10:53:49
+ Log: README.vms and related updates (from Peter Prymmer <pvhp@best.com>)
+ Branch: perl
+ ! MANIFEST Makefile.SH README.vms pod/perl5005delta.pod
+ ! pod/perldelta.pod pod/perlport.pod pod/podchecker.PL
+ ! vms/descrip_mms.template
+____________________________________________________________________________
+[ 5157] By: jhi on 2000/02/19 20:29:26
+ Log: Be explicit about what ops work with bt vectors.
+ (And implicit about which don't.)
+ Branch: cfgperl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 5156] By: jhi on 2000/02/19 18:38:14
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ +> lib/bytes.pm lib/bytes_heavy.pl
+ - lib/byte.pm lib/byte_heavy.pl
+ !> (integrate 61 files)
+____________________________________________________________________________
+[ 5155] By: gsar on 2000/02/19 17:57:39
+ Log: char vs U8 warnings
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 5154] By: gsar on 2000/02/19 17:44:56
+ Log: remove outdated caveat about C<while ($k = each %foo)> (from
+ Hugo van der Sanden)
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 5153] By: gsar on 2000/02/19 17:41:41
+ Log: tests, doc tweak (from Gisle Aas)
+ Branch: perl
+ ! pod/perlfaq9.pod t/op/ord.t
+____________________________________________________________________________
+[ 5152] By: gsar on 2000/02/19 17:35:50
+ Log: document behavior of splice(@ary) (from Gisle Aas)
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 5151] By: gsar on 2000/02/19 17:33:59
+ Log: fix bug in backtracking optimizer (from Makoto Ishisone
+ <ishisone@sra.co.jp>)
+ Branch: perl
+ ! regexec.c t/op/pat.t
+____________________________________________________________________________
+[ 5150] By: gsar on 2000/02/19 17:33:05
+ Log: more B fixups to cope with empty GVs (these can only happen in pads)
+ Branch: perl
+ ! ext/B/B.pm ext/B/B.xs ext/B/B/C.pm op.c
+____________________________________________________________________________
+[ 5149] By: gsar on 2000/02/19 17:32:03
+ Log: avoid compiler warnings
+ Branch: perl
+ ! malloc.c perl.h
+____________________________________________________________________________
+[ 5148] By: gsar on 2000/02/19 17:18:09
+ Log: document 'lvalue' attribute (from Simon Cozens <simon@brecon.co.uk>)
+ Branch: perl
+ ! lib/attributes.pm
+____________________________________________________________________________
+[ 5147] By: gsar on 2000/02/19 17:15:34
+ Log: avoid failing on $!{ENOTHERE} (they can always use C<exists $!{NOTHERE}>
+ for that)
+ Branch: perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 5146] By: gsar on 2000/02/19 16:18:46
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ !> Configure config_h.SH ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+ !> ext/SDBM_File/sdbm/sdbm.c ext/Socket/Socket.pm
+ !> ext/Socket/Socket.xs hints/hpux.sh perl.h pod/perldelta.pod
+ !> pod/perlfunc.pod pod/perlopentut.pod t/lib/syslfs.t
+____________________________________________________________________________
+[ 5145] By: gsar on 2000/02/19 16:10:37
+ Log: POSIX::strftime gets the date wrong (from John Tobey
+ <jtobey@epsilondev.com>)
+ Branch: perl
+ ! ext/POSIX/POSIX.xs t/lib/posix.t
+____________________________________________________________________________
+[ 5144] By: gsar on 2000/02/19 16:02:40
+ Log: don't blindly set bool=char on linux (from Andy Dougherty)
+ Branch: perl
+ ! handy.h hints/linux.sh x2p/a2p.h
+____________________________________________________________________________
+[ 5143] By: gsar on 2000/02/19 15:54:04
+ Log: some rearrangement of the includes for easier "microperl" build;
+ add PERL_MICRO guards supplied by Simon Cozens <simon@brecon.co.uk>
+ Branch: perl
+ ! doio.c perl.c perl.h pp_hot.c pp_sys.c toke.c util.c
+____________________________________________________________________________
+[ 5142] By: gsar on 2000/02/19 15:22:17
+ Log: fixes for Pod::Html issues (from Wolfgang Laun
+ <wolfgang.laun@chello.at>)
+ Branch: perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 5141] By: gsar on 2000/02/19 08:27:29
+ Log: grammos (spotted by Tom Christiansen)
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 5140] By: gsar on 2000/02/19 08:17:04
+ Log: various xsubpp enhancements that make it easier to use with
+ C::Scan (from Ilya Zakharevich)
+
+ TODO: still needs documentation
+ Branch: perl
+ ! lib/ExtUtils/xsubpp
+____________________________________________________________________________
+[ 5139] By: gsar on 2000/02/19 07:55:18
+ Log: s/croak/Perl_croak/
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 5138] By: gsar on 2000/02/19 07:51:39
+ Log: make comparisons promote to utf8 as necessary (from Gisle Aas)
+ Branch: perl
+ ! Todo-5.6 embed.h embed.pl global.sym objXSUB.h perlapi.c
+ ! pp_hot.c proto.h sv.c toke.c
+____________________________________________________________________________
+[ 5137] By: gsar on 2000/02/19 07:42:12
+ Log: set close-on-exec flag on sockets too, like we do for files
+ and pipes
+ Branch: perl
+ ! pod/perldelta.pod pod/perlfunc.pod pod/perlvar.pod pp_sys.c
+____________________________________________________________________________
+[ 5136] By: gsar on 2000/02/19 07:23:48
+ Log: allocate sufficient buffer sizes for 64-bit wide utf8 characters
+ permitted by change#5011 (from Gisle Aas)
+ Branch: perl
+ ! pp.c utf8.c utf8.h
+____________________________________________________________________________
+[ 5135] By: gsar on 2000/02/19 06:53:13
+ Log: s/WARN_PRECEDENCE/WARN_BAREWORD/, vide change#5131
+ Branch: perl
+ ! lib/warnings.pm op.c warnings.h warnings.pl
+____________________________________________________________________________
+[ 5134] By: gsar on 2000/02/19 06:36:46
+ Log: s/byte/bytes/g remnants
+ Branch: perl
+ ! lib/bytes.pm lib/bytes_heavy.pl
+____________________________________________________________________________
+[ 5133] By: gsar on 2000/02/19 06:33:49
+ Log: rename byte:: to bytes::
+ Branch: perl
+ +> lib/bytes.pm lib/bytes_heavy.pl
+ - lib/byte.pm lib/byte_heavy.pl
+ ! MANIFEST lib/charnames.pm lib/utf8.pm pod/perldelta.pod
+ ! pod/perltoc.pod pod/perlunicode.pod pod/perlvar.pod
+ ! t/lib/charnames.t t/op/ver.t
+____________________________________________________________________________
+[ 5132] By: gsar on 2000/02/19 05:58:42
+ Log: English names for $^R and $^S
+ Branch: perl
+ ! lib/English.pm pod/perlvar.pod
+____________________________________________________________________________
+[ 5131] By: gsar on 2000/02/19 05:44:20
+ Log: rename "Probable precendence problem" diagnostic to "Bareword found
+ in conditional" to better reflect the class of error (as suggested
+ by Larry)
+ Branch: perl
+ ! op.c pod/perldelta.pod pod/perldiag.pod t/pragma/warn/op
+____________________________________________________________________________
+[ 5130] By: gsar on 2000/02/19 05:43:10
+ Log: fix outdated info about PerlClinic and the bug-tracking system
+ Branch: perl
+ ! pod/perlfaq2.pod pod/perltodo.pod
+____________________________________________________________________________
+[ 5129] By: gsar on 2000/02/19 04:14:19
+ Log: some fixes for mingw32/GCC (SETERRNO() still appears to
+ trash memory)
+ Branch: perl
+ ! README.win32 t/lib/safe2.t t/op/mkdir.t win32/makefile.mk
+ ! win32/win32.h
+____________________________________________________________________________
+[ 5128] By: gsar on 2000/02/18 06:55:33
+ Log: avoid $@-clearing sideeffect of require in Carp
+ Branch: perl
+ ! lib/Carp.pm
+____________________________________________________________________________
+[ 5127] By: gsar on 2000/02/18 04:58:26
+ Log: stronger testcase for change#5126
+ Branch: perl
+ ! t/op/pat.t
+____________________________________________________________________________
+[ 5126] By: gsar on 2000/02/18 04:44:28
+ Log: make /\S/ match the same things /[\S]/ matches; likewise for
+ \D (from Rick Delaney <rick@consumercontact.com>)
+ Branch: perl
+ ! regexec.c t/op/pat.t
+____________________________________________________________________________
+[ 5125] By: gsar on 2000/02/18 03:57:43
+ Log: Compiler fixups from Jan Dubois
+ Branch: perl
+ ! ext/B/B.pm ext/B/B.xs ext/B/B/C.pm utils/perlcc.PL
+____________________________________________________________________________
+[ 5124] By: jhi on 2000/02/17 22:09:09
+ Log: Take out the -Wl,-z as we have survice so far without.
+ Branch: cfgperl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 5123] By: jhi on 2000/02/17 18:40:17
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> dump.c ext/ODBM_File/ODBM_File.xs t/op/split.t
+____________________________________________________________________________
+[ 5122] By: gsar on 2000/02/17 18:01:14
+ Log: fix test that depends on op_dump() output
+ Branch: perl
+ ! t/op/split.t
+____________________________________________________________________________
+[ 5121] By: gsar on 2000/02/17 17:55:18
+ Log: op_dump() tweak
+ Branch: perl
+ ! dump.c
+____________________________________________________________________________
+[ 5120] By: jhi on 2000/02/16 23:11:04
+ Log: Regularize the use* questions, and replace
+ "Configure *must* be run with -Duse..." with.
+ "can be run".
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: metaconfig
+ ! U/threads/usethreads.U
+ Branch: metaconfig/U/perl
+ ! use64bits.U uselfs.U uselongdbl.U uselonglong.U
+ ! usemultiplicity.U useperlio.U usesocks.U
+____________________________________________________________________________
+[ 5119] By: jhi on 2000/02/16 22:29:11
+ Log: HP-UX 64-bitness/largefile fixes.
+ Branch: cfgperl
+ ! Configure config_h.SH ext/SDBM_File/sdbm/sdbm.c hints/hpux.sh
+ ! perl.h
+ Branch: metaconfig
+ ! U/modified/cc.U U/modified/libpth.U U/modified/libs.U
+ Branch: metaconfig/U/perl
+ ! Extensions.U
+____________________________________________________________________________
+[ 5118] By: jhi on 2000/02/16 19:47:51
+ Log: Fcntl: more O_ constants, move SEEK_ to @EXPORT_OK
+ (tag :seek), add S_I constants (and functions) (tag :mode);
+ refer only to the SEEK_ of Fcntl, not the ones from
+ POSIX or IO::; add SHUT_ to Socket; get trigonometric
+ functions from Math::Trig instead of POSIX.
+ Branch: cfgperl
+ ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs ext/Socket/Socket.pm
+ ! ext/Socket/Socket.xs perl.h pod/perldelta.pod pod/perlfunc.pod
+ ! pod/perlopentut.pod t/lib/syslfs.t
+ Branch: metaconfig/U/perl
+ + i_sysmode.U
+____________________________________________________________________________
+[ 5117] By: gsar on 2000/02/16 06:39:06
+ Log: avoid warnings due to redefined NULL
+ Branch: perl
+ ! ext/ODBM_File/ODBM_File.xs
+____________________________________________________________________________
+[ 5116] By: gsar on 2000/02/16 00:10:25
+ Log: integrate cfgperl changes into mainline
+ Branch: perl
+ !> Configure Makefile.SH Porting/Glossary Porting/config.sh
+ !> Porting/config_H config_h.SH ext/Sys/Hostname/Hostname.xs
+ !> ext/Sys/Syslog/Syslog.xs hints/aix.sh hints/hpux.sh
+ !> lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm myconfig.SH
+____________________________________________________________________________
+[ 5115] By: jhi on 2000/02/15 23:11:55
+ Log: Probe for <sys/utsname.h>.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH ext/Sys/Hostname/Hostname.xs
+ Branch: metaconfig/U/perl
+ + i_sysutsname.U
+____________________________________________________________________________
+[ 5114] By: jhi on 2000/02/15 22:59:59
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ +> ext/Sys/Hostname/Hostname.pm ext/Sys/Hostname/Hostname.xs
+ +> ext/Sys/Hostname/Makefile.PL
+ - lib/Sys/Hostname.pm
+ !> (integrate 41 files)
+____________________________________________________________________________
+[ 5113] By: gsar on 2000/02/15 21:22:18
+ Log: update Changes, patchlevel
+ Branch: perl
+ ! Changes patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
[ 5112] By: gsar on 2000/02/15 20:57:12
Log: fix change#5104 under useithreads
Branch: perl
README.os2 Notes about OS/2 port
README.os390 Notes about OS/390 (nee MVS) port
README.plan9 Notes about Plan9 port
-README.posix-bc Notes about BC2000 POSIX port
+README.posix-bc Notes about BS2000 POSIX port
README.qnx Notes about QNX port
README.threads Notes about multithreading
README.vmesa Notes about VM/ESA port
-README.vms Notes about VMS port
+README.vms Notes about installing the VMS port
README.vos Notes about Stratus VOS port
README.win32 Notes about Win32 port
Todo The Wishlist
t/pragma/warn/6default Tests default warnings
t/pragma/warn/7fatal Tests fatal warnings
t/pragma/warn/8signal Tests warnings + __WARN__ and __DIE__
+t/pragma/warn/9enabled Tests warnings
t/pragma/warn/av Tests for av.c for warnings.t
t/pragma/warn/doio Tests for doio.c for warnings.t
t/pragma/warn/doop Tests for doop.c for warnings.t
extra.pods: miniperl
-@test -f extra.pods && rm -f `cat extra.pods`
-@rm -f extra.pods
- -@for x in `grep -l '^=[a-z]' README.*` ; do \
+ -@for x in `grep -l '^=[a-z]' README.* | grep -v README.vms` ; do \
nx=`echo $$x | sed -e "s/README\.//"`; \
$(LNS) ../$$x "pod/perl"$$nx".pod" ; \
echo "pod/perl"$$nx".pod" >> extra.pods ; \
done
+ -@test -f README.vms && $(LNS) ../README.vms pod/README_vms.pod && echo "pod/README_vms.pod" >> extra.pods
+ -@test -f vms/perlvms.pod && $(LNS) ../vms/perlvms.pod pod/perlvms.pod && echo "pod/perlvms.pod" >> extra.pods
install: all install.perl install.man
# XXX Experimental. Hardwired values, but useful for testing.
# Eventually Configure could ask for some of these values.
install.html: all installhtml
+ -@test -f pod/README_vms.pod && rm -f pod/README_vms.pod
+ -@test -f README.vms && $(LNS) ../README.vms vms/README_vms.pod
+ -@test -f pod/perlvms.pod && rm -f pod/perlvms.pod
$(LDLIBPTH) ./perl installhtml \
--podroot=. --podpath=. --recurse \
--htmldir=$(privlib)/html \
_mopup:
rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c
-@test -f extra.pods && rm -f `cat extra.pods`
+ -@test -f vms/README_vms.pod && rm -f vms/README_vms.pod
-rm -f perl.exp ext.libs extra.pods
-rm -f perl.export perl.dll perl.libexp perl.map perl.def
-rm -f perl.loadmap miniperl.loadmap perl.prelmap miniperl.prelmap
-Last revised 27-October-1999 by Craig Berry <craig.berry@metamor.com>
-Revised 01-March-1999 by Dan Sugalski <dan@sidhe.org>
-Originally by Charles Bailey <bailey@newman.upenn.edu>
+If you read this file _as_is_, just ignore the equal signs on the left.
+This file is written in the POD format (see [.POD]PERLPOD.POD;1) which is
+specially designed to be readable as is.
-* Important safety tip
+=head1 NAME
+
+README.vms - Configuring, building, testing, and installing perl on VMS
+
+=head1 SYNOPSIS
+
+To configure, build, test, and install perl on VMS:
+
+ @ Configure
+ mms
+ mms test
+ mms install
+
+mmk may be used in place of mms in the last three steps.
+
+=head1 DESCRIPTION
+
+=head2 Important safety tip
The build and install procedures have changed significantly from the 5.004
-releases! Make sure you read the "Building Perl" and "Installing Perl"
-sections of this document before you build or install.
+releases! Make sure you read the "Configuring the Perl Build", "Building
+Perl", and "Installing Perl" sections of this document before you build or
+install.
-Also note that, as of 5.005, an ANSI C compliant compiler is required to
-build Perl. Vax C is *not* ANSI compliant, as it died a natural death some
-time before the standard was set. Therefore Vax C will not compile perl
-5.005. Sorry about that.
+Also note that, as of Perl version 5.005 and later, an ANSI C compliant
+compiler is required to build Perl. VAX C is *not* ANSI compliant, as it
+died a natural death some time before the standard was set. Therefore
+VAX C will not compile perl 5.005. We are sorry about that.
-If you're stuck without Dec C (the Vax C license should be good for Dec C,
+If you are stuck without DEC C (the VAX C license should be good for DEC C,
but the media charges might prohibit an upgrade), consider getting Gnu C
instead.
-* Intro
+
+=head2 Introduction
The VMS port of Perl is as functionally complete as any other Perl port
(and as complete as the ports on some Unix systems). The Perl binaries
provide all the Perl system calls that are either available under VMS or
-reasonably emulated. There are some incompatibilites in process handling
-(e.g the fork/exec model for creating subprocesses doesn't do what you
+reasonably emulated. There are some incompatibilities in process handling
+(e.g. the fork/exec model for creating subprocesses doesn't do what you
might expect under Unix), mainly because VMS and Unix handle processes and
sub-processes very differently.
-There are still some unimplemented system functions, and of coursse we
+There are still some unimplemented system functions, and of course we
could use modules implementing useful VMS system services, so if you'd like
-to lend a hand we'd love to have you. Join the Perl Porting Team Now!
+to lend a hand we'd love to have you. Join the Perl Porting Team Now!
The current sources and build procedures have been tested on a VAX using
-Dec C, and on an AXP using Dec C. If you run into problems with
+DEC C, and on an AXP using DEC C. If you run into problems with
other compilers, please let us know.
-There are issues with varions versions of Dec C, so if you're not running a
-relatively modern version, check the Dec C issues section later on in this
+There are issues with various versions of DEC C, so if you're not running a
+relatively modern version, check the "DEC C issues" section later on in this
document.
-* Other required software
+=head2 Other required software
+
+In addition to VMS and DCL you will need two things:
-In addition to VMS, you'll need:
- 1) A C compiler. Dec C or gcc for AXP or the VAX.
- 2) A make tool. Dec's MMS (v2.6 or later), or MadGoat's free MMS
- analog MMK (available from ftp.madgoat.com/madgoat) both work
- just fine. Gnu Make might work, but it's been so long since
- anyone's tested it that we're not sure. MMK's free, though, so
- go ahead and use that.
+=over 4
+
+=item 1 A C compiler.
+
+DEC C or gcc for VMS (AXP or VAX).
+
+=item 2 A make tool.
+
+DEC's MMS (v2.6 or later), or MadGoat's free MMS
+analog MMK (available from ftp.madgoat.com/madgoat) both work
+just fine. Gnu Make might work, but it's been so long since
+anyone's tested it that we're not sure. MMK is free though, so
+go ahead and use that.
+
+=back
+
+=head2 Additional software that is optional
You may also want to have on hand:
- 1) UNZIP.EXE for VMS available from a number of web/ftp sites.
- http://www.cdrom.com/pub/infozip/UnZip.html
- http://www.openvms.digital.com/cd/INFO-ZIP/
- ftp://ftp.digital.com/pub/VMS/
- ftp://ftp.openvms.digital.com/
- ftp://ftp.madgoat.com/madgoat/
- ftp://ftp.wku.edu/vms/
- 2) GUNZIP/GZIP.EXE for VMS available from a number of web/ftp sites.
+
+=over 4
+
+=item 1 GUNZIP/GZIP.EXE for VMS
+
+A de-compressor for *.gz and *.tgz files available from a number
+of web/ftp sites.
+
http://www.fsf.org/order/ftp.html
ftp://ftp.uu.net/archive/systems/gnu/diffutils*.tar.gz
ftp://gatekeeper.dec.com/pub/GNU/diffutils*.tar.gz
ftp://ftp.gnu.org/pub/gnu/diffutils*.tar.gz
http://www.openvms.digital.com/cd/GZIP/
ftp://ftp.digital.com/pub/VMS/
- 3) VMS TAR also available from a number of web/ftp sites.
+
+=item 2 VMS TAR
+
+For reading and writing unix tape archives (*.tar files). Vmstar is also
+available from a number of web/ftp sites.
+
ftp://ftp.lp.se/vms/
http://www.openvms.digital.com/cd/VMSTAR/
ftp://ftp.digital.com/pub/VMS/
+
+=item 3 UNZIP.EXE for VMS
+
+A combination decompressor and archive reader/writer for *.zip files.
+Unzip is available from a number of web/ftp sites.
+
+ http://www.cdrom.com/pub/infozip/UnZip.html
+ http://www.openvms.digital.com/cd/INFO-ZIP/
+ ftp://ftp.digital.com/pub/VMS/
+ ftp://ftp.openvms.digital.com/
+ ftp://ftp.madgoat.com/madgoat/
+ ftp://ftp.wku.edu/vms/
+
+=item 4 MOST
+
+Most is an optional pager that is convenient to use with perldoc (unlike
+TYPE/PAGE, MOST can go forward and backwards in a document and supports
+regular expression searching). Most builds with the slang
+library on VMS. Most and slang are available from:
+
+ ftp://space.mit.edu/pub/davis/
+ ftp://ftp.wku.edu/vms/narnia/most.zip
+
+=back
+
Please note that UNZIP and GUNZIP are not the same thing (they work with
-different formats). Most of the useful files from CPAN (the Comprehensive
-Perl Archive Network) are in .tar.gz format (this includes copies of the
+different formats). Many of the useful files from CPAN (the Comprehensive
+Perl Archive Network) are in *.tar.gz format (this includes copies of the
source code for perl as well as modules and scripts that you may wish to
add later) hence you probably want to have GUNZIP.EXE and VMSTAR.EXE on
your VMS machine.
-If you want to include socket support, you'll need a TCP stack and either
-Dec C, or socket libraries. See the Socket Support topic for more details.
-
-* Building Perl
+If you want to include socket support, you'll need a TCP/IP stack and either
+DEC C, or socket libraries. See the "Socket Support (optional)" topic
+for more details.
-Building perl has two steps, configuration and compilation.
+=head1 Configuring the Perl build
To configure perl (a necessary first step), issue the command
- @CONFIGURE
+ @ Configure
-from the top of an unpacked perl directory. You'll be asked a series of
-questions, and the answers to them (along with the capabilities of your C
-compiler and network stack) will determine how perl's built.
+from the top of an unpacked perl source directory. You will be asked a
+series of questions, and the answers to them (along with the capabilities
+of your C compiler and network stack) will determine how perl is custom
+built for your machine.
-If you've got multiple C compilers installed, you'll have your choice of
-which one to use. Various older versions of Dec C had some gotchas, so if
-you're using a version older than 5.2, check the Dec C Issues section.
+If you have multiple C compilers installed, you'll have your choice of
+which one to use. Various older versions of DEC C had some caveats, so if
+you're using a version older than 5.2, check the "DEC C Issues" section.
-The configuration script will print out, at the very end, the MMS or MMK
-command you need to compile perl. Issue it (exactly as printed) to start
-the build. If you have any symbols or logical names in your environment
-that may interfere with the build or regression testing of perl then
-configure.com will try to warn you about them. If a logical name is causing
+If you have any symbols or logical names in your environment that may
+interfere with the build or regression testing of perl then configure.com
+will try to warn you about them. If a logical name is causing
you trouble but is in an LNM table that you do not have write access to
then try defining your own to a harmless equivalence string in a table
such that it is resolved before the other (e.g. if TMP is defined in the
-SYSTEM table then try DEFINE TMP "NL:" or somesuch) otherwise simply deasign
-the dangerous logical names. The potentially troublesome logicals and
-symbols are:
+SYSTEM table then try DEFINE TMP "NL:" or somesuch in your process table)
+otherwise simply deassign the dangerous logical names. The potentially
+troublesome logicals and symbols are:
TMP "LOGICAL"
LIB "LOGICAL"
EXT "LOGICAL"
TEST "SYMBOL"
-Once you issue your MMS command, sit back and wait. Perl should build and
-link without a problem. If it doesn't, check the Gotchas to watch out for
-section. If that doesn't help, send some mail to the VMSPERL mailing list.
-Instructions are in the Mailing Lists section.
-
As a handy shortcut, the command:
- @CONFIGURE "-des"
+ @ Configure "-des"
+
+(note the quotation marks and case) will choose reasonable defaults
+automatically (it takes DEC C over Gnu C, DEC C sockets over SOCKETSHR
+sockets, and either over no sockets). More help with configure.com is
+available from:
+
+ @ Configure "-h"
+
+See the "Changing compile-time options (optional)" section below to learn
+even more details about how to influence the outcome of the important
+configuration step. If you find yourself reconfiguring and rebuilding
+then be sure to also follow the advice in the "Cleaning up and starting
+fresh (optional)" and the checklist of items in the "CAVEATS" sections
+below.
+
+=head2 Changing compile-time options (optional)
+
+Most of the user definable features of Perl are enabled or disabled in
+[.VMS]CONFIG.VMS. There is code in there to Do The Right Thing, but that
+may end up being the wrong thing for you. Make sure you understand what
+you are doing since inappropriate changes to CONFIG.VMS can render perl
+unbuildable.
+
+Odds are that there's nothing here to change, unless you're on a version of
+VMS later than 6.2 and DEC C later than 5.6. Even if you are, the correct
+values will still be chosen, most likely. Poking around here should be
+unnecessary.
+
+The one exception is the various *DIR install locations. Changing those
+requires changes in genconfig.pl as well. Be really careful if you need to
+change these, as they can cause some fairly subtle problems.
+
+=head2 Socket Support (optional)
+
+Perl includes a number of functions for IP sockets, which are available if
+you choose to compile Perl with socket support. Since IP networking is an
+optional addition to VMS, there are several different IP stacks available.
+How well integrated they are into the system depends on the stack, your
+version of VMS, and the version of your C compiler.
+
+The most portable solution uses the SOCKETSHR library. In combination with
+either UCX or NetLib, this supports all the major TCP stacks (Multinet,
+Pathways, TCPWare, UCX, and CMU) on all versions of VMS Perl runs on, with
+all the compilers on both VAX and Alpha. The socket interface is also
+consistent across versions of VMS and C compilers. It has a problem with
+UDP sockets when used with Multinet, though, so you should be aware of
+that.
+
+The other solution available is to use the socket routines built into DEC
+C. Which routines are available depend on the version of VMS you're
+running, and require proper UCX emulation by your TCP/IP vendor.
+Relatively current versions of Multinet, TCPWare, Pathway, and UCX all
+provide the required libraries--check your manuals or release notes to see
+if your version is new enough.
+
+=head1 Building Perl
+
+The configuration script will print out, at the very end, the MMS or MMK
+command you need to compile perl. Issue it (exactly as printed) to start
+the build.
-(note the quotation marks and case) will choose reasonable defaults. (It
-takes Dec C over Gnu C, Dec C sockets over SOCKETSHR sockets, and either
-over no sockets)
+Once you issue your MMS or MMK command, sit back and wait. Perl should
+compile and link without a problem. If a problem does occur check the
+"CAVEATS" section of this document. If that does not help send some
+mail to the VMSPERL mailing list. Instructions are in the "Mailing Lists"
+section of this document.
-* Testing Perl
+=head1 Testing Perl
-Once Perl has built cleanly, you need to test it to make sure things work.
-This step is very important--there are always things that can go wrong
-somehow and get you a dysfunctional Perl.
+Once Perl has built cleanly you need to test it to make sure things work.
+This step is very important since there are always things that can go wrong
+somehow and yield a dysfunctional Perl for you.
Testing is very easy, though, as there's a full test suite in the perl
-distribution. To run the tests, enter the *exact* MMS line you used to
+distribution. To run the tests, enter the *exact* MMS line you used to
compile Perl and add the word "test" to the end, like this:
-Compile Command:
+If the compile command was:
-$MMS
+ MMS
-Test Command:
+then the test command ought to be:
-$MMS test
+ MMS test
-MMS will run all the tests. This may take some time, as there are a lot of
-tests. If any tests fail, there will be a note made on-screen. At the end
-of all the tests, a summary of the tests, the number passed and failed, and
-the time taken will be displayed.
+MMS (or MMK) will run all the tests. This may take some time, as there are
+a lot of tests. If any tests fail, there will be a note made on-screen.
+At the end of all the tests, a summary of the tests, the number passed and
+failed, and the time taken will be displayed.
-If any tests fail, it means something's wrong with Perl. If the test suite
+If any tests fail, it means something is wrong with Perl. If the test suite
hangs (some tests can take upwards of two or three minutes, or more if
you're on an especially slow machine, depending on your machine speed, so
don't be hasty), then the test *after* the last one displayed failed. Don't
install Perl unless you're confident that you're OK. Regardless of how
confident you are, make a bug report to the VMSPerl mailing list.
-If one or more tests fail, you can get more info on the failure by issuing
-this command sequence:
+If one or more tests fail, you can get more information on the failure by
+issuing this command sequence:
-$ @[.VMS]TEST .typ "" "-v" [.subdir]test.T
+ @ [.VMS]TEST .typ "" "-v" [.subdir]test.T
where ".typ" is the file type of the Perl images you just built (if you
didn't do anything special, use .EXE), and "[.subdir]test.T" is the test
that failed. For example, with a normal Perl build, if the test indicated
that [.op]time failed, then you'd do this:
-$ @[.VMS]TEST .EXE "" "-v" [.OP]TIME.T
+ @ [.VMS]TEST .EXE "" "-v" [.OP]TIME.T
When you send in a bug report for failed tests, please include the output
from this command, which is run from the main source directory:
-MCR []MINIPERL "-V"
+ MCR []MINIPERL "-V"
+
+Note that -"V" really is a capital V in double quotes. This will dump out a
+couple of screens worth of configuration information, and can help us
+diagnose the problem. If (and only if) that did not work then try enclosing
+the output of:
+
+ MMS printconfig
-Note that "-V" really is a capital V in double quotes. This will dump out a
-couple of screens worth of config info, and can help us diagnose the problem.
If (and only if) that did not work then try enclosing the output of:
-@[.vms]myconfig
+ @ [.vms]myconfig
-* Cleaning up and starting fresh
+You may also be asked to provide your C compiler version ("CC/VERSION NL:"
+with DEC C, "gcc --version" with GNU CC). To obtain the version of MMS or
+MMK you are running try "MMS/ident" or "MMK /ident". The GNU make version
+can be identified with "make --version".
+
+=head2 Cleaning up and starting fresh (optional)
If you need to recompile from scratch, you have to make sure you clean up
-first. There's a procedure to do it--enter the *exact* MMS line you used to
-compile and add "realclean" at the end, like this:
+first. There is a procedure to do it--enter the *exact* MMS line you used
+to compile and add "realclean" at the end, like this:
-Compile Command:
+if the compile command was:
-$MMS
+ MMS
-Cleanup Command:
+then the cleanup command ought to be:
-$MMS realclean
+ MMS realclean
-If you don't do this, things may behave erratically. They might not, too,
-so it's best to be sure and do it.
+If you do not do this things may behave erratically during the subsequent
+rebuild attempt. They might not, too, so it is best to be sure and do it.
-* Installing Perl
+=head1 Installing Perl
There are several steps you need to take to get Perl installed and
running.
1) Create a directory somewhere and define the concealed logical PERL_ROOT
-to point to it. For example, DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
+to point to it. For example,
+
+ CREATE/DIRECTORY dka200:[perl]
+ DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
2) Run the install script via:
-MMS install
+ MMS install
or
-MMK install
+ MMK install
If for some reason it complains about target INSTALL being up to date,
throw a /FORCE switch on the MMS or MMK command.
-The script [.VMS]PERL_SETUP.COM that is written by CONFIGURE.COM
+The DCL script [.VMS]PERL_SETUP.COM that is written by CONFIGURE.COM
will take care of most of the following:
-3) Either define the symbol PERL somewhere, such as
-SYS$MANAGER:SYLOGIN.COM, to be "PERL :== $PERL_ROOT:[000000]PERL.EXE", or
-install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
-into DCLTABLES" for more info), or put the image in a directory that's in
-your DCL$PATH (if you're using VMS 6.2 or higher).
+3) Either create the global foreign symbol PERL somewhere, such as
+SYS$MANAGER:SYLOGIN.COM, to be
+
+ $ PERL :== "$PERL_ROOT:[000000]PERL.EXE"
+
+or install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
+into DCLTABLES (optional)" for more information), or put the image in a
+directory that's in your DCL$PATH (if you're using VMS V6.2 or higher).
4) Either define the logical name PERLSHR somewhere
-(such as in PERL_SETUP.COM) like so:
-DEFINE/NOLOG PERLSHR PERL_ROOT:[000000]PERLSHR.EXE
-or copy perl_root:[000000]perlshr.exe sys$share:.
+(such as in PERL_SETUP.COM) like so
+
+ $ DEFINE/NOLOG PERLSHR PERL_ROOT:[000000]PERLSHR.EXE
+
+or copy the file into the system shareable library directory with
+
+ copy perl_root:[000000]perlshr.exe sys$share:
5) Optionally define the command PERLDOC as
-PERLDOC == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -t"
-Note that if you wish to use most as a pager please see
-ftp://space.mit.edu/pub/davis/ for both most and slang (or perhaps
-ftp://ftp.wku.edu/vms/narnia/most.zip ).
+
+ $ PERLDOC == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -t"
+
+(See above for where to find the B<most> pager for use with perldoc).
6) Optionally define the command PERLBUG (the Perl bug report generator) as
-PERLBUG == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
+
+ $ PERLBUG == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
7) Optionally define the command POD2MAN (Converts POD files to nroff
source suitable for converting to man pages. Also quiets complaints during
module builds) as
-DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
-POD2MAN == "$PERL_ROOT:[000000]PERL POD2MAN"
+ $ DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
+ $ POD2MAN == "$PERL_ROOT:[000000]PERL POD2MAN"
8) Optionally define the command POD2TEXT (Converts POD files to text,
-which is required for perldoc -f to work properly) as
+which is required for B<perldoc -f> to work properly) as
-DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
-POD2TEXT == "$PERL_ROOT:[000000]PERL POD2TEXT"
+ $ DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
+ $ POD2TEXT == "$PERL_ROOT:[000000]PERL POD2TEXT"
-In all these cases, if you've got PERL defined as a foreign command, you
-can replace $PERL_ROOT:[000000]PERL with ''perl'. If you've installed perl
-into DCLTABLES, replace it with just perl.
+In all these cases, if you've got PERL defined as a foreign command symbol,
+you can replace $PERL_ROOT:[000000]PERL with ''perl'. If you have installed
+perl into DCLTABLES, replace it with just perl.
-* Installing Perl into DCLTABLES
+=head2 Installing Perl into DCLTABLES (optional)
Execute the following command file to define PERL as a DCL command.
-You'll need CMKRNL priv to install the new dcltables.exe.
+You'll need CMKRNL privilege to install the new dcltables.exe.
$ create perl.cld
!
$ install replace sys$common:[syslib]dcltables.exe
$ exit
-* Changing compile-time things
-
-Most of the user-definable features of Perl are enabled or disabled in
-[.VMS]CONFIG.VMS. There's code in there to Do The Right Thing, but that may
-end up being the wrong thing for you. Make sure you understand what you're
-doing, since changes here can get you a busted perl.
-
-Odds are that there's nothing here to change, unless you're on a version of
-VMS later than 6.2 and Dec C later than 5.6. Even if you are, the correct
-values will still be chosen, most likely. Poking around here should be
-unnecessary.
-
-The one exception is the various *DIR install locations. Changing those
-requires changes in genconfig.pl as well. Be really careful if you need to
-change these, as they can cause some fairly subtle problems.
-
-* INSTALLing images
+=head2 INSTALLing images (optional)
On systems that are using perl quite a bit, and particularly those with
minimal RAM, you can boost the performance of perl by INSTALLing it as
invoked.
INSTALL ADD PERLSHR/SHARE
+ INSTALL ADD PERL/HEADER
should be enough for PERLSHR.EXE (/share implies /header and /open),
while /HEADER should do for PERL.EXE (perl.exe is not a shared image).
-If your code 'use's modules, check to see if there's an executable for
-them, too. In the base perl build, POSIX, IO, Fcntl, Opcode, SDBM_File,
+If your code 'use's modules, check to see if there is a shareable image for
+them, too. In the base perl build, POSIX, IO, Fcntl, Opcode, SDBM_File,
DCLsym, and Stdio all have shared images that can be installed /SHARE.
-How much of a win depends on your memory situation, but if you're firing
+How much of a win depends on your memory situation, but if you are firing
off perl with any regularity (like more than once every 20 seconds or so)
-it's probably a win.
+it is probably beneficial to INSTALL at least portions of perl.
While there is code in perl to remove privileges as it runs you are advised
to NOT INSTALL PERL.EXE with PRIVs!
-* Extra things in the Perl distribution
-
-In addition to the standard stuff that gets installed, there are two
-optional extensions, DCLSYM and STDIO, that are handy. Instructions for
-these two modules are in [.VMS.EXT.DCLSYM] and [.VMS.EXT.STDIO],
-respectively. They are built automatically for versions of perl >= 5.005.
-
-* Socket Support
-
-Perl includes a number of functions for IP sockets, which are available if
-you choose to compile Perl with socket support (see the section Compiling
-Perl for more info on selecting a socket stack). Since IP networking is an
-optional addition to VMS, there are several different IP stacks
-available. How well integrated they are into the system depends on the
-stack, your version of VMS, and the version of your C compiler.
-
-The most portable solution uses the SOCKETSHR library. In combination with
-either UCX or NetLib, this supports all the major TCP stacks (Multinet,
-Pathways, TCPWare, UCX, and CMU) on all versions of VMS Perl runs on, with
-all the compilers on both VAX and Alpha. The socket interface is also
-consistent across versions of VMS and C compilers. It has a problem with
-UDP sockets when used with Multinet, though, so you should be aware of
-that.
-
-The other solution available is to use the socket routines built into Dec
-C. Which routines are available depend on the version of VMS you're
-running, and require proper UCX emulation by your TCP/IP vendor.
-Relatively current versions of Multinet, TCPWare, Pathway, and UCX all
-provide the required libraries--check your manuals or release notes to see
-if your version is new enough.
-
-* Reporting Bugs
+=head1 Reporting Bugs
If you come across what you think might be a bug in Perl, please report
it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
installation, and is very handy. Completed bug reports should go to
perlbug@perl.com.
-* Gotchas to watch out for
+=head1 CAVEATS
Probably the single biggest gotcha in compiling Perl is giving the wrong
-switches to MMS/MMK when you build. Use *exactly* what the configure script
-prints!
-
-The next big gotcha is directory depth. Perl can create directories four
-and five levels deep during the build, so you don't have to be too deep to
-start to hit the RMS 8 level point. It's best to do a
-$DEFINE/TRANS=(CONC,TERM) PERLSRC disk:[dir.dir.dir.perldir.]" (note the
-trailing period) and $SET DEFAULT PERLSRC:[000000] before building. Perl
-modules can be just as bad (or worse), so watch out for them, too. The
-configuration script will warn if it thinks you're too deep (at least on
-versions of VMS prior to 7.2).
-
-Finally, the third thing that bites people is leftover pieces from a failed
-build. If things go wrong, make sure you do a "(MMK|MMS|make) realclean"
+switches to MMS/MMK when you build. Use *exactly* what the configure.com
+script prints!
+
+The next big gotcha is directory depth. Perl can create directories four,
+five, or even six levels deep during the build, so you don't have to be
+too deep to start to hit the RMS 8 level limit (for versions of VMS prior
+to V7.2 and even with V7.2 on the VAX). It is best to do
+
+ DEFINE/TRANS=(CONC,TERM) PERLSRC "disk:[dir.dir.dir.perldir.]"
+ SET DEFAULT PERLSRC:[000000]
+
+before building in cases where you have to unpack the distribution so deep
+(note the trailing period in the definition of PERLSRC). Perl modules
+from CPAN can be just as bad (or worse), so watch out for them, too. Perl's
+configuration script will warn if it thinks you are too deep (at least on
+a VAX or on Alpha versions of VMS prior to 7.2). But MakeMaker will not
+warn you if you start out building a module too deep in a directory.
+
+Be sure that the process that you use to build perl has a PGFLQ greater
+than 100000. Be sure to have a correct local time zone to UTC offset
+defined (in seconds) in the logical name SYS$TIMEZONE_DIFFERENTIAL before
+running the regression test suite. The SYS$MANAGER:UTC$CONFIGURE_TDF.COM
+procedure will help you set that logical for your system but may require
+system privileges. For example, a location 5 hours west of UTC (such as
+the US East coast while not on daylight savings time) would have:
+
+ DEFINE SYS$TIMEZONE_DIFFERENTIAL "-18000"
+
+A final thing that causes trouble is leftover pieces from a failed
+build. If things go wrong make sure you do a "(MMK|MMS|make) realclean"
before you rebuild.
-* Dec C issues
+=head2 DEC C issues
-Note to DECC users: Some early versions (pre-5.2, some pre-4. If you're Dec
+Note to DEC C users: Some early versions (pre-5.2, some pre-4. If you're DEC
C 5.x or higher, with current patches if any, you're fine) of the DECCRTL
contained a few bugs which affect Perl performance:
- - Newlines are lost on I/O through pipes, causing lines to run together.
- This shows up as RMS RTB errors when reading from a pipe. You can
- work around this by having one process write data to a file, and
- then having the other read the file, instead of the pipe. This is
- fixed in version 4 of DECC.
- - The modf() routine returns a non-integral value for some values above
- INT_MAX; the Perl "int" operator will return a non-integral value in
- these cases. This is fixed in version 4 of DECC.
- - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine
- changes the process default device and directory permanently, even
- though the call specified that the change should not persist after
- Perl exited. This is fixed by DEC CSC patch AXPACRT04_061.
-
-* Mailing Lists
-
-There are several mailing lists available to the Perl porter. For VMS
+
+=over 4
+
+=item - pipes
+
+Newlines are lost on I/O through pipes, causing lines to run together.
+This shows up as RMS RTB errors when reading from a pipe. You can
+work around this by having one process write data to a file, and
+then having the other read the file, instead of the pipe. This is
+fixed in version 4 of DEC C.
+
+=item - modf()
+
+The modf() routine returns a non-integral value for some values above
+INT_MAX; the Perl "int" operator will return a non-integral value in
+these cases. This is fixed in version 4 of DEC C.
+
+=item - ALPACRT ECO
+
+On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine
+changes the process default device and directory permanently, even
+though the call specified that the change should not persist after
+Perl exited. This is fixed by DEC CSC patch ALPACRT04_061 or later.
+See also:
+
+ http://ftp.service.digital.com/patches/.new/openvms.html
+
+=back
+
+Please note that in later versions "DEC C" may also be known as
+"Compaq C".
+
+=head2 GNU issues
+
+It has been a while since the GNU utilities such as GCC or GNU make
+were used to build perl on VMS. Hence they may require a great deal
+of source code modification to work again.
+
+ http://slacvx.slac.stanford.edu/HELP/GCC
+ http://www.progis.de/
+ http://vms.gnu.org/
+ http://www.lp.se/products/gnu.html
+
+=head1 Mailing Lists
+
+There are several mailing lists available to the Perl porter. For VMS
specific issues (including both Perl questions and installation problems)
-there is the VMSPERL mailing list. It's usually a low-volume (10-12
+there is the VMSPERL mailing list. It is usually a low-volume (10-12
messages a week) mailing list.
-The subscription address is MAJORDOMO@PERL.ORG. Send a mail message with just
-the words SUBSCRIBE VMSPERL in the body of the message.
+The subscription address is MAJORDOMO@PERL.ORG. Send a mail message with
+just the words SUBSCRIBE VMSPERL in the body of the message.
The VMSPERL mailing list address is VMSPERL@PERL.ORG. Any mail sent there
gets echoed to all subscribers of the list. There is a searchable archive of
-the list at <http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/>.
+the list on the web at:
+
+ http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/
To unsubscribe from VMSPERL send the message UNSUBSCRIBE VMSPERL to
MAJORDOMO@PERL.ORG. Be sure to do so from the subscribed account that
-you are cancelling.
+you are canceling.
+
+=head2 Web sites
+
+Vmsperl pages on the web include:
+
+ http://www.sidhe.org/vmsperl/index.html
+ http://duphy4.physics.drexel.edu/pub/cgi_info.htmlx
+ http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/
+ http://www.cpan.org/modules/by-module/VMS/
+ http://nucwww.chem.sunysb.edu/htbin/software_list.cgi
+ http://www.best.com/~pvhp/vms/
+ http://bkfug.kfunigraz.ac.at/~binder/perl.html
-* Acknowledgements
+=head1 SEE ALSO
+
+Perl information for users and programmers about the port of perl to VMS is
+available from the [.VMS]PERLVMS.POD file that gets installed as L<perlvms>.
+For administrators the perlvms document also includes a detailed discussion
+of extending vmsperl with CPAN modules after Perl has been installed.
+
+=head1 AUTHORS
+
+Last revised 13-February-2000 by Peter Prymmer pvhp@best.com.
+Revised 27-October-1999 by Craig Berry craig.berry@metamorgs.com.
+Revised 01-March-1999 by Dan Sugalski dan@sidhe.org.
+Originally by Charles Bailey bailey@newman.upenn.edu.
+
+=head1 ACKNOWLEDGEMENTS
A real big thanks needs to go to Charles Bailey
-<bailey@newman.upenn.edu>, who is ultimately responsible for Perl 5.004
+bailey@newman.upenn.edu, who is ultimately responsible for Perl 5.004
running on VMS. Without him, nothing the rest of us have done would be at
all important.
There are, of course, far too many people involved in the porting and testing
of Perl to mention everyone who deserves it, so please forgive us if we've
missed someone. That said, special thanks are due to the following:
- Tim Adye <T.J.Adye@rl.ac.uk>
+
+ Tim Adye T.J.Adye@rl.ac.uk
for the VMS emulations of getpw*()
- David Denholm <denholm@conmat.phys.soton.ac.uk>
+ David Denholm denholm@conmat.phys.soton.ac.uk
for extensive testing and provision of pipe and SocketShr code,
- Mark Pizzolato <mark@infocomm.com>
+ Mark Pizzolato mark@infocomm.com
for the getredirection() code
- Rich Salz <rsalz@bbn.com>
+ Rich Salz rsalz@bbn.com
for readdir() and related routines
- Peter Prymmer <pvhp@forte.com>
+ Peter Prymmer pvhp@best.com
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
- Dan Sugalski <dan@sidhe.org>
+ Dan Sugalski dan@sidhe.org
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
the opportunity to test and develop for the AXP,
+
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
-gratitude is due to Larry Wall <larry@wall.org>, for having the ideas which
+gratitude is due to Larry Wall larry@wall.org, for having the ideas which
have made our sleepless nights possible.
Thanks,
The VMSperl group
+
+=cut
+
Bugs
- perl_run() can longjmp out
fix small memory leaks on compile-time failures
Unicode support
sv_setpvn(astr, s, 1);
*s = '\0';
SvCUR_set(sv, len);
+ SvUTF8_off(sv);
SvNIOK_off(sv);
}
else
#define do_pmop_dump Perl_do_pmop_dump
#define do_sv_dump Perl_do_sv_dump
#define magic_dump Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
#define default_protect Perl_default_protect
#define vdefault_protect Perl_vdefault_protect
+#endif
#define reginitcolors Perl_reginitcolors
#define sv_2pv_nolen Perl_sv_2pv_nolen
#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen
#define parse_body S_parse_body
#define run_body S_run_body
#define call_body S_call_body
-#define call_xbody S_call_xbody
#define call_list_body S_call_list_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vparse_body S_vparse_body
+#define vrun_body S_vrun_body
+#define vcall_body S_vcall_body
+#define vcall_list_body S_vcall_list_body
+#endif
# if defined(USE_THREADS)
#define init_main_thread S_init_main_thread
# endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
#define docatch S_docatch
#define docatch_body S_docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vdocatch_body S_vdocatch_body
+#endif
#define dofindlabel S_dofindlabel
#define doparseform S_doparseform
#define dopoptoeval S_dopoptoeval
#define do_pmop_dump(a,b,c) Perl_do_pmop_dump(aTHX_ a,b,c)
#define do_sv_dump(a,b,c,d,e,f,g) Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g)
#define magic_dump(a) Perl_magic_dump(aTHX_ a)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
#define vdefault_protect(a,b,c,d) Perl_vdefault_protect(aTHX_ a,b,c,d)
+#endif
#define reginitcolors() Perl_reginitcolors(aTHX)
#define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a)
#define sv_2pvutf8_nolen(a) Perl_sv_2pvutf8_nolen(aTHX_ a)
# if defined(IAMSUID)
#define fd_on_nosuid_fs(a) S_fd_on_nosuid_fs(aTHX_ a)
# endif
-#define parse_body(a) S_parse_body(aTHX_ a)
+#define parse_body(a,b) S_parse_body(aTHX_ a,b)
#define run_body(a) S_run_body(aTHX_ a)
-#define call_body(a) S_call_body(aTHX_ a)
-#define call_xbody(a,b) S_call_xbody(aTHX_ a,b)
+#define call_body(a,b) S_call_body(aTHX_ a,b)
#define call_list_body(a) S_call_list_body(aTHX_ a)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vparse_body(a) S_vparse_body(aTHX_ a)
+#define vrun_body(a) S_vrun_body(aTHX_ a)
+#define vcall_body(a) S_vcall_body(aTHX_ a)
+#define vcall_list_body(a) S_vcall_list_body(aTHX_ a)
+#endif
# if defined(USE_THREADS)
#define init_main_thread() S_init_main_thread(aTHX)
# endif
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
#define docatch(a) S_docatch(aTHX_ a)
-#define docatch_body(a) S_docatch_body(aTHX_ a)
+#define docatch_body() S_docatch_body(aTHX)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vdocatch_body(a) S_vdocatch_body(aTHX_ a)
+#endif
#define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
#define doparseform(a) S_doparseform(aTHX_ a)
#define dopoptoeval(a) S_dopoptoeval(aTHX_ a)
#define do_sv_dump Perl_do_sv_dump
#define Perl_magic_dump CPerlObj::Perl_magic_dump
#define magic_dump Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
#define Perl_default_protect CPerlObj::Perl_default_protect
#define default_protect Perl_default_protect
#define Perl_vdefault_protect CPerlObj::Perl_vdefault_protect
#define vdefault_protect Perl_vdefault_protect
+#endif
#define Perl_reginitcolors CPerlObj::Perl_reginitcolors
#define reginitcolors Perl_reginitcolors
#define Perl_sv_2pv_nolen CPerlObj::Perl_sv_2pv_nolen
#define run_body S_run_body
#define S_call_body CPerlObj::S_call_body
#define call_body S_call_body
-#define S_call_xbody CPerlObj::S_call_xbody
-#define call_xbody S_call_xbody
#define S_call_list_body CPerlObj::S_call_list_body
#define call_list_body S_call_list_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define S_vparse_body CPerlObj::S_vparse_body
+#define vparse_body S_vparse_body
+#define S_vrun_body CPerlObj::S_vrun_body
+#define vrun_body S_vrun_body
+#define S_vcall_body CPerlObj::S_vcall_body
+#define vcall_body S_vcall_body
+#define S_vcall_list_body CPerlObj::S_vcall_list_body
+#define vcall_list_body S_vcall_list_body
+#endif
# if defined(USE_THREADS)
#define S_init_main_thread CPerlObj::S_init_main_thread
#define init_main_thread S_init_main_thread
#define docatch S_docatch
#define S_docatch_body CPerlObj::S_docatch_body
#define docatch_body S_docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define S_vdocatch_body CPerlObj::S_vdocatch_body
+#define vdocatch_body S_vdocatch_body
+#endif
#define S_dofindlabel CPerlObj::S_dofindlabel
#define dofindlabel S_dofindlabel
#define S_doparseform CPerlObj::S_doparseform
Ap |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \
|I32 maxnest|bool dumpops|STRLEN pvlim
Ap |void |magic_dump |MAGIC *mg
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
Ap |void* |default_protect|volatile JMPENV *je|int *excpt \
|protect_body_t body|...
Ap |void* |vdefault_protect|volatile JMPENV *je|int *excpt \
|protect_body_t body|va_list *args
+#endif
Ap |void |reginitcolors
Ap |char* |sv_2pv_nolen |SV* sv
Ap |char* |sv_2pvutf8_nolen|SV* sv
# if defined(IAMSUID)
s |int |fd_on_nosuid_fs|int fd
# endif
-s |void* |parse_body |va_list args
-s |void* |run_body |va_list args
-s |void* |call_body |va_list args
-s |void |call_xbody |OP *myop|int is_eval
-s |void* |call_list_body |va_list args
+s |void* |parse_body |char **env|XSINIT_t xsinit
+s |void* |run_body |I32 oldscope
+s |void |call_body |OP *myop|int is_eval
+s |void* |call_list_body |CV *cv
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s |void* |vparse_body |va_list args
+s |void* |vrun_body |va_list args
+s |void* |vcall_body |va_list args
+s |void* |vcall_list_body|va_list args
+#endif
# if defined(USE_THREADS)
s |struct perl_thread * |init_main_thread
# endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
s |OP* |docatch |OP *o
-s |void* |docatch_body |va_list args
+s |void* |docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s |void* |vdocatch_body |va_list args
+#endif
s |OP* |dofindlabel |OP *o|char *label|OP **opstack|OP **oplimit
s |void |doparseform |SV *sv
s |I32 |dopoptoeval |I32 startingblock
sub FETCH {
my ($self, $errname) = @_;
my $proto = prototype("Errno::$errname");
+ my $errno = "";
if (defined($proto) && $proto eq "") {
no strict 'refs';
- return $! == &$errname;
+ $errno = &$errname;
+ $errno = 0 unless $! == $errno;
}
- return "";
+ return $errno;
}
sub STORE {
}
sub FIRSTKEY {
- my $s = scalar keys %Errno::;
+ my $s = scalar keys %Errno::; # initialize iterator
goto &NEXTKEY;
}
tag, C<:POSIX>, which will export all POSIX defined error numbers.
C<Errno> also makes C<%!> magic such that each element of C<%!> has a
-non-zero value only if C<$!> is set to that value, eg
+non-zero value only if C<$!> is set to that value. For example:
use Errno;
}
}
-If a specified constant C<EFOO> doesn't exist on the system, C<$!{EFOO}>
-has a false value. You may use C<exists $!{EFOO}> to check whether the
+If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}>
+returns C<"">. You may use C<exists $!{EFOO}> to check whether the
constant is available on the system.
+=head1 CAVEATS
+
+Importing a particular constant may not be very portable, because the
+import will fail on platforms that do not have that constant. A more
+portable way to set C<$!> to a valid value is to use:
+
+ if (exists &Errno::EFOO) {
+ $! = &Errno::EFOO;
+ }
+
=head1 AUTHOR
Graham Barr <gbarr@pobox.com>
use strict;
our(@ISA, $VERSION);
use Exporter;
+use Errno;
# legacy
@ISA = qw(IO::Handle);
-$VERSION = "1.252";
+$VERSION = "1.26";
sub import {
my $pkg = shift;
my $sock = shift;
my $addr = shift;
my $timeout = ${*$sock}{'io_socket_timeout'};
-
+ my $err;
my $blocking;
$blocking = $sock->blocking(0) if $timeout;
- eval {
- croak 'connect: Bad address'
- if(@_ == 2 && !defined $_[1]);
-
- unless(connect($sock, $addr)) {
- if($timeout && ($! == &IO::EINPROGRESS)) {
- require IO::Select;
+ if (!connect($sock, $addr)) {
+ if ($timeout && exists(&IO::EINPROGRESS) && ($! == &IO::EINPROGRESS)) {
+ require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = new IO::Select $sock;
- unless($sel->can_write($timeout) && defined($sock->peername)) {
- croak "connect: timeout";
- }
+ if (!$sel->can_write($timeout)) {
+ $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ $@ = "connect: timeout";
}
- else {
- croak "connect: $!";
+ elsif(!connect($sock,$addr)) {
+ $err = $!;
+ $@ = "connect: $!";
}
}
- };
+ else {
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
- my $ret = $@ ? undef : $sock;
+ $sock->blocking(1) if $blocking;
- $sock->blocking($blocking) if $timeout;
+ $! = $err if $err;
- $ret;
+ $err ? undef : $sock;
}
sub bind {
my $new = $pkg->new(Timeout => $timeout);
my $peer = undef;
- eval {
- if($timeout) {
- require IO::Select;
+ if($timeout) {
+ require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = new IO::Select $sock;
+
+ unless ($sel->can_read($timeout)) {
+ $@ = 'accept: timeout';
+ $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ return;
+ }
+ }
+
+ $peer = accept($new,$sock)
+ or return;
- croak "accept: timeout"
- unless $sel->can_read($timeout);
- }
- $peer = accept($new,$sock) || undef;
- };
- croak "$@" if $@ and $sock;
-
- return wantarray ? defined $peer ? ($new, $peer)
- : ()
- : defined $peer ? $new
- : undef;
+ return wantarray ? ($new, $peer)
+ : $new;
}
sub sockname {
use Socket;
use Carp;
use Exporter;
+use Errno qw(EINVAL); # EINVAL appears portable
@ISA = qw(IO::Socket);
-$VERSION = "1.24";
+$VERSION = "1.25";
IO::Socket::INET->register_domain( AF_INET );
if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
if(defined $proto) {
- @proto = $proto =~ m,\D, ? getprotobyname($proto)
- : getprotobynumber($proto);
-
- $proto = $proto[2] || undef;
+ if (@proto = ( $proto =~ m,\D,
+ ? getprotobyname($proto)
+ : getprotobynumber($proto))
+ ) {
+ $proto = $proto[2] || undef;
+ }
+ else {
+ $@ = "Bad protocol '$proto'";
+ return;
+ }
}
if(defined $port) {
my $defport = $1 || undef;
my $pnum = ($port =~ m,^(\d+)$,)[0];
- @serv= getservbyname($port, $proto[0] || "")
- if($port =~ m,\D,);
+ if ($port =~ m,\D,) {
+ unless (@serv = getservbyname($port, $proto[0] || "")) {
+ $@ = "Bad service '$port'";
+ return;
+ }
+ }
$port = $pnum || $serv[2] || $defport || undef;
sub _error {
my $sock = shift;
- local($!);
- $@ = join("",ref($sock),": ",@_);
- close($sock)
+ my $err = shift;
+ {
+ local($!);
+ $@ = join("",ref($sock),": ",@_);
+ close($sock)
if(defined fileno($sock));
+ }
+ $! = $err;
return undef;
}
($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
$arg->{LocalPort},
- $arg->{Proto});
+ $arg->{Proto})
+ or return _error($sock, $!, $@);
$laddr = defined $laddr ? inet_aton($laddr)
: INADDR_ANY;
- return _error($sock,"Bad hostname '",$arg->{LocalAddr},"'")
+ return _error($sock, EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
unless(defined $laddr);
$arg->{PeerAddr} = $arg->{PeerHost}
unless(exists $arg->{Listen}) {
($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
$arg->{PeerPort},
- $proto);
+ $proto)
+ or return _error($sock, $!, $@);
}
$proto ||= (getprotobyname('tcp'))[2];
if(defined $raddr) {
@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
- return _error($sock,"Bad hostname '",$arg->{PeerAddr},"'")
+ return _error($sock, EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
unless @raddr;
}
while(1) {
$sock->socket(AF_INET, $type, $proto) or
- return _error($sock,"$!");
+ return _error($sock, $!, "$!");
if ($arg->{Reuse}) {
$sock->sockopt(SO_REUSEADDR,1) or
- return _error($sock,"$!");
+ return _error($sock, $!, "$!");
}
if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
$sock->bind($lport || 0, $laddr) or
- return _error($sock,"$!");
+ return _error($sock, $!, "$!");
}
if(exists $arg->{Listen}) {
$sock->listen($arg->{Listen} || 5) or
- return _error($sock,"$!");
+ return _error($sock, $!, "$!");
last;
}
$raddr = shift @raddr;
- return _error($sock,'Cannot determine remote port')
+ return _error($sock, EINVAL, 'Cannot determine remote port')
unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
last
unless($type == SOCK_STREAM || defined $raddr);
- return _error($sock,"Bad hostname '",$arg->{PeerAddr},"'")
+ return _error($sock, EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
unless defined $raddr;
# my $timeout = ${*$sock}{'io_socket_timeout'};
return $sock;
}
- return _error($sock,"$!")
+ return _error($sock, $!, "Timeout")
unless @raddr;
# if ($timeout) {
# my $new_timeout = $timeout - (time() - $before);
-# return _error($sock, "Timeout") if $new_timeout <= 0;
+# return _error($sock,
+# (exists(&Errno::ETIMEDOUT) ? &Errno::ETIMEDOUT : EINVAL),
+# "Timeout") if $new_timeout <= 0;
# ${*$sock}{'io_socket_timeout'} = $new_timeout;
# }
* generated when built with or without MULTIPLICITY. It is also used
* to generate the appropriate export list for win32.
*
- * When building without MULTIPLICITY, these variables will be truly global.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING. That way,
- * we can keep binary compatibility of the curinterp structure */
+ * When building without MULTIPLICITY, these variables will be truly global. */
/* pseudo environmental stuff */
PERLVAR(Iorigargc, int)
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
typedef char* (*LPEnvLibPath)(struct IPerlEnv*, char*);
typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, char*);
+typedef void (*LPEnvGetChildIO)(struct IPerlEnv*, child_IO_table*);
#endif
struct IPerlEnv
LPEnvOsID pEnvOsID;
LPEnvLibPath pLibPath;
LPEnvSiteLibPath pSiteLibPath;
+ LPEnvGetChildIO pGetChildIO;
#endif
};
(*PL_Env->pLibPath)(PL_Env,(str))
#define PerlEnv_sitelib_path(str) \
(*PL_Env->pSiteLibPath)(PL_Env,(str))
+#define PerlEnv_get_child_IO(ptr) \
+ (*PL_Env->pGetChildIO)(PL_Env, ptr)
#endif
#else /* PERL_IMPLICIT_SYS */
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
+#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
#endif
#endif /* PERL_IMPLICIT_SYS */
use warnings "all";
no warnings "all";
+ if (warnings::enabled("void") {
+ warnings::warn("void", "some warning");
+ }
+
=head1 DESCRIPTION
If no import list is supplied, all possible warnings are either enabled
or disabled.
-See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
+Two functions are provided to assist module authors.
+
+=over 4
+
+=item warnings::enabled($category)
+
+Returns TRUE if the warnings category in C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
+
+
+=item warnings::warn($category, $message)
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
+
+=back
+
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
=cut
use Carp ;
%Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..35]
- 'ambiguous' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [16]
- 'bareword' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [17]
- 'closed' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'closure' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [27]
- 'debugging' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [12]
- 'deprecated' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18]
- 'digit' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [19]
- 'exec' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'inplace' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [13]
- 'internal' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [14]
- 'io' => "\x55\x05\x00\x00\x00\x00\x00\x00\x00", # [0..5]
- 'misc' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'newline' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'numeric' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'octal' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [20]
- 'once' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [8]
- 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [28]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21]
- 'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4]
- 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29]
- 'printf' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [22]
- 'recursion' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [9]
- 'redefine' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [10]
- 'reserved' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [23]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [24]
- 'severe' => "\x00\x00\x40\x15\x00\x00\x00\x00\x00", # [11..14]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [30]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [31]
- 'syntax' => "\x00\x00\x00\x40\x55\x55\x01\x00\x00", # [15..24]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [32]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [25]
- 'unopened' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'unsafe' => "\x00\x00\x00\x00\x00\x00\x50\x55\x15", # [26..34]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [33]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [34]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [35]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
+ 'chmod' => "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
+ 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
+ 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+ 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+ 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
+ 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
+ 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+ 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
+ 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+ 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+ 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+ 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
);
%DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..35]
- 'ambiguous' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [16]
- 'bareword' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [17]
- 'closed' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'closure' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [27]
- 'debugging' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [12]
- 'deprecated' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18]
- 'digit' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [19]
- 'exec' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'inplace' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [13]
- 'internal' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [14]
- 'io' => "\xaa\x0a\x00\x00\x00\x00\x00\x00\x00", # [0..5]
- 'misc' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'newline' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'numeric' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'octal' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [20]
- 'once' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [8]
- 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [28]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21]
- 'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4]
- 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29]
- 'printf' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [22]
- 'recursion' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [9]
- 'redefine' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [10]
- 'reserved' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [23]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [24]
- 'severe' => "\x00\x00\x80\x2a\x00\x00\x00\x00\x00", # [11..14]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [30]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [31]
- 'syntax' => "\x00\x00\x00\x80\xaa\xaa\x02\x00\x00", # [15..24]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [32]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [25]
- 'unopened' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'unsafe' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\x2a", # [26..34]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [33]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [34]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [35]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
+ 'chmod' => "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
+ 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
+ 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+ 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+ 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
+ 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
+ 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+ 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
+ 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+ 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+ 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+ 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
);
+$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
sub bits {
my $mask ;
sub enabled
{
- my $string = shift ;
-
+ # If no parameters, check for any lexical warnings enabled
+ # in the users scope.
+ my $callers_bitmask = (caller(1))[9] ;
+ return ($callers_bitmask ne $NONE) if @_ == 0 ;
+
+ # otherwise check for the category supplied.
+ my $category = shift ;
+ return 0
+ unless $Bits{$category} ;
+ return 0 unless defined $callers_bitmask ;
return 1
- if $bits{$string} && ${^WARNING_BITS} & $bits{$string} ;
+ if ($callers_bitmask & $Bits{$category}) ne $NONE ;
return 0 ;
}
+sub warn
+{
+ croak "Usage: warnings::warn('category', 'message')"
+ unless @_ == 2 ;
+ my $category = shift ;
+ my $message = shift ;
+ local $Carp::CarpLevel = 1 ;
+ my $callers_bitmask = (caller(1))[9] ;
+ croak($message)
+ if defined $callers_bitmask &&
+ ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+ carp($message) ;
+}
+
1;
)];
}
+unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) {
+ skip_symbols [qw(
+ PL_protect
+ Perl_default_protect
+ Perl_vdefault_protect
+ )];
+}
+
if ($define{'MYMALLOC'}) {
emit_symbols [qw(
Perl_dump_mstats
} STMT_END
#endif
+#ifdef PERL_IMPLICIT_CONTEXT
+# define PERL_IS_ALIVE aTHX
+#else
+# define PERL_IS_ALIVE TRUE
+#endif
+
+
/*
* Layout of memory:
* ~~~~~~~~~~~~~~~~
static void
botch(char *diag, char *s)
{
- dTHXo;
+ dTHX;
PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
PerlProc_abort();
}
/* remove from linked list */
#if defined(RCHECK)
if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) {
- dTHXo;
+ dTHX;
PerlIO_printf(PerlIO_stderr(),
"Unaligned pointer in the free chain 0x%"UVxf"\n",
PTR2UV(p));
}
if ((PTR2UV(p->ov_next)) & (MEM_ALIGNBYTES - 1)) {
- dTHXo;
+ dTHX;
PerlIO_printf(PerlIO_stderr(),
"Unaligned `next' pointer in the free "
"chain 0x"UVxf" at 0x%"UVxf"\n",
{
static int bad_free_warn = -1;
if (bad_free_warn == -1) {
- dTHXo;
+ dTHX;
char *pbf = PerlEnv_getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
return;
#ifdef RCHECK
+#ifdef PERL_CORE
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored",
+ ovp->ov_rmagic == RMAGIC - 1 ?
+ "Duplicate" : "Bad");
+ }
+#else
warn("%s free() ignored",
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+#endif
+#else
+#ifdef PERL_CORE
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored");
+ }
#else
warn("%s", "Bad free() ignored");
#endif
+#endif
return; /* sanity */
}
#ifdef RCHECK
{
static int bad_free_warn = -1;
if (bad_free_warn == -1) {
- dTHXo;
+ dTHX;
char *pbf = PerlEnv_getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
return Nullch;
#ifdef RCHECK
+#ifdef PERL_CORE
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored",
+ (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
+ ovp->ov_rmagic == RMAGIC - 1
+ ? "of freed memory " : "");
+ }
+#else
warn("%srealloc() %signored",
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
+#endif
+#else
+#ifdef PERL_CORE
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%s",
+ "Bad realloc() ignored");
+ }
#else
warn("%s", "Bad realloc() ignored");
#endif
+#endif
return Nullch; /* sanity */
}
else {
i = whichsig(s); /* ...no, a brick */
if (!i) {
- if (ckWARN(WARN_SIGNAL) || strEQ(s,"ALARM"))
+ if (ckWARN(WARN_SIGNAL))
Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
return 0;
}
#define Perl_magic_dump pPerl->Perl_magic_dump
#undef magic_dump
#define magic_dump Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
#undef Perl_default_protect
#define Perl_default_protect pPerl->Perl_default_protect
#undef default_protect
#define Perl_vdefault_protect pPerl->Perl_vdefault_protect
#undef vdefault_protect
#define vdefault_protect Perl_vdefault_protect
+#endif
#undef Perl_reginitcolors
#define Perl_reginitcolors pPerl->Perl_reginitcolors
#undef reginitcolors
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
# if defined(IAMSUID)
# endif
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
# if defined(USE_THREADS)
# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#endif
}
yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
}
- if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
+ if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
SV **svp = AvARRAY(PL_comppad_name);
HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
PADOFFSET top = AvFILLp(PL_comppad_name);
|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"\"%s\" variable %s masks earlier declaration in same %s",
(PL_in_my == KEY_our ? "our" : "my"),
name,
&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"\"our\" variable %s redeclared", name);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
dTHR;
OP *o;
- if (ckWARN(WARN_UNSAFE) &&
+ if (ckWARN(WARN_MISC) &&
(left->op_type == OP_RV2AV ||
left->op_type == OP_RV2HV ||
left->op_type == OP_PADAV ||
const char *sample = ((left->op_type == OP_RV2AV ||
left->op_type == OP_PADAV)
? "@array" : "%hash");
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"Applying %s to %s will act on scalar(%s)",
desc, sample, sample);
}
}
if (first->op_type == OP_CONST) {
if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
- Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
+ Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
*firstp = Nullop;
else
scalar(other);
}
- else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
+ else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
OP *k1 = ((UNOP*)first)->op_first;
OP *k2 = k1->op_sibling;
OPCODE warnop = 0;
if (warnop) {
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
{
dTHR;
- if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
+ if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
SV* msg = sv_newmortal();
SV* name = Nullsv;
Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
else
sv_catpv(msg, "none");
- Perl_warner(aTHX_ WARN_UNSAFE, "%"SVf, msg);
+ Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
}
}
maximum a prototype before. */
if (SvTYPE(gv) > SVt_NULL) {
if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
- && ckWARN_d(WARN_UNSAFE))
+ && ckWARN_d(WARN_PROTOTYPE))
{
- Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+ Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
}
cv_ckproto((CV*)gv, NULL, ps);
}
goto withattrs;
if (const_sv = cv_const_sv(cv))
const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
- if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE)
- && !(CvGV(cv) && GvSTASH(CvGV(cv))
- && HvNAME(GvSTASH(CvGV(cv)))
- && strEQ(HvNAME(GvSTASH(CvGV(cv))),
- "autouse")))
+ if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
{
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ if (ckWARN(WARN_DEPRECATED))
+ Perl_warner(aTHX_ WARN_DEPRECATED,
"Array @%s missing the @ in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
op_free(kid);
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ if (ckWARN(WARN_DEPRECATED))
+ Perl_warner(aTHX_ WARN_DEPRECATED,
"Hash %%%s missing the %% in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
op_free(kid);
{
GV *gv;
+ o = ck_fun(o);
if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
append_elem(OP_GLOB, o, newDEFSVOP());
gv_IOadd(gv);
append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
scalarkids(o);
- return ck_fun(o);
+ return o;
}
OP *
GvAVn(gv);
}
}
- else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+ else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
GV *gv = cGVOPo_gv;
if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
/* XXX could check prototype here instead of just carping */
SV *sv = sv_newmortal();
gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_PROTOTYPE,
"%s() called too early to check prototype",
SvPV_nolen(sv));
}
0x0001368c, /* ref */
0x00122804, /* bless */
0x00001608, /* backtick */
- 0x00132808, /* glob */
+ 0x00012808, /* glob */
0x00001608, /* readline */
0x00001608, /* rcatline */
0x00002204, /* regcmaybe */
0x0002291c, /* link */
0x0002291c, /* symlink */
0x0001368c, /* readlink */
- 0x0002291c, /* mkdir */
+ 0x0012291c, /* mkdir */
0x0001379c, /* rmdir */
0x0002c814, /* open_dir */
0x0000d600, /* readdir */
backtick quoted execution (``, qx) ck_null t%
# glob defaults its first arg to $_
-glob glob ck_glob t@ S? S?
+glob glob ck_glob t@ S?
readline <HANDLE> ck_null t%
rcatline append I/O operator ck_null t%
link link ck_fun isT@ S S
symlink symlink ck_fun isT@ S S
readlink readlink ck_fun stu% S?
-mkdir mkdir ck_fun isT@ S S
+mkdir mkdir ck_fun isT@ S S?
rmdir rmdir ck_fun isTu% S?
# Directory calls.
thr = init_main_thread();
#endif /* USE_THREADS */
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
+#endif
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
oldscope = PL_scopestack_ix;
PL_dowarn = G_WARN_OFF;
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body),
- env, xsinit);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vparse_body), env, xsinit);
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ parse_body(env,xsinit);
+#endif
if (PL_checkav)
call_list(oldscope, PL_checkav);
- return 0;
+ ret = 0;
+ break;
case 1:
STATUS_ALL_FAILURE;
/* FALL THROUGH */
PL_curstash = PL_defstash;
if (PL_checkav)
call_list(oldscope, PL_checkav);
- return STATUS_NATIVE_EXPORT;
+ ret = STATUS_NATIVE_EXPORT;
+ break;
case 3:
PerlIO_printf(Perl_error_log, "panic: top_env\n");
- return 1;
+ ret = 1;
+ break;
}
- return 0;
+ JMPENV_POP;
+ return ret;
+}
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+STATIC void *
+S_vparse_body(pTHX_ va_list args)
+{
+ char **env = va_arg(args, char**);
+ XSINIT_t xsinit = va_arg(args, XSINIT_t);
+
+ return parse_body(env, xsinit);
}
+#endif
STATIC void *
-S_parse_body(pTHX_ va_list args)
+S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
{
dTHR;
int argc = PL_origargc;
char **argv = PL_origargv;
- char **env = va_arg(args, char**);
char *scriptname = NULL;
int fdscript = -1;
VOL bool dosearch = FALSE;
register char *s;
char *cddir = Nullch;
- XSINIT_t xsinit = va_arg(args, XSINIT_t);
-
sv_setpvn(PL_linestr,"",0);
sv = newSVpvn("",0); /* first used for -I flags */
SAVEFREESV(sv);
{
dTHR;
I32 oldscope;
- int ret;
+ int ret = 0;
dJMPENV;
#ifdef USE_THREADS
dTHX;
oldscope = PL_scopestack_ix;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vrun_body), oldscope);
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 1:
cxstack_ix = -1; /* start context stack again */
goto redo_body;
- case 0: /* normal completion */
- case 2: /* my_exit() */
+ case 0: /* normal completion */
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ run_body(oldscope);
+#endif
+ /* FALL THROUGH */
+ case 2: /* my_exit() */
while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
#endif
- return STATUS_NATIVE_EXPORT;
+ ret = STATUS_NATIVE_EXPORT;
+ break;
case 3:
if (PL_restartop) {
POPSTACK_TO(PL_mainstack);
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
FREETMPS;
- return 1;
+ ret = 1;
+ break;
}
- /* NOTREACHED */
- return 0;
+ JMPENV_POP;
+ return ret;
}
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
-S_run_body(pTHX_ va_list args)
+S_vrun_body(pTHX_ va_list args)
{
- dTHR;
I32 oldscope = va_arg(args, I32);
+ return run_body(oldscope);
+}
+#endif
+
+
+STATIC void *
+S_run_body(pTHX_ I32 oldscope)
+{
+ dTHR;
+
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
PL_sawampersand ? "Enabling" : "Omitting"));
if (!(flags & G_EVAL)) {
CATCH_SET(TRUE);
- call_xbody((OP*)&myop, FALSE);
+ call_body((OP*)&myop, FALSE);
retval = PL_stack_sp - (PL_stack_base + oldmark);
CATCH_SET(oldcatch);
}
}
PL_markstack_ptr++;
- redo_body:
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
(OP*)&myop, FALSE);
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ call_body((OP*)&myop, FALSE);
+#endif
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
sv_setpv(ERRSV,"");
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
+ JMPENV_POP;
if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
PL_curpm = newpm;
LEAVE;
}
+ JMPENV_POP;
}
if (flags & G_DISCARD) {
return retval;
}
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
-S_call_body(pTHX_ va_list args)
+S_vcall_body(pTHX_ va_list args)
{
OP *myop = va_arg(args, OP*);
int is_eval = va_arg(args, int);
- call_xbody(myop, is_eval);
+ call_body(myop, is_eval);
return NULL;
}
+#endif
STATIC void
-S_call_xbody(pTHX_ OP *myop, int is_eval)
+S_call_body(pTHX_ OP *myop, int is_eval)
{
dTHR;
if (flags & G_KEEPERR)
myop.op_flags |= OPf_SPECIAL;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
(OP*)&myop, TRUE);
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ call_body((OP*)&myop,TRUE);
+#endif
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
sv_setpv(ERRSV,"");
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
+ JMPENV_POP;
if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
break;
}
+ JMPENV_POP;
if (flags & G_DISCARD) {
PL_stack_sp = PL_stack_base + oldmark;
retval = 0;
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
SAVEFREESV(cv);
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ call_list_body(cv);
+#endif
atsv = ERRSV;
(void)SvPV(atsv, len);
if (len) {
: "END");
while (PL_scopestack_ix > oldscope)
LEAVE;
+ JMPENV_POP;
Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
}
break;
PL_curstash = PL_defstash;
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
+ JMPENV_POP;
if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
if (paramList == PL_beginav)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
FREETMPS;
break;
}
+ JMPENV_POP;
}
}
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
-S_call_list_body(pTHX_ va_list args)
+S_vcall_list_body(pTHX_ va_list args)
{
- dTHR;
CV *cv = va_arg(args, CV*);
+ return call_list_body(cv);
+}
+#endif
+STATIC void *
+S_call_list_body(pTHX_ CV *cv)
+{
PUSHMARK(PL_stack_sp);
call_sv((SV*)cv, G_EVAL|G_DISCARD);
return NULL;
#define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
#define CALLREGFREE CALL_FPTR(PL_regfree)
-#define CALLPROTECT CALL_FPTR(PL_protect)
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+# define CALLPROTECT CALL_FPTR(PL_protect)
+#endif
#define NOOP (void)0
#define dNOOP extern int Perl___notused
{
((CPerlObj*)pPerl)->Perl_magic_dump(mg);
}
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
#undef Perl_default_protect
void*
{
return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args);
}
+#endif
#undef Perl_reginitcolors
void
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
# if defined(IAMSUID)
# endif
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
# if defined(USE_THREADS)
# endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#endif
*
* The 'G' prefix is only needed for vars that need appropriate #defines
* generated in embed*.h. Such symbols are also used to generate
- * the appropriate export list for win32.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING. That way,
- * we can keep binary compatibility of the curinterp structure */
-
+ * the appropriate export list for win32. */
/* global state */
PERLVAR(Gcurinterp, PerlInterpreter *)
to the language internals. If you have dynamically loaded extensions
that you built under perl 5.003 or 5.004, you can continue to use them
with 5.004, but you will need to rebuild and reinstall those extensions
-to use them 5.005. See L<INSTALL> for detailed instructions on how to
+to use them 5.005. See F<INSTALL> for detailed instructions on how to
upgrade.
=head2 Default installation structure has changed
The new Configure defaults are designed to allow a smooth upgrade from
-5.004 to 5.005, but you should read L<INSTALL> for a detailed
+5.004 to 5.005, but you should read F<INSTALL> for a detailed
discussion of the changes in order to adapt them to your system.
=head2 Perl Source Compatibility
implementation may change without notice. There are known limitations
and some bugs. These are expected to be fixed in future versions.
-See L<README.threads>.
+See F<README.threads>.
=head2 Compiler
=head2 New Platforms
-BeOS is now supported. See L<README.beos>.
+BeOS is now supported. See F<README.beos>.
-DOS is now supported under the DJGPP tools. See L<README.dos>.
+DOS is now supported under the DJGPP tools. See F<README.dos> (installed
+as L<perldos> on some systems).
-MiNT is now supported. See L<README.mint>.
+MiNT is now supported. See F<README.mint>.
-MPE/iX is now supported. See L<README.mpeix>.
+MPE/iX is now supported. See F<README.mpeix>.
-MVS (aka OS390, aka Open Edition) is now supported. See L<README.os390>.
+MVS (aka OS390, aka Open Edition) is now supported. See F<README.os390>
+(installed as L<perlos390> on some systems).
-Stratus VOS is now supported. See L<README.vos>.
+Stratus VOS is now supported. See F<README.vos>.
=head2 Changes in existing support
encapsulation of Perl. GCC and EGCS are now supported on Win32.
See F<README.win32>, aka L<perlwin32>.
-VMS configuration system has been rewritten. See L<README.vms>.
+VMS configuration system has been rewritten. See F<README.vms> (installed
+as L<README_vms> on some systems).
The hints files for most Unix platforms have seen incremental improvements.
with another number.
This behavior must be specifically enabled when running Configure.
-See L<INSTALL> and L<README.Y2K>.
+See F<INSTALL> and F<README.Y2K>.
=head1 Significant bug fixes
(W) A warning (optional).
(D) A deprecation (optional).
- (S) A severe warning (mandatory).
+ (S) A severe warning (default).
(F) A fatal error (trappable).
(P) An internal error you should never see (trappable).
(X) A very fatal error (nontrappable).
(A) An alien error message (not generated by Perl).
-Optional warnings are enabled by using the B<-w> switch. Warnings may
-be captured by setting C<$SIG{__WARN__}> to a reference to a routine that
-will be called on each warning instead of printing it. See L<perlvar>.
+The majority of messages from the first three classifications above (W,
+D & S) can be controlled using the C<warnings> pragma.
+
+If a message can be controlled by the C<warnings> pragma, its warning
+category is included with the classification letter in the description
+below.
+
+Optional warnings are enabled by using the C<warnings> pragma or the B<-w>
+and B<-W> switches. Warnings may be captured by setting C<$SIG{__WARN__}>
+to a reference to a routine that will be called on each warning instead
+of printing it. See L<perlvar>.
+
+Default warnings are always enabled unless they are explicitly disabled
+with the C<warnings> pragma or the B<-X> switch.
Trappable errors may be trapped using the eval operator. See
L<perlfunc/eval>. In almost all cases, warnings may be selectively
=item "%s" variable %s masks earlier declaration in same %s
-(W) A "my" or "our" variable has been redeclared in the current scope or statement,
+(W misc) A "my" or "our" variable has been redeclared in the current scope or statement,
effectively eliminating all access to the previous instance. This is almost
always a typographical error. Note that the earlier variable will still exist
until the end of the scope or until all closure referents to it are
=item "our" variable %s redeclared
-(W) You seem to have already declared the same global once before in the
+(W misc) You seem to have already declared the same global once before in the
current lexical scope.
=item "use" not allowed in expression
=item /%s/: Unrecognized escape \\%c passed through
-(W) You used a backslash-character combination which is not recognized
+(W regexp) You used a backslash-character combination which is not recognized
by Perl. This combination appears in an interpolated variable or a
C<'>-delimited regular expression. The character was understood literally.
=item /%s/: Unrecognized escape \\%c in character class passed through
-(W) You used a backslash-character combination which is not recognized
+(W regexp) You used a backslash-character combination which is not recognized
by Perl inside character classes. The character was understood literally.
=item /%s/ should probably be written as "%s"
-(W) You have used a pattern where Perl expected to find a string,
+(W syntax) You have used a pattern where Perl expected to find a string,
as in the first argument to C<join>. Perl will treat the true
or false result of matching the pattern against $_ as the string,
which is probably not what you had in mind.
=item %s (...) interpreted as function
-(W) You've run afoul of the rule that says that any list operator followed
+(W syntax) You've run afoul of the rule that says that any list operator followed
by parentheses turns into a function, with all the list operators arguments
found inside the parentheses. See L<perlop/Terms and List Operators (Leftward)>.
=item %s() called too early to check prototype
-(W) You've called a function that has a prototype before the parser saw a
+(W prototype) You've called a function that has a prototype before the parser saw a
definition or declaration for it, and Perl could not check that the call
conforms to the prototype. You need to either add an early prototype
declaration for the subroutine in question, or move the subroutine
=item %s matches null string many times
-(W) The pattern you've specified would be an infinite loop if the
+(W regexp) The pattern you've specified would be an infinite loop if the
regular expression engine didn't specifically check for that. See L<perlre>.
=item %s never introduced
-(S) The symbol in question was declared but somehow went out of scope
+(S internal) The symbol in question was declared but somehow went out of scope
before it could possibly have been used.
=item %s package attribute may clash with future reserved word: %s
-(W) A lowercase attribute name was used that had a package-specific handler.
+(W reserved) A lowercase attribute name was used that had a package-specific handler.
That name might have a meaning to Perl itself some day, even though it
doesn't yet. Perhaps you should use a mixed-case attribute name, instead.
See L<attributes>.
=item (in cleanup) %s
-(W) This prefix usually indicates that a DESTROY() method raised
+(W misc) This prefix usually indicates that a DESTROY() method raised
the indicated exception. Since destructors are usually called by
the system at arbitrary points during execution, and often a vast
number of times, the warning is issued only once for any number
=item accept() on closed socket %s
-(W) You tried to do an accept on a closed socket. Did you forget to check
+(W closed) You tried to do an accept on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/accept>.
=item Allocation too large: %lx
=item Applying %s to %s will act on scalar(%s)
-(W) The pattern match (//), substitution (s///), and transliteration (tr///)
+(W misc) The pattern match (//), substitution (s///), and transliteration (tr///)
operators work on scalar values. If you apply one of them to an array
or a hash, it will convert the array or hash to a scalar value -- the
length of an array, or the population info of a hash -- and then work on
=item Ambiguous use of %s resolved as %s
-(W)(S) You said something that may not be interpreted the way
+(W ambiguous)(S) You said something that may not be interpreted the way
you thought. Normally it's pretty easy to disambiguate it by supplying
a missing quote, operator, parenthesis pair or declaration.
=item Ambiguous call resolved as CORE::%s(), qualify as such or use &
-(W) A subroutine you have declared has the same name as a Perl keyword,
+(W ambiguous) A subroutine you have declared has the same name as a Perl keyword,
and you have used the name without qualification for calling one or the
other. Perl decided to call the builtin because the subroutine is
not imported.
=item Argument "%s" isn't numeric%s
-(W) The indicated string was fed as an argument to an operator that
+(W numeric) The indicated string was fed as an argument to an operator that
expected a numeric value instead. If you're fortunate the message
will identify which operator was so unfortunate.
=item Array @%s missing the @ in argument %d of %s()
-(D) Really old Perl let you omit the @ on array names in some spots. This
+(D deprecated) Really old Perl let you omit the @ on array names in some spots. This
is now heavily deprecated.
=item assertion botched: %s
=item Attempt to free non-arena SV: 0x%lx
-(P) All SV objects are supposed to be allocated from arenas that will
+(P internal) All SV objects are supposed to be allocated from arenas that will
be garbage collected on exit. An SV was discovered to be outside any
of those arenas.
=item Attempt to free nonexistent shared string
-(P) Perl maintains a reference counted internal table of strings to
+(P internal) Perl maintains a reference counted internal table of strings to
optimize the storage and access of hash keys and other strings. This
indicates someone tried to decrement the reference count of a string
that can no longer be found in the table.
=item Attempt to free temp prematurely
-(W) Mortalized values are supposed to be freed by the free_tmps()
+(W debugging) Mortalized values are supposed to be freed by the free_tmps()
routine. This indicates that something else is freeing the SV before
the free_tmps() routine gets a chance, which means that the free_tmps()
routine will be freeing an unreferenced scalar when it does try to free
=item Attempt to free unreferenced glob pointers
-(P) The reference counts got screwed up on symbol aliases.
+(P internal) The reference counts got screwed up on symbol aliases.
=item Attempt to free unreferenced scalar
-(W) Perl went to decrement the reference count of a scalar to see if it
+(W internal) Perl went to decrement the reference count of a scalar to see if it
would go to 0, and discovered that it had already gone to 0 earlier,
and should have been freed, and in fact, probably was freed. This
could indicate that SvREFCNT_dec() was called too many times, or that
=item Attempt to pack pointer to temporary value
-(W) You tried to pass a temporary value (like the result of a
+(W pack) You tried to pass a temporary value (like the result of a
function, or a computed expression) to the "p" pack() template. This
means the result contains a pointer to a location that could become
invalid anytime, even before the end of the current statement. Use
=item Attempt to use reference as lvalue in substr
-(W) You supplied a reference as the first argument to substr() used
+(W substr) You supplied a reference as the first argument to substr() used
as an lvalue, which is pretty strange. Perhaps you forgot to
dereference it first. See L<perlfunc/substr>.
=item Bad free() ignored
-(S) An internal routine called free() on something that had never been
+(S malloc) An internal routine called free() on something that had never been
malloc()ed in the first place. Mandatory, but can be disabled by
setting environment variable C<PERL_BADFREE> to 1.
=item Bad realloc() ignored
-(S) An internal routine called realloc() on something that had never been
+(S malloc) An internal routine called realloc() on something that had never been
malloc()ed in the first place. Mandatory, but can be disabled by
setting environment variable C<PERL_BADFREE> to 1.
=item Bareword "%s" refers to nonexistent package
-(W) You used a qualified bareword of the form C<Foo::>, but
+(W bareword) You used a qualified bareword of the form C<Foo::>, but
the compiler saw no other uses of that namespace before that point.
Perhaps you need to predeclare a package?
=item Bareword found in conditional
-(W) The compiler found a bareword where it expected a conditional,
+(W bareword) The compiler found a bareword where it expected a conditional,
which often indicates that an || or && was parsed as part of the
last argument of the previous construct, for example:
=item Binary number > 0b11111111111111111111111111111111 non-portable
-(W) The binary number you specified is larger than 2**32-1
+(W portable) The binary number you specified is larger than 2**32-1
(4294967295) and therefore non-portable between systems. See
L<perlport> for more on portability concerns.
=item bind() on closed socket %s
-(W) You tried to do a bind on a closed socket. Did you forget to check
+(W closed) You tried to do a bind on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/bind>.
=item Bit vector size > 32 non-portable
-(W) Using bit vector sizes larger than 32 is non-portable.
+(W portable) Using bit vector sizes larger than 32 is non-portable.
=item Bizarre copy of %s in %s
=item Buffer overflow in prime_env_iter: %s
-(W) A warning peculiar to VMS. While Perl was preparing to iterate over
+(W internal) A warning peculiar to VMS. While Perl was preparing to iterate over
%ENV, it encountered a logical name or symbol definition which was too long,
so it was truncated to the string shown.
=item Can't break at that line
-(S) A warning intended to only be printed while running within the debugger, indicating
+(S internal) A warning intended to only be printed while running within the debugger, indicating
the line number specified wasn't the location of a statement that could
be stopped at.
=item Can't do inplace edit on %s: %s
-(S) The creation of the new file failed for the indicated reason.
+(S inplace) The creation of the new file failed for the indicated reason.
=item Can't do inplace edit without backup
=item Can't do inplace edit: %s would not be unique
-(S) Your filesystem does not support filenames longer than 14
+(S inplace) Your filesystem does not support filenames longer than 14
characters and Perl was unable to create a unique filename during
inplace editing with the B<-i> switch. The file was ignored.
=item Can't do inplace edit: %s is not a regular file
-(S) You tried to use the B<-i> switch on a special file, such as a file in
+(S inplace) You tried to use the B<-i> switch on a special file, such as a file in
/dev, or a FIFO. The file was ignored.
=item Can't do setegid!
=item Can't exec "%s": %s
-(W) An system(), exec(), or piped open call could not execute the named
+(W exec) An system(), exec(), or piped open call could not execute the named
program for the indicated reason. Typical reasons include: the permissions
were wrong on the file, the file wasn't found in C<$ENV{PATH}>, the
executable in question was compiled for another architecture, or the
=item Can't ignore signal CHLD, forcing to default
-(W) Perl has detected that it is being run with the SIGCHLD signal
+(W signal) Perl has detected that it is being run with the SIGCHLD signal
(sometimes known as SIGCLD) disabled. Since disabling this signal
will interfere with proper determination of exit status of child
processes, Perl has reset the signal to its default value.
=item Can't locate package %s for @%s::ISA
-(W) The @ISA array contained the name of another package that doesn't seem
+(W syntax) The @ISA array contained the name of another package that doesn't seem
to exist.
=item Can't make list assignment to \%ENV on this system
=item Can't open %s: %s
-(S) The implicit opening of a file through use of the C<E<lt>E<gt>>
+(S inplace) The implicit opening of a file through use of the C<E<lt>E<gt>>
filehandle, either implicitly under the C<-n> or C<-p> command-line
switches, or explicitly, failed for the indicated reason. Usually this
is because you don't have read permission for a file which you named
=item Can't open bidirectional pipe
-(W) You tried to say C<open(CMD, "|cmd|")>, which is not supported. You can
+(W pipe) You tried to say C<open(CMD, "|cmd|")>, which is not supported. You can
try any of several modules in the Perl library to do this, such as
IPC::Open2. Alternately, direct the pipe's output to a file using "E<gt>",
and then read it in under a different file handle.
=item Can't remove %s: %s, skipping file
-(S) You requested an inplace edit without creating a backup file. Perl
+(S inplace) You requested an inplace edit without creating a backup file. Perl
was unable to remove the original file to replace it with the modified
file. The file was left unmodified.
=item Can't rename %s to %s: %s, skipping file
-(S) The rename done by the B<-i> switch failed for some reason,
+(S inplace) The rename done by the B<-i> switch failed for some reason,
probably because you don't have write permission to the directory.
=item Can't reopen input pipe (name: %s) in binary mode
=item Can't use \%c to mean $%c in expression
-(W) In an ordinary expression, backslash is a unary operator that creates
+(W syntax) In an ordinary expression, backslash is a unary operator that creates
a reference to its argument. The use of backslash to indicate a backreference
to a matched substring is valid only as part of a regular expression pattern.
Trying to do this in ordinary Perl code produces a value that prints
=item Character class syntax [%s] belongs inside character classes
-(W) The character class constructs [: :], [= =], and [. .] go
+(W unsafe) The character class constructs [: :], [= =], and [. .] go
I<inside> character classes, the [] are part of the construct,
for example: /[012[:alpha:]345]/. Note that [= =] and [. .]
are not currently implemented; they are simply placeholders for
=item Character class syntax [. .] is reserved for future extensions
-(W) Within regular expression character classes ([]) the syntax beginning
+(W regexp) Within regular expression character classes ([]) the syntax beginning
with "[." and ending with ".]" is reserved for future extensions.
If you need to represent those character sequences inside a regular
expression character class, just quote the square brackets with the
=item Character class syntax [= =] is reserved for future extensions
-(W) Within regular expression character classes ([]) the syntax
+(W regexp) Within regular expression character classes ([]) the syntax
beginning with "[=" and ending with "=]" is reserved for future extensions.
If you need to represent those character sequences inside a regular
expression character class, just quote the square brackets with the
backslash: "\[=" and "=\]".
-=item chmod: mode argument is missing initial 0
+=item chmod() mode argument is missing initial 0
-(W) A novice will sometimes say
+(W chmod) A novice will sometimes say
chmod 777, $filename
=item Close on unopened file E<lt>%sE<gt>
-(W) You tried to close a filehandle that was never opened.
+(W unopened) You tried to close a filehandle that was never opened.
=item Compilation failed in require
=item Complex regular subexpression recursion limit (%d) exceeded
-(W) The regular expression engine uses recursion in complex situations
+(W regexp) The regular expression engine uses recursion in complex situations
where back-tracking is required. Recursion depth is limited to 32766,
or perhaps less in architectures where the stack cannot grow
arbitrarily. ("Simple" and "medium" situations are handled without
=item connect() on closed socket %s
-(W) You tried to do a connect on a closed socket. Did you forget to check
+(W closed) You tried to do a connect on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/connect>.
=item Constant is not %s reference
=item Constant subroutine %s redefined
-(S|W) You redefined a subroutine which had previously been eligible for
+(S|W redefine) You redefined a subroutine which had previously been eligible for
inlining. See L<perlsub/"Constant Functions"> for commentary and
workarounds.
=item Constant subroutine %s undefined
-(W) You undefined a subroutine which had previously been eligible for
+(W misc) You undefined a subroutine which had previously been eligible for
inlining. See L<perlsub/"Constant Functions"> for commentary and
workarounds.
=item Deep recursion on subroutine "%s"
-(W) This subroutine has called itself (directly or indirectly) 100
+(W recursion) This subroutine has called itself (directly or indirectly) 100
times more than it has returned. This probably indicates an infinite
recursion, unless you're writing strange benchmark programs, in which
case it indicates something else.
=item defined(@array) is deprecated
-(D) defined() is not usually useful on arrays because it checks for an
+(D deprecated) defined() is not usually useful on arrays because it checks for an
undefined I<scalar> value. If you want to see if the array is empty,
just use C<if (@array) { # not empty }> for example.
=item defined(%hash) is deprecated
-(D) defined() is not usually useful on hashes because it checks for an
+(D deprecated) defined() is not usually useful on hashes because it checks for an
undefined I<scalar> value. If you want to see if the hash is empty,
just use C<if (%hash) { # not empty }> for example.
=item Did you mean "local" instead of "our"?
-(W) Remember that "our" does not localize the declared global variable.
+(W misc) Remember that "our" does not localize the declared global variable.
You have declared it again in the same lexical scope, which seems superfluous.
=item Did you mean $ or @ instead of %?
=item Duplicate free() ignored
-(S) An internal routine called free() on something that had already
+(S malloc) An internal routine called free() on something that had already
been freed.
=item elseif should be elsif
=item Exiting eval via %s
-(W) You are exiting an eval by unconventional means, such as
+(W exiting) You are exiting an eval by unconventional means, such as
+a goto, or a loop control statement.
+
+=item Exiting format via %s
+
+(W exiting) You are exiting an eval by unconventional means, such as
a goto, or a loop control statement.
=item Exiting pseudo-block via %s
-(W) You are exiting a rather special block construct (like a sort block or
+(W exiting) You are exiting a rather special block construct (like a sort block or
subroutine) by unconventional means, such as a goto, or a loop control
statement. See L<perlfunc/sort>.
=item Exiting subroutine via %s
-(W) You are exiting a subroutine by unconventional means, such as
+(W exiting) You are exiting a subroutine by unconventional means, such as
a goto, or a loop control statement.
=item Exiting substitution via %s
-(W) You are exiting a substitution by unconventional means, such as
+(W exiting) You are exiting a substitution by unconventional means, such as
a return, a goto, or a loop control statement.
=item Explicit blessing to '' (assuming package main)
-(W) You are blessing a reference to a zero length string. This has
+(W misc) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
package, e.g. bless($ref, $p || 'MyPackage');
=item false [] range "%s" in regexp
-(W) A character class range must start and end at a literal character, not
+(W regexp) A character class range must start and end at a literal character, not
another character class like C<\d> or C<[:alpha:]>. The "-" in your false
range is interpreted as a literal "-". Consider quoting the "-", "\-".
See L<perlre>.
=item Filehandle %s never opened
-(W) An I/O operation was attempted on a filehandle that was never initialized.
+(W unopened) An I/O operation was attempted on a filehandle that was never initialized.
You need to do an open() or a socket() call, or call a constructor from
the FileHandle package.
=item Filehandle %s opened only for input
-(W) You tried to write on a read-only filehandle. If you
+(W io) You tried to write on a read-only filehandle. If you
intended it to be a read-write filehandle, you needed to open it with
"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See
=item Filehandle %s opened only for output
-(W) You tried to read from a filehandle opened only for writing. If you
+(W io) You tried to read from a filehandle opened only for writing. If you
intended it to be a read/write filehandle, you needed to open it with
"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
you intended only to read from the file, use "E<lt>". See
=item flock() on closed filehandle %s
-(W) The filehandle you're attempting to flock() got itself closed some
+(W closed) The filehandle you're attempting to flock() got itself closed some
time before now. Check your logic flow. flock() operates on filehandles.
Are you attempting to call flock() on a dirhandle by the same name?
=item Format %s redefined
-(W) You redefined a format. To suppress this warning, say
+(W redefine) You redefined a format. To suppress this warning, say
{
no warnings;
=item Found = in conditional, should be ==
-(W) You said
+(W syntax) You said
if ($foo = 123)
=item get%sname() on closed socket %s
-(W) You tried to get a socket or peer socket name on a closed socket.
+(W closed) You tried to get a socket or peer socket name on a closed socket.
Did you forget to check the return value of your socket() call?
=item getpwnam returned invalid UIC %#o for user "%s"
(S) A warning peculiar to VMS. The call to C<sys$getuai> underlying the
C<getpwnam> operator returned an invalid UIC.
+=item glob failed (%s)
+
+(W glob) Something went wrong with the external program(s) used for C<glob>
+and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
+pattern that caused the external program to fail and exit with a nonzero
+status. If the message indicates that the abnormal exit resulted in a
+coredump, this may also mean that your csh (C shell) is broken. If so,
+you should change all of the csh-related variables in config.sh: If you
+have tcsh, make the variables refer to it as if it were csh (e.g.
+C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
+C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
+In either case, after editing config.sh, run C<./Configure -S> and
+rebuild Perl.
+
=item Glob not terminated
(F) The lexer saw a left angle bracket in a place where it was expecting
=item Had to create %s unexpectedly
-(S) A routine asked for a symbol from a symbol table that ought to have
+(S internal) A routine asked for a symbol from a symbol table that ought to have
existed already, but for some reason it didn't, and had to be created on
an emergency basis to prevent a core dump.
=item Hash %%s missing the % in argument %d of %s()
-(D) Really old Perl let you omit the % on hash names in some spots. This
+(D deprecated) Really old Perl let you omit the % on hash names in some spots. This
is now heavily deprecated.
=item Hexadecimal number > 0xffffffff non-portable
-(W) The hexadecimal number you specified is larger than 2**32-1
+(W portable) The hexadecimal number you specified is larger than 2**32-1
(4294967295) and therefore non-portable between systems. See
L<perlport> for more on portability concerns.
=item Ill-formed CRTL environ value "%s"
-(W) A warning peculiar to VMS. Perl tried to read the CRTL's internal
+(W internal) A warning peculiar to VMS. Perl tried to read the CRTL's internal
environ array, and encountered an element without the C<=> delimiter
used to spearate keys from values. The element is ignored.
=item Ill-formed message in prime_env_iter: |%s|
-(W) A warning peculiar to VMS. Perl tried to read a logical name
+(W internal) A warning peculiar to VMS. Perl tried to read a logical name
or CLI symbol definition when preparing to iterate over %ENV, and
didn't see the expected delimiter between key and value, so the
line was ignored.
=item Illegal binary digit %s ignored
-(W) You may have tried to use a digit other than 0 or 1 in a binary number.
+(W digit) You may have tried to use a digit other than 0 or 1 in a binary number.
Interpretation of the binary number stopped before the offending digit.
=item Illegal octal digit %s ignored
-(W) You may have tried to use an 8 or 9 in a octal number. Interpretation
+(W digit) You may have tried to use an 8 or 9 in a octal number. Interpretation
of the octal number stopped before the 8 or 9.
=item Illegal hexadecimal digit %s ignored
-(W) You may have tried to use a character other than 0 - 9 or A - F, a - f
+(W digit) You may have tried to use a character other than 0 - 9 or A - F, a - f
in a hexadecimal number. Interpretation of the hexadecimal number stopped
before the illegal character.
=item Integer overflow in %s number
-(W) The hexadecimal, octal or binary number you have specified either
+(W overflow) The hexadecimal, octal or binary number you have specified either
as a literal or as an argument to hex() or oct() is too big for your
architecture, and has been converted to a floating point number. On a
32-bit architecture the largest hexadecimal, octal or binary number
(P) Something went badly wrong in the regular expression parser.
-=item glob failed (%s)
-
-(W) Something went wrong with the external program(s) used for C<glob>
-and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
-pattern that caused the external program to fail and exit with a nonzero
-status. If the message indicates that the abnormal exit resulted in a
-coredump, this may also mean that your csh (C shell) is broken. If so,
-you should change all of the csh-related variables in config.sh: If you
-have tcsh, make the variables refer to it as if it were csh (e.g.
-C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
-C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
-In either case, after editing config.sh, run C<./Configure -S> and
-rebuild Perl.
-
=item internal urp in regexp at /%s/
(P) Something went badly awry in the regular expression parser.
=item Invalid conversion in %s: "%s"
-(W) Perl does not understand the given format conversion.
+(W printf) Perl does not understand the given format conversion.
See L<perlfunc/sprintf>.
=item Invalid separator character %s in attribute list
=item Invalid type in pack: '%s'
(F) The given character is not a valid pack type. See L<perlfunc/pack>.
-(W) The given character is not a valid pack type but used to be silently
+(W pack) The given character is not a valid pack type but used to be silently
ignored.
=item Invalid type in unpack: '%s'
(F) The given character is not a valid unpack type. See L<perlfunc/unpack>.
-(W) The given character is not a valid unpack type but used to be silently
+(W unpack) The given character is not a valid unpack type but used to be silently
ignored.
=item ioctl is not implemented
=item listen() on closed socket %s
-(W) You tried to do a listen on a closed socket. Did you forget to check
+(W closed) You tried to do a listen on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/listen>.
=item Lvalue subs returning %s not implemented yet
=item Misplaced _ in number
-(W) An underline in a decimal constant wasn't on a 3-digit boundary.
+(W syntax) An underline in a decimal constant wasn't on a 3-digit boundary.
=item Missing $ on loop variable
=item Missing command in piped open
-(W) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
+(W pipe) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
construction, but the command was missing or blank.
=item Missing operator before %s?
=item Multidimensional syntax %s not supported
-(W) Multidimensional arrays aren't written like C<$foo[1,2,3]>. They're written
+(W syntax) Multidimensional arrays aren't written like C<$foo[1,2,3]>. They're written
like C<$foo[1][2][3]>, as in C.
=item Missing name in "my sub"
=item Name "%s::%s" used only once: possible typo
-(W) Typographical errors often show up as unique variable names.
+(W once) 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<our> declaration is
provided for this purpose.
=item No such signal: SIG%s
-(W) You specified a signal name as a subscript to %SIG that was not recognized.
+(W signal) You specified a signal name as a subscript to %SIG that was not recognized.
Say C<kill -l> in your shell to see the valid signal names on your system.
=item no UTC offset information; assuming local time is UTC
=item Not enough format arguments
-(W) A format specified more picture fields than the next line supplied.
+(W syntax) A format specified more picture fields than the next line supplied.
See L<perlform>.
=item Null filename used
=item NULL OP IN RUN
-(P) Some internal routine called run() with a null opcode pointer.
+(P debugging) Some internal routine called run() with a null opcode pointer.
=item Null realloc
=item Octal number > 037777777777 non-portable
-(W) The octal number you specified is larger than 2**32-1 (4294967295)
+(W portable) The octal number you specified is larger than 2**32-1 (4294967295)
and therefore non-portable between systems. See L<perlport> for more
on portability concerns.
=item Odd number of elements in hash assignment
-(W) You specified an odd number of elements to initialize a hash, which
+(W misc) You specified an odd number of elements to initialize a hash, which
is odd, because hashes come in key/value pairs.
=item Offset outside string
=item oops: oopsAV
-(S) An internal warning that the grammar is screwed up.
+(S internal) An internal warning that the grammar is screwed up.
=item oops: oopsHV
-(S) An internal warning that the grammar is screwed up.
+(S internal) An internal warning that the grammar is screwed up.
=item Operation `%s': no method found, %s
=item Operator or semicolon missing before %s
-(S) You used a variable or subroutine call where the parser was
+(S ambiguous) You used a variable or subroutine call where the parser was
expecting an operator. The parser has assumed you really meant
to use an operator, but this is highly likely to be incorrect.
For example, if you say "*foo *foo" it will be interpreted as
=item page overflow
-(W) A single call to write() produced more lines than can fit on a page.
+(W io) A single call to write() produced more lines than can fit on a page.
See L<perlform>.
=item panic: ck_grep
=item Parentheses missing around "%s" list
-(W) You said something like
+(W parenthesis) You said something like
my $foo, $bar = @_;
=item pid %x not a child
-(W) A warning peculiar to VMS. Waitpid() was asked to wait for a process which
+(W exec) A warning peculiar to VMS. Waitpid() was asked to wait for a process which
isn't a subprocess of the current process. While this is fine from VMS'
perspective, it's probably not what you intended.
=item Possible Y2K bug: %s
-(W) You are concatenating the number 19 with another number, which
+(W y2k) You are concatenating the number 19 with another number, which
could be a potential Year 2000 problem.
=item Possible attempt to put comments in qw() list
-(W) qw() lists contain items separated by whitespace; as with literal
+(W qw) 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
parentheses shown here; braces are also frequently used.)
=item Possible attempt to separate words with commas
-(W) qw() lists contain items separated by whitespace; therefore commas
+(W qw) 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.)
=item Precedence problem: open %s should be open(%s)
-(S) The old irregular construct
+(S precedence) The old irregular construct
open FOO || die;
=item print() on closed filehandle %s
-(W) The filehandle you're printing on got itself closed sometime before now.
+(W closed) The filehandle you're printing on got itself closed sometime before now.
Check your logic flow.
=item printf() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item Prototype mismatch: %s vs %s
-(S) The subroutine being declared or defined had previously been declared
+(S unsafe) The subroutine being declared or defined had previously been declared
or defined with a different function prototype.
=item Range iterator outside integer range
=item readline() on closed filehandle %s
-(W) The filehandle you're reading from got itself closed sometime before now.
+(W closed) The filehandle you're reading from got itself closed sometime before now.
Check your logic flow.
=item realloc() of freed memory ignored
-(S) An internal routine called realloc() on something that had already
+(S malloc) An internal routine called realloc() on something that had already
been freed.
=item Reallocation too large: %lx
=item Recompile perl with B<-D>DEBUGGING to use B<-D> switch
-(F) You can't use the B<-D> option unless the code to produce the
+(F debugging) You can't use the B<-D> option unless the code to produce the
desired output is compiled into Perl, which entails some overhead,
which is why it's currently left out of your copy.
=item Reference found where even-sized list expected
-(W) You gave a single reference where Perl was expecting a list with
+(W misc) You gave a single reference where Perl was expecting a list with
an even number of elements (for assignment to a hash). This
usually means that you used the anon hash constructor when you meant
to use parens. In any case, a hash requires key/value B<pairs>.
=item Reference is already weak
-(W) You have attempted to weaken a reference that is already weak.
+(W misc) You have attempted to weaken a reference that is already weak.
Doing so has no effect.
=item Reference miscount in sv_replace()
-(W) The internal sv_replace() function was handed a new SV with a
+(W internal) The internal sv_replace() function was handed a new SV with a
reference count of other than 1.
=item regexp *+ operand could be empty
=item Reversed %s= operator
-(W) You wrote your assignment operator backwards. The = must always
+(W syntax) You wrote your assignment operator backwards. The = must always
comes last, to avoid ambiguity with subsequent unary operators.
=item Runaway format
=item Scalar value @%s[%s] better written as $%s[%s]
-(W) You've used an array slice (indicated by @) to select a single element of
+(W syntax) You've used an array slice (indicated by @) to select a single element of
an array. 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
=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
+(W syntax) 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
=item %sseek() on unopened file
-(W) You tried to use the seek() or sysseek() function on a filehandle that
+(W unopened) You tried to use the seek() or sysseek() function on a filehandle that
was either never opened or has since been closed.
=item select not implemented
=item semi-panic: attempt to dup freed string
-(S) The internal newSVsv() routine was called to duplicate a scalar
+(S internal) The internal newSVsv() routine was called to duplicate a scalar
that had previously been marked as free.
=item Semicolon seems to be missing
-(W) A nearby syntax error was probably caused by a missing semicolon,
+(W semicolon) A nearby syntax error was probably caused by a missing semicolon,
or possibly some other missing operator, such as a comma.
=item send() on closed socket %s
-(W) The socket you're sending to got itself closed sometime before now.
+(W closed) The socket you're sending to got itself closed sometime before now.
Check your logic flow.
=item Sequence (? incomplete
=item shutdown() on closed socket %s
-(W) You tried to do a shutdown on a closed socket. Seems a bit superfluous.
+(W closed) You tried to do a shutdown on a closed socket. Seems a bit superfluous.
=item SIG%s handler "%s" not defined
-(W) The signal handler named in %SIG doesn't, in fact, exist. Perhaps you
+(W signal) The signal handler named in %SIG doesn't, in fact, exist. Perhaps you
put it into the wrong package?
=item sort is now a reserved word
=item Stat on unopened file E<lt>%sE<gt>
-(W) You tried to use the stat() function (or an equivalent file test)
+(W unopened) You tried to use the stat() function (or an equivalent file test)
on a filehandle that was either never opened or has since been closed.
=item Statement unlikely to be reached
-(W) You did an exec() with some statement after it other than a die().
+(W exec) You did an exec() with some statement after it other than a die().
This is almost always an error, because exec() never returns unless
there was a failure. You probably wanted to use system() instead,
which does return. To suppress this warning, put the exec() in a block
=item Strange *+?{} on zero-length expression
-(W) You applied a regular expression quantifier in a place where it
+(W regexp) You applied a regular expression quantifier in a place where it
makes no sense, such as on a zero-width assertion.
Try putting the quantifier inside the assertion instead. For example,
the way to match "abc" provided that it is followed by three
=item Subroutine %s redefined
-(W) You redefined a subroutine. To suppress this warning, say
+(W redefine) You redefined a subroutine. To suppress this warning, say
{
no warnings;
=item substr outside of string
-(S),(W) You tried to reference a substr() that pointed outside of a
+(W substr),(F) You tried to reference a substr() that pointed outside of a
string. That is, the absolute value of the offset was larger than the
length of the string. See L<perlfunc/substr>. This warning is
-mandatory if substr is used in an lvalue context (as the left hand side
+fatal if substr is used in an lvalue context (as the left hand side
of an assignment or as a subroutine argument for example).
=item suidperl is no longer needed since %s
=item syswrite() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item Target of goto is too deeply nested
=item tell() on unopened file
-(W) You tried to use the tell() function on a filehandle that was either
+(W unopened) You tried to use the tell() function on a filehandle that was either
never opened or has since been closed.
=item Test on unopened file E<lt>%sE<gt>
-(W) You tried to invoke a file test operator on a filehandle that isn't
+(W unopened) You tried to invoke a file test operator on a filehandle that isn't
open. Check your logic. See also L<perlfunc/-X>.
=item That use of $[ is unsupported
=item This Perl can't set CRTL environ elements (%s=%s)
-(W) Warnings peculiar to VMS. You tried to change or delete an element
+(W internal) Warnings peculiar to VMS. You tried to change or delete an element
of the CRTL's internal environ array, but your copy of Perl wasn't
built with a CRTL that contained the setenv() function. You'll need to
rebuild Perl with a CRTL that does, or redefine F<PERL_ENV_TABLES> (see
=item umask: argument is missing initial 0
-(W) A umask of 222 is incorrect. It should be 0222, because octal
+(W umask) A umask of 222 is incorrect. It should be 0222, because octal
literals always start with 0 in Perl, as in C.
=item umask not implemented
=item Unbalanced context: %d more PUSHes than POPs
-(W) The exit code detected an internal inconsistency in how many execution
+(W internal) The exit code detected an internal inconsistency in how many execution
contexts were entered and left.
=item Unbalanced saves: %d more saves than restores
-(W) The exit code detected an internal inconsistency in how many
+(W internal) The exit code detected an internal inconsistency in how many
values were temporarily localized.
=item Unbalanced scopes: %d more ENTERs than LEAVEs
-(W) The exit code detected an internal inconsistency in how many blocks
+(W internal) The exit code detected an internal inconsistency in how many blocks
were entered and left.
=item Unbalanced tmps: %d more allocs than frees
-(W) The exit code detected an internal inconsistency in how many mortal
+(W internal) The exit code detected an internal inconsistency in how many mortal
scalars were allocated and freed.
=item Undefined format "%s" called
=item Undefined value assigned to typeglob
-(W) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
+(W misc) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
This does nothing. It's possible that you really mean C<undef *foo>.
=item unexec of %s into %s failed!
=item Unquoted string "%s" may clash with future reserved word
-(W) You used a bareword that might someday be claimed as a reserved word.
+(W reserved) You used a bareword that might someday be claimed as a reserved word.
It's best to put such a word in quotes, or capitalize it somehow, or insert
an underbar into it. You might also declare it as a subroutine.
=item Unrecognized escape \\%c passed through
-(W) You used a backslash-character combination which is not recognized
+(W misc) You used a backslash-character combination which is not recognized
by Perl.
=item Unrecognized signal name "%s"
=item Unsuccessful %s on filename containing newline
-(W) A file operation was attempted on a filename, and that operation
+(W newline) A file operation was attempted on a filename, and that operation
failed, PROBABLY because the filename contained a newline, PROBABLY
because you forgot to chop() or chomp() it off. See L<perlfunc/chomp>.
=item Use of $# is deprecated
-(D) This was an ill-advised attempt to emulate a poorly defined B<awk> feature.
+(D
deprecated) This was an ill-advised attempt to emulate a poorly defined B<awk> feature.
Use an explicit printf() or sprintf() instead.
=item Use of $* is deprecated
-(D) This variable magically turned on multi-line pattern matching, both for
+(D deprecated) This variable magically turned on multi-line pattern matching, both for
you and for any luckless subroutine that you happen to call. You should
use the new C<//m> and C<//s> modifiers now to do that without the dangerous
action-at-a-distance effects of C<$*>.
=item Use of bare E<lt>E<lt> to mean E<lt>E<lt>"" is deprecated
-(D) You are now encouraged to use the explicitly quoted form if you
+(D deprecated) You are now encouraged to use the explicitly quoted form if you
wish to use an empty line as the terminator of the here-document.
=item Use of implicit split to @_ is deprecated
-(D) It makes a lot of work for the compiler when you clobber a
+(D deprecated) It makes a lot of work for the compiler when you clobber a
subroutine's argument list, so it's better if you assign the results of
a split() explicitly to an array (or list).
=item Use of inherited AUTOLOAD for non-method %s() is deprecated
-(D) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
+(D
deprecated) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
up as methods (using the C<@ISA> hierarchy) even when the subroutines to
be autoloaded were called as plain functions (e.g. C<Foo::bar()>), not
as methods (e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>).
=item Use of reserved word "%s" is deprecated
-(D) The indicated bareword is a reserved word. Future versions of perl
+(D deprecated) The indicated bareword is a reserved word. Future versions of perl
may use it as a keyword, so you're better off either explicitly quoting
the word in a manner appropriate for its context of use, or using a
different name altogether. The warning can be suppressed for subroutine
=item Use of %s is deprecated
-(D) The construct indicated is no longer recommended for use, generally
+(D deprecated) The construct indicated is no longer recommended for use, generally
because there's a better way to do it, and also because the old way has
bad side effects.
=item Use of uninitialized value%s
-(W) An undefined value was used as if it were already defined. It was
+(W uninitialized) An undefined value was used as if it were already defined. It was
interpreted as a "" or a 0, but maybe it was a mistake. To suppress this
warning assign a defined value to your variables.
=item Useless use of %s in void context
-(W) You did something without a side effect in a context that does nothing
+(W void) You did something without a side effect in a context that does nothing
with the return value, such as a statement that doesn't return a value
from a block, or the left side of a scalar comma operator. Very often
this points not to stupidity on your part, but a failure of Perl to parse
=item untie attempted while %d inner references still exist
-(W) A copy of the object returned from C<tie> (or C<tied>) was still
+(W untie) A copy of the object returned from C<tie> (or C<tied>) was still
valid when C<untie> was called.
=item Value of %s can be "0"; test with defined()
-(W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
+(W misc) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
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
=item Value of CLI symbol "%s" too long
-(W) A warning peculiar to VMS. Perl tried to read the value of an %ENV
+(W misc) A warning peculiar to VMS. Perl tried to read the value of an %ENV
element from a CLI symbol table, and found a resultant string longer
than 1024 characters. The return value has been truncated to 1024
characters.
=item Variable "%s" may be unavailable
-(W) An inner (nested) I<anonymous> subroutine is inside a I<named>
+(W
closure) 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:
=item Variable "%s" will not stay shared
-(W) An inner (nested) I<named> subroutine is referencing a lexical
+(W closure) 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
=item Warning: Use of "%s" without parentheses is ambiguous
-(S) You wrote a unary operator followed by something that looks like a
+(S ambiguous) You wrote a unary operator followed by something that looks like a
binary operator that could also have been interpreted as a term or
unary operator. For instance, if you know that the rand function
has a default argument of 1.0, and you write
=item write() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item X outside of string
=item You need to quote "%s"
-(W) You assigned a bareword as a signal handler name. Unfortunately, you
+(W syntax) You assigned a bareword as a signal handler name. Unfortunately, you
already have a subroutine of that name declared, which means that Perl 5
will try to call the subroutine when the assignment is executed, which is
probably not what you want. (If it IS what you want, put an & in front.)
=item %cetsockopt() on closed socket %s
-(W) You tried to get or set a socket option on a closed socket.
+(W closed) You tried to get or set a socket option on a closed socket.
Did you forget to check the return value of your socket() call?
See L<perlfunc/getsockopt> and L<perlfunc/setsockopt>.
=item \1 better written as $1
-(W) Outside of patterns, backreferences live on as variables. The use
+(W syntax) Outside of patterns, backreferences live on as variables. The use
of backslashes is grandfathered on the right-hand side of a
substitution, but stylistically it's better to use the variable form
because other Perl programmers will expect it, and it works better
to go back before the current one.
($package, $filename, $line, $subroutine, $hasargs,
- $wantarray, $evaltext, $is_require, $hints) = caller($i);
+ $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($i);
Here $subroutine may be C<(eval)> if the frame is not a subroutine
call, but an C<eval>. In such a case additional elements $evaltext and
C<eval EXPR> statement. In particular, for a C<eval BLOCK> statement,
$filename is C<(eval)>, but $evaltext is undefined. (Note also that
each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
-frame. C<$hints> contains pragmatic hints that the caller was
-compiled with. The C<$hints> value is subject to change between versions
-of Perl, and is not meant for external use.
+frame. C<$hints> and C<$bitmask> contain pragmatic hints that the caller
+was compiled with. The C<$hints> and C<$bitmask> values are subject to
+change between versions of Perl, and are not meant for external use.
Furthermore, when called from within the DB package, caller returns more
detailed information: it sets the list variable C<@DB::args> to be the
=item mkdir FILENAME,MASK
+=item mkdir FILENAME
+
Creates the directory specified by FILENAME, with permissions
specified by MASK (as modified by C<umask>). If it succeeds it
returns true, otherwise it returns false and sets C<$!> (errno).
+If omitted, MASK defaults to 0777.
In general, it is better to create directories with permissive MASK,
and let the user modify that with their C<umask>, than it is to supply
my $a = "2:" + 3;
-though the result will be 5.
-
With the introduction of lexical warnings, mandatory warnings now become
I<default> warnings. The difference is that although the previously
mandatory warnings are still enabled by default, they can then be
subsequently enabled or disabled with the lexical warning pragma. For
-example, in the code below, an C<"integer overflow"> warning will only
+example, in the code below, an C<"isn't numeric"> warning will only
be reported for the C<$a> variable.
my $a = "2:" + 3;
=item 1.
If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
-control warnings is used and neither C<$^W> or lexical warnings are used,
-then default warnings will be enabled and optional warnings disabled.
+control warnings is used and neither C<$^W> or the C<warnings> pragma
+are used, then default warnings will be enabled and optional warnings
+disabled.
This means that legacy code that doesn't attempt to control the warnings
will work unchanged.
=item 4.
-If a piece of code is under the control of the lexical warning pragma,
+If a piece of code is under the control of the C<warnings> pragma,
both the C<$^W> variable and the B<-w> flag will be ignored for the
scope of the lexical warning.
=back
The combined effect of 3 & 4 is that it will will allow code which uses
-the lexical warnings pragma to control the warning behavior of $^W-type
+the C<warnings> pragma to control the warning behavior of $^W-type
code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
-=head1 EXPERIMENTAL FEATURES
-
-The features described in this section are experimental, and so subject
-to change.
-
=head2 Category Hierarchy
-A B<tentative> hierarchy of "categories" have been defined to allow groups
-of warnings to be enabled/disabled in isolation. The current
-hierarchy is:
-
- all - +--- unsafe -------+--- taint
- | |
- | +--- substr
- | |
- | +--- signal
- | |
- | +--- closure
- | |
- | +--- overflow
- | |
- | +--- portable
- | |
- | +--- untie
- | |
- | +--- utf8
- |
- +--- io ---------+--- pipe
- | |
- | +--- unopened
- | |
- | +--- closed
- | |
- | +--- newline
- | |
- | +--- exec
- |
- +--- syntax ----+--- ambiguous
- | |
- | +--- semicolon
- | |
- | +--- precedence
- | |
- | +--- reserved
- | |
- | +--- digit
- | |
- | +--- parenthesis
- | |
- | +--- deprecated
- | |
- | +--- printf
- |
- +--- severe ----+--- inplace
- | |
- | +--- internal
- | |
- | +--- debugging
- |
- |--- uninitialized
- |
- +--- void
- |
- +--- recursion
- |
- +--- redefine
- |
- +--- numeric
- |
- +--- once
- |
- +--- misc
-
+A hierarchy of "categories" have been defined to allow groups of warnings
+to be enabled/disabled in isolation.
+
+The current hierarchy is:
+
+ all -+
+ |
+ +- chmod
+ |
+ +- closure
+ |
+ +- exiting
+ |
+ +- glob
+ |
+ +- io -----------+
+ | |
+ | +- closed
+ | |
+ | +- exec
+ | |
+ | +- newline
+ | |
+ | +- pipe
+ | |
+ | +- unopened
+ |
+ +- misc
+ |
+ +- numeric
+ |
+ +- once
+ |
+ +- overflow
+ |
+ +- pack
+ |
+ +- portable
+ |
+ +- recursion
+ |
+ +- redefine
+ |
+ +- regexp
+ |
+ +- severe -------+
+ | |
+ | +- debugging
+ | |
+ | +- inplace
+ | |
+ | +- internal
+ | |
+ | +- malloc
+ |
+ +- signal
+ |
+ +- substr
+ |
+ +- syntax -------+
+ | |
+ | +- ambiguous
+ | |
+ | +- bareword
+ | |
+ | +- deprecated
+ | |
+ | +- digit
+ | |
+ | +- parenthesis
+ | |
+ | +- precedence
+ | |
+ | +- printf
+ | |
+ | +- prototype
+ | |
+ | +- qw
+ | |
+ | +- reserved
+ | |
+ | +- semicolon
+ |
+ +- taint
+ |
+ +- umask
+ |
+ +- uninitialized
+ |
+ +- unpack
+ |
+ +- untie
+ |
+ +- utf8
+ |
+ +- void
+ |
+ +- y2k
Just like the "strict" pragma any of these categories can be combined
no warnings qw(io syntax untie) ;
Also like the "strict" pragma, if there is more than one instance of the
-warnings pragma in a given scope the cumulative effect is additive.
+C<warnings> pragma in a given scope the cumulative effect is additive.
use warnings qw(void) ; # only "void" warnings enabled
...
...
no warnings qw(void) ; # only "io" warnings enabled
+To determine which category a specific warning has been assigned to see
+L<perldiag>.
=head2 Fatal Warnings
The presence of the word "FATAL" in the category list will escalate any
-warnings from the category/categories specified that are detected in
-the lexical scope into fatal errors. In the code below, there are 3
-places where a deprecated warning will be detected, the middle one will
-produce a fatal error.
+warnings detected from the categories specified in the lexical scope
+into fatal errors. In the code below, there are 3 places where a
+deprecated warning will be detected, the middle one will produce a
+fatal error.
use warnings ;
}
$a = 1 if $a EQ $b ;
-
-=head1 TODO
-
-The experimental features need bottomed out.
- perldiag.pod
- Need to add warning class information and notes on
- how to use the class info with the warnings pragma.
+=head2 Reporting Warnings from a Module
+
+The C<warnings> pragma provides two functions, namely C<warnings::enabled>
+and C<warnings::warn>, that are useful for module authors. They are
+used when you want to report a module-specific warning, but only when
+the calling module has enabled warnings via the C<warnings> pragma.
+
+Consider the module C<abc> below.
+
+ package abc;
+
+ sub open
+ {
+ if (warnings::enabled("deprecated")) {
+ warnings::warn("deprecated",
+ "abc::open is deprecated. Use abc:new") ;
+ }
+ new(@_) ;
+ }
+ sub new
+ ...
+ 1 ;
+
+The function C<open> has been deprecated, so code has been included to
+display a warning message whenever the calling module has (at least) the
+"deprecated" warnings category enabled. Something like this, say.
+
+ use warnings 'deprecated';
+ use abc;
+ ...
+ abc::open($filename) ;
+
+
+If the calling module has escalated the "deprecated" warnings category
+into a fatal error like this:
+
+ use warnings 'FATAL deprecated';
+ use abc;
+ ...
+ abc::open($filename) ;
+
+then C<warnings::warn> will detect this and die after displaying the
+warning message.
+
+=head1 TODO
+
perl5db.pl
The debugger saves and restores C<$^W> at runtime. I haven't checked
whether the debugger will still work with the lexical warnings
=head1 SEE ALSO
-L<warnings>.
+L<warnings>, L<perldiag>.
=head1 AUTHOR
Windows NT MSWin32 MSWin32-x86
Windows NT MSWin32 MSWin32-ALPHA
Windows NT MSWin32 MSWin32-ppc
+ Cygwin cygwin
Also see:
=item The ActiveState Pages, C<http://www.activestate.com/>
-=item The Cygwin environment for Win32; L<README.cygwin>,
-C<http://sourceware.cygnus.com/cygwin/>
+=item The Cygwin environment for Win32; F<README.cygwin> (installed
+as L<perlcygwin>), C<http://sourceware.cygnus.com/cygwin/>
=item The U/WIN environment for Win32,
C<http://www.research.att.com/sw/tools/uwin/>
=over 4
-=item L<README.vms>, L<perlvms.pod>
+=item F<README.vms> (installed as L<README_vms>), L<perlvms>
=item vmsperl list, C<majordomo@perl.org>
=over 4
-=item L<README.vos>
+=item F<README.vos>
=item VOS mailing list
=over 4
-=item L<README.os390>, L<README.posix-bc>, L<README.vmesa>
+=item F<README.os390>, F<README.posix-bc>, F<README.vmesa>
=item perl-mvs list
=over 4
-=item Amiga, L<README.amiga>
+=item Amiga, F<README.amiga> (installed as L<perlamiga>).
-=item Atari, L<README.mint> and Guido Flohr's web page
+=item Atari, F<README.mint> and Guido Flohr's web page
C<http://stud.uni-sb.de/~gufl0000/>
-=item Be OS, L<README.beos>
+=item Be OS, F<README.beos>
-=item HP 300 MPE/iX, L<README.mpeix> and Mark Bixby's web page
+=item HP 300 MPE/iX, F<README.mpeix> and Mark Bixby's web page
C<http://www.cccd.edu/~markb/perlix.html>
=item Novell Netware
precompiled binary and source code form from C<http://www.novell.com/>
as well as from CPAN.
-=item Plan 9, L<README.plan9>
+=item Plan 9, F<README.plan9>
=back
=item @+
-$+[0] is the offset of the end of the last successful match.
-C<$+[>I<n>C<]> is the offset of the end of the substring matched by
-I<n>-th subpattern, or undef if the subpattern did not match.
-
-Thus after a match against $_, $& coincides with C<substr $_, $-[0],
-$+[0] - $-[0]>. Similarly, C<$>I<n> coincides with C<substr $_, $-[>I<n>C<],
-$+[>I<n>C<] - $-[>I<n>C<]> if C<$-[>I<n>C<]> is defined, and $+ coincides with
-C<substr $_, $-[$#-], $+[$#-]>. One can use C<$#+> to find the number
-of subgroups in the last successful match. Contrast with
-C<$#E<45>>, the last I<matched> subgroup. Compare with C<@E<45>>.
+This array holds the offsets of the ends of the last successful
+submatches in the currently active dynamic scope. C<$+[0]> is
+the offset into the string of the end of the entire match. This
+is the same value as what the C<pos> function returns when called
+on the variable that was matched against. The I<n>th element
+of this array holds the offset of the I<n>th submatch, so
+C<$+[1]> is the offset past where $1 ends, C<$+[2]> the offset
+past where $2 ends, and so on. You can use C<$#+> to determine
+how many subgroups were in the last successful match. See the
+examples given for the C<@-> variable.
=item $MULTILINE_MATCHING
C<$#+>, the number of subgroups in the regular expression. Compare
with C<@+>.
+This array holds the offsets of the beginnings of the last
+successful submatches in the currently active dynamic scope.
+C<$-[0]> is the offset into the string of the beginning of the
+entire match. The I<n>th element of this array holds the offset
+of the I<n>th submatch, so C<$+[1]> is the offset where $1
+begins, C<$+[2]> the offset where $2 begins, and so on.
+You can use C<$#-> to determine how many subgroups were in the
+last successful match. Compare with the C<@+> variable.
+
+After a match against some variable $var:
+
+=over 5
+
+=item C<$`> is the same as C<substr($var, 0, $-[0]>)
+
+=item C<$&> is the same as C<substr($var, $-[0], $+[0] - $-[0]>)
+
+=item C<$'> is the same as C<substr($var, $+[0]>)
+
+=item C<$1> is the same as C<substr($var, $-[1], $+[1] - $-[1])>
+
+=item C<$2> is the same as C<substr($var, $-[2], $+[2] - $-[2])>
+
+=item C<$3> is the same as C<substr $var, $-[3], $+[3] - $-[3]>)
+
+=back
+
=item format_name HANDLE EXPR
=item $FORMAT_NAME
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (ckWARN(WARN_UNSAFE) && len == 0)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && len == 0)
+ Perl_warner(aTHX_ WARN_MISC,
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
- Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined",
+ if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
+ Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
rem -= pos;
}
if (fail < 0) {
- if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ if (lvalue || repl)
+ Perl_croak(aTHX_ "substr outside of string");
+ if (ckWARN(WARN_SUBSTR))
Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
default:
DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_UNPACK))
+ Perl_warner(aTHX_ WARN_UNPACK,
"Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
default:
DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
"Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ if (ckWARN(WARN_PACK) && (SvTEMP(fromstr)
|| (SvPADTMP(fromstr)
&& !SvREADONLY(fromstr))))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_PACK,
"Attempt to pack pointer to temporary value");
}
if (SvPOK(fromstr) || SvNIOK(fromstr))
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
sv_catpvn(err, prefix, sizeof(prefix)-1);
sv_catpvn(err, message, msglen);
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
+ Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
}
}
}
if (MAXARG)
count = POPi;
- EXTEND(SP, 7);
+ EXTEND(SP, 10);
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
* use the global PL_hints) */
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
HINT_PRIVATE_MASK)));
+ {
+ SV * mask ;
+ SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+ if (old_warnings == WARN_NONE || old_warnings == WARN_STD)
+ mask = newSVpvn(WARN_NONEstring, WARNsize) ;
+ else if (old_warnings == WARN_ALL)
+ mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+ else
+ mask = newSVsv(old_warnings);
+ PUSHs(sv_2mortal(mask));
+ }
RETURN;
}
}
}
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
S_docatch_body(pTHX_ va_list args)
{
+ return docatch_body();
+}
+#endif
+
+STATIC void *
+S_docatch_body(pTHX)
+{
CALLRUNOPS(aTHX);
return NULL;
}
assert(CATCH_GET == TRUE);
#endif
PL_op = o;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
+#else
+ JMPENV_PUSH(ret);
+#endif
switch (ret) {
case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+ docatch_body();
+#endif
break;
case 3:
if (PL_restartop && cursi == PL_curstackinfo) {
}
/* FALL THROUGH */
default:
+ JMPENV_POP;
PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
}
+ JMPENV_POP;
PL_op = oldop;
return Nullop;
}
s = SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) {
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
STRLEN n;
char *s = SvPV(TARG,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s",
+ Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
"about to append an integer to '19'");
}
}
if (relem == lastrelem) {
if (*relem) {
HE *didstore;
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
if (relem == firstrelem &&
SvROK(*relem) &&
( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
+ Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected");
else
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
}
tmpstr = NEWSV(29,0);
didstore = hv_store_ent(hash,*relem,tmpstr,0);
}
}
if (!fp) {
- if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+ if (ckWARN2(WARN_GLOB,WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_CLOSED,
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (can't start child: %s)",
Strerror(errno));
else
(void)do_close(PL_last_in_gv, FALSE);
}
else if (type == OP_GLOB) {
- if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
- Perl_warner(aTHX_ WARN_CLOSED,
+ if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
PP(pp_mkdir)
{
djSP; dTARGET;
- int mode = POPi;
+ int mode;
#ifndef HAS_MKDIR
int oldumask;
#endif
STRLEN n_a;
- char *tmps = SvPV(TOPs, n_a);
+ char *tmps;
+
+ if (MAXARG > 1)
+ mode = POPi;
+ else
+ mode = 0777;
+
+ tmps = SvPV(TOPs, n_a);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm);
PERL_CALLCONV void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
PERL_CALLCONV void Perl_magic_dump(pTHX_ MAGIC *mg);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
PERL_CALLCONV void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...);
PERL_CALLCONV void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args);
+#endif
PERL_CALLCONV void Perl_reginitcolors(pTHX);
PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv);
PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv);
# if defined(IAMSUID)
STATIC int S_fd_on_nosuid_fs(pTHX_ int fd);
# endif
-STATIC void* S_parse_body(pTHX_ va_list args);
-STATIC void* S_run_body(pTHX_ va_list args);
-STATIC void* S_call_body(pTHX_ va_list args);
-STATIC void S_call_xbody(pTHX_ OP *myop, int is_eval);
-STATIC void* S_call_list_body(pTHX_ va_list args);
+STATIC void* S_parse_body(pTHX_ char **env, XSINIT_t xsinit);
+STATIC void* S_run_body(pTHX_ I32 oldscope);
+STATIC void S_call_body(pTHX_ OP *myop, int is_eval);
+STATIC void* S_call_list_body(pTHX_ CV *cv);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+STATIC void* S_vparse_body(pTHX_ va_list args);
+STATIC void* S_vrun_body(pTHX_ va_list args);
+STATIC void* S_vcall_body(pTHX_ va_list args);
+STATIC void* S_vcall_list_body(pTHX_ va_list args);
+#endif
# if defined(USE_THREADS)
STATIC struct perl_thread * S_init_main_thread(pTHX);
# endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
STATIC OP* S_docatch(pTHX_ OP *o);
-STATIC void* S_docatch_body(pTHX_ va_list args);
+STATIC void* S_docatch_body(pTHX);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+STATIC void* S_vdocatch_body(pTHX_ va_list args);
+#endif
STATIC OP* S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit);
STATIC void S_doparseform(pTHX_ SV *sv);
STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock);
}
if (!scan) /* It was not CURLYX, but CURLY. */
scan = next;
- if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0)
+ if (ckWARN(WARN_REGEXP) && (minnext + deltanext == 0)
&& !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
&& maxcount <= REG_INFTY/3) /* Complement check for big count */
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Strange *+?{} on zero-length expression");
min += minnext * mincount;
is_inf_internal |= (maxcount == REG_INFTY
goto do_curly;
}
nest_check:
- if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
- Perl_warner(aTHX_ WARN_UNSAFE, "%.*s matches null string many times",
+ if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
+ Perl_warner(aTHX_ WARN_REGEXP, "%.*s matches null string many times",
PL_regcomp_parse - origparse, origparse);
}
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(*p))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c passed through",
PL_regprecomp,
*p);
posixcc[skip + 1] == ']'))))
Perl_croak(aTHX_ "Character class [:%.*s:] unknown",
t - s - 1, s + 1);
- } else if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY)
+ } else if (ckWARN(WARN_REGEXP) && !SIZE_ONLY)
/* [[=foo=]] and [[.foo.]] are still future. */
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] is reserved for future extensions", c, c);
} else {
/* Maternal grandfather:
STATIC void
S_checkposixcc(pTHX)
{
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) &&
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
(*PL_regcomp_parse == ':' ||
*PL_regcomp_parse == '=' ||
*PL_regcomp_parse == '.')) {
while(*s && isALNUM(*s))
s++;
if (*s && c == *s && s[1] == ']') {
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] belongs inside character classes", c, c);
if (c == '=' || c == '.')
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] is reserved for future extensions", c, c);
}
}
ANYOF_FLAGS(ret) |= ANYOF_INVERT;
}
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
PL_regcomp_parse += numlen;
break;
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c in character class passed through",
PL_regprecomp,
(int)value);
need_class = 1;
if (range) { /* a-\d, a-[:digit:] */
if (!SIZE_ONLY) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
PL_regcomp_parse[1] != ']') {
PL_regcomp_parse++;
if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
listsv = newSVpvn("# comment\n",10);
}
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
PL_regcomp_parse += numlen;
break;
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c in character class passed through",
PL_regprecomp,
(int)value);
if (namedclass > OOB_NAMEDCLASS) {
if (range) { /* a-\d, a-[:digit:] */
if (!SIZE_ONLY) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
PL_regcomp_parse[1] != ']') {
PL_regcomp_parse++;
if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
? s + (prog->minlen? cl_l : 0)
: (prog->float_substr ? check_at - start_shift + cl_l
: strend) ;
- char *startpos = sv ? strend - SvCUR(sv) : s;
+ char *startpos = sv && SvPOK(sv) ? strend - SvCUR(sv) : s;
t = s;
if (prog->reganch & ROPT_UTF8) {
PL_regcc = cc;
if (n >= cc->max) { /* Maximum greed exceeded? */
- if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
+ if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
REPORT_CODE_OFF+PL_regindent*2, "")
);
}
- if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
+ if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
#define PERL_IN_SCOPE_C
#include "perl.h"
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
void *
Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
protect_body_t body, ...)
int ex;
void *ret;
- DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
- pcur_env, PL_top_env));
JMPENV_PUSH(ex);
if (ex)
ret = NULL;
JMPENV_POP;
return ret;
}
+#endif
SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
Sigjmp_buf je_buf; /* only for use if !je_throw */
int je_ret; /* last exception thrown */
bool je_mustcatch; /* need to call longjmp()? */
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
void (*je_throw)(int v); /* last for bincompat */
bool je_noset; /* no need for setjmp() */
+#endif
};
typedef struct jmpenv JMPENV;
-/*
- * Function that catches/throws, and its callback for the
- * body of protected processing.
- */
-typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
-typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
- int *, protect_body_t, ...);
+#ifdef OP_IN_REGISTER
+#define OP_REG_TO_MEM PL_opsave = op
+#define OP_MEM_TO_REG op = PL_opsave
+#else
+#define OP_REG_TO_MEM NOOP
+#define OP_MEM_TO_REG NOOP
+#endif
/*
* How to build the first jmpenv.
#define JMPENV_BOOTSTRAP \
STMT_START { \
- PL_start_env.je_prev = NULL; \
- PL_start_env.je_throw = NULL; \
+ Zero(&PL_start_env, 1, JMPENV); \
PL_start_env.je_ret = -1; \
PL_start_env.je_mustcatch = TRUE; \
- PL_start_env.je_noset = 0; \
PL_top_env = &PL_start_env; \
} STMT_END
-#ifdef OP_IN_REGISTER
-#define OP_REG_TO_MEM PL_opsave = op
-#define OP_MEM_TO_REG op = PL_opsave
-#else
-#define OP_REG_TO_MEM NOOP
-#define OP_MEM_TO_REG NOOP
-#endif
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
/*
* These exception-handling macros are split up to
* JMPENV_POP; // don't forget this!
*/
+/*
+ * Function that catches/throws, and its callback for the
+ * body of protected processing.
+ */
+typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
+typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
+ int *, protect_body_t, ...);
+
#define dJMPENV JMPENV cur_env; \
volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env)
#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env)
-
#define JMPENV_PUSH_ENV(ce,v) \
STMT_START { \
if (!(ce).je_noset) { \
+ DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
+ ce, PL_top_env)); \
JMPENV_PUSH_INIT_ENV(ce,NULL); \
EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, 1));\
(ce).je_noset = 1; \
#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v)
#define JMPENV_POP_ENV(ce) \
- STMT_START { PL_top_env = (ce).je_prev; } STMT_END
+ STMT_START { \
+ if (PL_top_env == &(ce)) \
+ PL_top_env = (ce).je_prev; \
+ } STMT_END
#define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env)
#define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v))
#define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v)
+#else /* !PERL_FLEXIBLE_EXCEPTIONS */
+
+#define dJMPENV JMPENV cur_env
+
+#define JMPENV_PUSH(v) \
+ STMT_START { \
+ DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
+ &cur_env, PL_top_env)); \
+ cur_env.je_prev = PL_top_env; \
+ OP_REG_TO_MEM; \
+ cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1); \
+ OP_MEM_TO_REG; \
+ PL_top_env = &cur_env; \
+ cur_env.je_mustcatch = FALSE; \
+ (v) = cur_env.je_ret; \
+ } STMT_END
+
+#define JMPENV_POP \
+ STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+
+#define JMPENV_JUMP(v) \
+ STMT_START { \
+ OP_REG_TO_MEM; \
+ if (PL_top_env->je_prev) \
+ PerlProc_longjmp(PL_top_env->je_buf, (v)); \
+ if ((v) == 2) \
+ PerlProc_exit(STATUS_NATIVE_EXPORT); \
+ PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
+ PerlProc_exit(1); \
+ } STMT_END
+
+#endif /* PERL_FLEXIBLE_EXCEPTIONS */
+
#define CATCH_GET (PL_top_env->je_mustcatch)
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
SV* sva = (SV*)ptr;
register SV* sv;
register SV* svend;
- Zero(sva, size, char);
+ Zero(ptr, size, char);
/* The first SV in an arena isn't an SV. */
SvANY(sva) = (void *) PL_sv_arenaroot; /* ptr to next arena */
Perl_croak(aTHX_
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
- if (!(CvGV(cv) && GvSTASH(CvGV(cv))
- && HvNAME(GvSTASH(CvGV(cv)))
- && strEQ(HvNAME(GvSTASH(CvGV(cv))),
- "autouse")))
- Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
+ if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE))
+ Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
"Constant subroutine %s redefined"
: "Subroutine %s redefined",
GvENAME((GV*)dstr));
- }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
}
else {
if (dtype == SVt_PVGV) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Undefined value assigned to typeglob");
+ if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
}
else
(void)SvOK_off(dstr);
break;
default: /* it had better be ten or less */
#if defined(PERL_Y2KWARN)
- if (ckWARN(WARN_MISC)) {
+ if (ckWARN(WARN_Y2K)) {
STRLEN n;
char *s = SvPV(sv,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ WARN_Y2K,
"Possible Y2K bug: %%%c %s",
c, "format string following '19'");
}
PL_dirty = proto_perl->Tdirty;
PL_localizing = proto_perl->Tlocalizing;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = proto_perl->Tprotect;
+#endif
PL_errors = sv_dup_inc(proto_perl->Terrors);
PL_av_fetch_sv = Nullsv;
PL_hv_fetch_sv = Nullsv;
#!./perl
-# $RCSfile: mkdir.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:06 $
+print "1..9\n";
-print "1..7\n";
-
-if ($^O eq 'VMS') { # May as well test the library too
- unshift @INC, '../lib';
- require File::Path;
- File::Path::rmtree('blurfl');
-}
-else {
- $^O eq 'MSWin32' ? `del /s /q blurfl 2>&1` : `rm -rf blurfl`;
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
}
+use File::Path;
+rmtree('blurfl');
+
# tests 3 and 7 rather naughtily expect English error messages
$ENV{'LC_ALL'} = 'C';
$ENV{LANGUAGE} = 'C'; # GNU locale extension
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
print ($! =~ /cannot find|such|exist|not found/i ? "ok 7\n" : "# $!\nnot ok 7\n");
+print (mkdir('blurfl') ? "ok 8\n" : "not ok 8\n");
+print (rmdir('blurfl') ? "ok 9\n" : "not ok 9\n");
-#!./perl
-print "1..108\n";
+print "1..125\n";
#P = start of string Q = start of substr R = end of substr S = end of string
-$a = 'abcdefxyz';
-BEGIN { $^W = 1 };
+BEGIN {
+ unshift @INC, '../lib' if -d '../lib' ;
+}
+use warnings ;
+$a = 'abcdefxyz';
$SIG{__WARN__} = sub {
if ($_[0] =~ /^substr outside of string/) {
$w++;
}
};
-sub fail { !defined(shift) && $w-- };
+sub ok { print (($_[1] ? "" : "not ") . "ok $_[0]\n") }
+
+$FATAL_MSG = '^substr outside of string' ;
-print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n"); # P=Q R S
-print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n"); # P Q R S
-print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R
-print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n"); # P R Q S
-print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); # P=Q R S
-print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); # P Q R S
+ok 1, substr($a,0,3) eq 'abc'; # P=Q R S
+ok 2, substr($a,3,3) eq 'def'; # P Q R S
+ok 3, substr($a,6,999) eq 'xyz'; # P Q S R
+$b = substr($a,999,999) ; # warn # P R Q S
+ok 4, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; };# P R Q S
+ok 5, $@ =~ /$FATAL_MSG/;
+ok 6, substr($a,0,-6) eq 'abc'; # P=Q R S
+ok 7, substr($a,-3,1) eq 'x'; # P Q R S
$[ = 1;
-print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n"); # P=Q R S
-print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n"); # P Q R S
-print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R
-print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S
-print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S
-print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); # P Q R S
+ok 8, substr($a,1,3) eq 'abc' ; # P=Q R S
+ok 9, substr($a,4,3) eq 'def' ; # P Q R S
+ok 10, substr($a,7,999) eq 'xyz';# P Q S R
+$b = substr($a,999,999) ; # warn # P R Q S
+ok 11, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; } ; # P R Q S
+ok 12, $@ =~ /$FATAL_MSG/;
+ok 13, substr($a,1,-6) eq 'abc' ;# P=Q R S
+ok 14, substr($a,-3,1) eq 'x' ; # P Q R S
$[ = 0;
substr($a,3,3) = 'XYZ';
-print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+ok 15, $a eq 'abcXYZxyz' ;
substr($a,0,2) = '';
-print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+ok 16, $a eq 'cXYZxyz' ;
substr($a,0,0) = 'ab';
-print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+ok 17, $a eq 'abcXYZxyz' ;
substr($a,0,0) = '12345678';
-print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+ok 18, $a eq '12345678abcXYZxyz' ;
substr($a,-3,3) = 'def';
-print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+ok 19, $a eq '12345678abcXYZdef';
substr($a,-3,3) = '<';
-print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+ok 20, $a eq '12345678abcXYZ<' ;
substr($a,-1,1) = '12345678';
-print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+ok 21, $a eq '12345678abcXYZ12345678' ;
$a = 'abcdefxyz';
-print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n"); # P Q R=S
-print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n"); # P Q R=S
-print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n"); # P R=S Q
-print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S
-print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n"); # P Q=R=S
-print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S
-print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n"); # P=Q R=S
+ok 22, substr($a,6) eq 'xyz' ; # P Q R=S
+ok 23, substr($a,-3) eq 'xyz' ; # P Q R=S
+$b = substr($a,999,999) ; # warning # P R=S Q
+ok 24, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; } ; # P R=S Q
+ok 25, $@ =~ /$FATAL_MSG/;
+ok 26, substr($a,0) eq 'abcdefxyz' ; # P=Q R=S
+ok 27, substr($a,9) eq '' ; # P Q=R=S
+ok 28, substr($a,-11) eq 'abcdefxyz'; # Q P R=S
+ok 29, substr($a,-9) eq 'abcdefxyz'; # P=Q R=S
$a = '54321';
-print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n"); # Q R P S
-print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n"); # Q R P S
-print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n"); # R P=Q S
-print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n"); # R P Q S
-print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n"); # R P Q S
-print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n"); # P=R Q S
-print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n"); # P=R Q S
-print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n"); # P R Q S
-print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n"); # P R Q S
-print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n"); # R P Q=S
-print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n"); # P=R Q S
-print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n"); # P R Q=S
-print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n"); # R P S Q
-print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n"); # P=R S Q
-print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n"); # P R S Q
-print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n"); # P S Q=R
-
-print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n"); # Q P=R S
-print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S
-print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S
-print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R
-print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n"); # P=Q=R S
-print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S
-print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S
-print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R
-print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n"); # P Q=R S
-print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S
-print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R
-print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n"); # P=Q=R S
-print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n"); # P Q=R S
-print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n"); # P=Q=R S
-print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S
-print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R
-print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n"); # P Q=R S
-print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S
-print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n"); # P Q=R=S
-print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n"); # P Q=S R
-print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n"); # Q P=R S
-print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S
-print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n"); # P=Q=R S
-print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S
-print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n"); # P Q=R S
-print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S
+$b = substr($a,-7, 1) ; # warn # Q R P S
+ok 30, $w-- == 1 ;
+eval{substr($a,-7, 1) = "" ; }; # Q R P S
+ok 31, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-7,-6) ; # warn # Q R P S
+ok 32, $w-- == 1 ;
+eval{substr($a,-7,-6) = "" ; }; # Q R P S
+ok 33, $@ =~ /$FATAL_MSG/;
+ok 34, substr($a,-5,-7) eq ''; # R P=Q S
+ok 35, substr($a, 2,-7) eq ''; # R P Q S
+ok 36, substr($a,-3,-7) eq ''; # R P Q S
+ok 37, substr($a, 2,-5) eq ''; # P=R Q S
+ok 38, substr($a,-3,-5) eq ''; # P=R Q S
+ok 39, substr($a, 2,-4) eq ''; # P R Q S
+ok 40, substr($a,-3,-4) eq ''; # P R Q S
+ok 41, substr($a, 5,-6) eq ''; # R P Q=S
+ok 42, substr($a, 5,-5) eq ''; # P=R Q S
+ok 43, substr($a, 5,-3) eq ''; # P R Q=S
+$b = substr($a, 7,-7) ; # warn # R P S Q
+ok 44, $w-- == 1 ;
+eval{substr($a, 7,-7) = "" ; }; # R P S Q
+ok 45, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7,-5) ; # warn # P=R S Q
+ok 46, $w-- == 1 ;
+eval{substr($a, 7,-5) = "" ; }; # P=R S Q
+ok 47, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7,-3) ; # warn # P Q S Q
+ok 48, $w-- == 1 ;
+eval{substr($a, 7,-3) = "" ; }; # P Q S Q
+ok 49, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7, 0) ; # warn # P S Q=R
+ok 50, $w-- == 1 ;
+eval{substr($a, 7, 0) = "" ; }; # P S Q=R
+ok 51, $@ =~ /$FATAL_MSG/;
+
+ok 52, substr($a,-7,2) eq ''; # Q P=R S
+ok 53, substr($a,-7,4) eq '54'; # Q P R S
+ok 54, substr($a,-7,7) eq '54321';# Q P R=S
+ok 55, substr($a,-7,9) eq '54321';# Q P S R
+ok 56, substr($a,-5,0) eq ''; # P=Q=R S
+ok 57, substr($a,-5,3) eq '543';# P=Q R S
+ok 58, substr($a,-5,5) eq '54321';# P=Q R=S
+ok 59, substr($a,-5,7) eq '54321';# P=Q S R
+ok 60, substr($a,-3,0) eq ''; # P Q=R S
+ok 61, substr($a,-3,3) eq '321';# P Q R=S
+ok 62, substr($a,-2,3) eq '21'; # P Q S R
+ok 63, substr($a,0,-5) eq ''; # P=Q=R S
+ok 64, substr($a,2,-3) eq ''; # P Q=R S
+ok 65, substr($a,0,0) eq ''; # P=Q=R S
+ok 66, substr($a,0,5) eq '54321';# P=Q R=S
+ok 67, substr($a,0,7) eq '54321';# P=Q S R
+ok 68, substr($a,2,0) eq ''; # P Q=R S
+ok 69, substr($a,2,3) eq '321'; # P Q R=S
+ok 70, substr($a,5,0) eq ''; # P Q=R=S
+ok 71, substr($a,5,2) eq ''; # P Q=S R
+ok 72, substr($a,-7,-5) eq ''; # Q P=R S
+ok 73, substr($a,-7,-2) eq '543';# Q P R S
+ok 74, substr($a,-5,-5) eq ''; # P=Q=R S
+ok 75, substr($a,-5,-2) eq '543';# P=Q R S
+ok 76, substr($a,-3,-3) eq ''; # P Q=R S
+ok 77, substr($a,-3,-1) eq '32';# P Q R S
$a = '';
-print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n"); # Q P=R=S
-print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n"); # P=Q=R=S
-print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n"); # P=Q=S R
-print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n"); # Q P=S R
-print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n"); # Q P=R=S
-print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n"); # P=Q=R=S
+ok 78, substr($a,-2,2) eq ''; # Q P=R=S
+ok 79, substr($a,0,0) eq ''; # P=Q=R=S
+ok 80, substr($a,0,1) eq ''; # P=Q=S R
+ok 81, substr($a,-2,3) eq ''; # Q P=S R
+ok 82, substr($a,-2) eq ''; # Q P=R=S
+ok 83, substr($a,0) eq ''; # P=Q=R=S
+
+
+ok 84, substr($a,0,-1) eq ''; # R P=Q=S
+$b = substr($a,-2, 0) ; # warn # Q=R P=S
+ok 85, $w-- == 1 ;
+eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
+ok 86, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-2, 1) ; # warn # Q R P=S
+ok 87, $w-- == 1 ;
+eval{substr($a,-2, 1) = "" ; }; # Q R P=S
+ok 88, $@ =~ /$FATAL_MSG/;
-print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n"); # R P=Q=S
-print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n"); # Q=R P=S
-print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n"); # Q R P=S
-print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n"); # Q R P=S
-print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n"); # Q=R P=S
-print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n"); # R P=S Q
-print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n"); # P=S Q R
-print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n"); # P=S Q=R
-print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n"); # P=R=S Q
+$b = substr($a,-2,-1) ; # warn # Q R P=S
+ok 89, $w-- == 1 ;
+eval{substr($a,-2,-1) = "" ; }; # Q R P=S
+ok 90, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-2,-2) ; # warn # Q=R P=S
+ok 91, $w-- == 1 ;
+eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
+ok 92, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1,-2) ; # warn # R P=S Q
+ok 93, $w-- == 1 ;
+eval{substr($a, 1,-2) = "" ; }; # R P=S Q
+ok 94, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1, 1) ; # warn # P=S Q R
+ok 95, $w-- == 1 ;
+eval{substr($a, 1, 1) = "" ; }; # P=S Q R
+ok 96, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1, 0) ;# warn # P=S Q=R
+ok 97, $w-- == 1 ;
+eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
+ok 98, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a,1) ; # warning # P=R=S Q
+ok 99, $w-- == 1 ;
+eval{substr($a,1) = "" ; }; # P=R=S Q
+ok 100, $@ =~ /$FATAL_MSG/;
my $a = 'zxcvbnm';
substr($a,2,0) = '';
-print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n";
+ok 101, $a eq 'zxcvbnm';
substr($a,7,0) = '';
-print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n";
+ok 102, $a eq 'zxcvbnm';
substr($a,5,0) = '';
-print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n";
+ok 103, $a eq 'zxcvbnm';
substr($a,0,2) = 'pq';
-print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n";
+ok 104, $a eq 'pqcvbnm';
substr($a,2,0) = 'r';
-print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n";
+ok 105, $a eq 'pqrcvbnm';
substr($a,8,0) = 'asd';
-print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n";
+ok 106, $a eq 'pqrcvbnmasd';
substr($a,0,2) = 'iop';
-print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n";
+ok 107, $a eq 'ioprcvbnmasd';
substr($a,0,5) = 'fgh';
-print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n";
+ok 108, $a eq 'fghvbnmasd';
substr($a,3,5) = 'jkl';
-print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n";
+ok 109, $a eq 'fghjklsd';
substr($a,3,2) = '1234';
-print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n";
+ok 110, $a eq 'fgh1234lsd';
# with lexicals (and in re-entered scopes)
unless ($_) {
$txt = "Foo";
substr($txt, -1) = "X";
- print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n";
+ ok 111, $txt eq "FoX";
}
else {
- local $^W = 0; # because of (spurious?) "uninitialised value"
substr($txt, 0, 1) = "X";
- print $txt eq "X" ? "ok 95\n" : "not ok 95\n";
+ ok 112, $txt eq "X";
}
}
+$w = 0 ;
# coercion of references
{
my $s = [];
substr($s, 0, 1) = 'Foo';
- print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n";
+ ok 113, substr($s,0,7) eq "FooRRAY" && !($w-=2);
}
# check no spurious warnings
-print $w ? "not ok 97\n" : "ok 97\n";
+ok 114, $w == 0;
# check new 4 arg replacement syntax
$a = "abcxyz";
$w = 0;
-print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
-print "ok 98\n";
-print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
-print "ok 99\n";
-print "not " unless substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
-print "ok 100\n";
-
-print "not " unless substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
+ok 115, substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
+ok 116, substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
+ok 117, substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
+
+ok 118, substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
&& $w == 3;
-print "ok 101\n";
+
$w = 0;
-print "not " unless substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
-print "ok 102\n";
-print "not " unless fail(substr($a, -99, 0, ""));
-print "ok 103\n";
-print "not " unless fail(substr($a, 99, 3, ""));
-print "ok 104\n";
+ok 119, substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
+eval{substr($a, -99, 0, "") };
+ok 120, $@ =~ /$FATAL_MSG/;
+eval{substr($a, 99, 3, "") };
+ok 121, $@ =~ /$FATAL_MSG/;
substr($a, 0, length($a), "foo");
-print "not " unless $a eq "foo" && !$w;
-print "ok 105\n";
+ok 122, $a eq "foo" && !$w;
# using 4 arg substr as lvalue is a compile time error
eval 'substr($a,0,0,"") = "abc"';
-print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
-print "ok 106\n";
+ok 123, $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
$a = "abcdefgh";
-print "not " unless sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
-print "ok 107\n";
-print "not " unless $a eq 'xxxxefgh';
-print "ok 108\n";
+ok 124, sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
+ok 125, $a eq 'xxxxefgh';
--- /dev/null
+Check warnings::enabled & warnings::warn
+
+__END__
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled() ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE--
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if warnings::enabled() ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'syntax' ;
+print "ok1\n" if warnings::enabled() ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+1;
+--FILE--
+use warnings 'io' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+no warnings ;
+print "ok1\n" if warnings::enabled() ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE--
+use warnings 'syntax' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+print "ok1\n" if warnings::enabled ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+print "ok3\n" if warnings::enabled("io") ;
+1;
+--FILE--
+use warnings 'io' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled() ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+no warnings;
+use abc ;
+1;
+--FILE--
+use warnings;
+use def ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if warnings::enabled() ;
+print "ok2\n" if warnings::enabled("syntax") ;
+print "ok3\n" if !warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+use warnings 'syntax' ;
+print "ok4\n" if warnings::enabled() ;
+print "ok5\n" if warnings::enabled("io") ;
+use abc ;
+1;
+--FILE--
+use warnings 'io' ;
+use def ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+require "abc" ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if warnings::enabled("io") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+require "abc" ;
+eval { use warnings 'io' ; abc::check() ; };
+abc::check() ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+ print "ok1\n" if ! warnings::enabled ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check {
+ print "ok1\n" if warnings::enabled ;
+ print "ok2\n" if warnings::enabled("syntax") ;
+ print "ok3\n" if warnings::enabled("io") ;
+ print "ok4\n" if ! warnings::enabled("misc") ;
+}
+1;
+--FILE--
+use warnings 'syntax' ;
+use abc ;
+sub fred { use warnings 'io' ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+# check warnings::warn
+use warnings ;
+eval { warnings::warn() } ;
+print $@ ;
+eval { warnings::warn("fred") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warn('category', 'message') at - line 4
+Usage: warnings::warn('category', 'message') at - line 6
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("misc", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL deprecated ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL io ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+]]
local $a, $b = (1,2);
Bareword found in conditional at -e line 1.
- use warnings 'syntax'; my $x = print(ABC || 1);
+ use warnings 'bareword'; my $x = print(ABC || 1);
Value of %s may be \"0\"; use \"defined\"
$x = 1 if $x = <FH> ;
__END__
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $x ;
my $x ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $x ;
EXPECT
"my" variable $x masks earlier declaration in same scope at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'closure' ;
sub x {
my $x;
sub y {
Variable "$x" will not stay shared at - line 7.
########
# op.c
-no warnings 'unsafe' ;
+no warnings 'closure' ;
sub x {
my $x;
sub y {
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'closure' ;
sub x {
my $x;
sub y {
Variable "$x" may be unavailable at - line 6.
########
# op.c
-no warnings 'unsafe' ;
+no warnings 'closure' ;
sub x {
my $x;
sub y {
########
# op.c
BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
{
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
Parentheses missing around "local" list at - line 3.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'bareword' ;
print (ABC || 1) ;
-no warnings 'syntax' ;
+no warnings 'bareword' ;
print (ABC || 1) ;
EXPECT
Bareword found in conditional at - line 3.
--FILE--
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
open FH, "<abc" ;
$x = 1 if $x = <FH> ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = <FH> ;
EXPECT
Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
opendir FH, "." ;
$x = 1 if $x = readdir FH ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = readdir FH ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
$x = 1 if $x = <*> ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = <*> ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
%a = (1,2,3,4) ;
$x = 1 if $x = each %a ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = each %a ;
EXPECT
Value of each() operator can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
opendir FH, "." ;
$x = 1 while $x = readdir FH and 0 ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 while $x = readdir FH and 0 ;
closedir FH ;
EXPECT
Format FRED redefined at - line 5.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'deprecated' ;
push FRED;
-no warnings 'syntax' ;
+no warnings 'deprecated' ;
push FRED;
EXPECT
Array @FRED missing the @ in argument 1 of push() at - line 3.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'deprecated' ;
@a = keys FRED ;
-no warnings 'syntax' ;
+no warnings 'deprecated' ;
@a = keys FRED ;
EXPECT
Hash %FRED missing the % in argument 1 of keys() at - line 3.
sub fred() ;
sub fred($) {}
{
- no warnings 'unsafe' ;
+ no warnings 'prototype' ;
sub Fred() ;
sub Fred($) {}
- use warnings 'unsafe' ;
+ use warnings 'prototype' ;
sub freD() ;
sub freD($) {}
}
/---/ should probably be written as "---" at - line 3.
########
# op.c [Perl_peep]
-use warnings 'unsafe' ;
+use warnings 'prototype' ;
fred() ;
sub fred ($$) {}
-no warnings 'unsafe' ;
+no warnings 'prototype' ;
joe() ;
sub joe ($$) {}
EXPECT
pp.c TODO
substr outside of string
- $a = "ab" ; $a = substr($a, 4,5)
+ $a = "ab" ; $b = substr($a, 4,5) ;
Attempt to use reference as lvalue in substr
$a = "ab" ; $b = \$a ; substr($b, 1,1) = $b
# pp.c
use warnings 'substr' ;
$a = "ab" ;
-$a = substr($a, 4,5);
+$b = substr($a, 4,5) ;
no warnings 'substr' ;
$a = "ab" ;
-$a = substr($a, 4,5);
+$b = substr($a, 4,5) ;
EXPECT
substr outside of string at - line 4.
########
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a = { 1,2,3};
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $b = { 1,2,3};
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'pack' ;
+use warnings 'unpack' ;
my @a = unpack ("A,A", "22") ;
my $a = pack ("A,A", 1,2) ;
-no warnings 'unsafe' ;
+no warnings 'pack' ;
+no warnings 'unpack' ;
my @b = unpack ("A,A", "22") ;
my $b = pack ("A,A", 1,2) ;
EXPECT
-Invalid type in unpack: ',' at - line 3.
-Invalid type in pack: ',' at - line 4.
+Invalid type in unpack: ',' at - line 4.
+Invalid type in pack: ',' at - line 5.
########
# pp.c
use warnings 'uninitialized' ;
Use of uninitialized value in scalar dereference at - line 4.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'pack' ;
sub foo { my $a = "a"; return $a . $a++ . $a++ }
my $a = pack("p", &foo) ;
-no warnings 'unsafe' ;
+no warnings 'pack' ;
my $b = pack("p", &foo) ;
EXPECT
Attempt to pack pointer to temporary value at - line 4.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
bless \[], "" ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
bless \[], "" ;
EXPECT
Explicit blessing to '' (assuming package main) at - line 3.
1
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
$_ = "abc" ;
while ($i ++ == 0)
{
s/ab/last/e ;
}
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last/e ;
Exiting substitution via last at - line 7.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
sub fred { last }
{ fred() }
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
sub joe { last }
{ joe() }
EXPECT
########
# pp_ctl.c
{
- eval "use warnings 'unsafe' ; last;"
+ eval "use warnings 'exiting' ; last;"
}
print STDERR $@ ;
{
- eval "no warnings 'unsafe' ;last;"
+ eval "no warnings 'exiting' ;last;"
}
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
@a = (1,2) ;
@b = sort { last } @a ;
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a loop block at - line 4.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
$_ = "abc" ;
fred:
while ($i ++ == 0)
{
s/ab/last fred/e ;
}
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last fred/e ;
Exiting substitution via last at - line 7.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
sub fred { last joe }
joe: { fred() }
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
sub Fred { last Joe }
Joe: { Fred() }
EXPECT
########
# pp_ctl.c
joe:
-{ eval "use warnings 'unsafe' ; last joe;" }
+{ eval "use warnings 'exiting' ; last joe;" }
print STDERR $@ ;
Joe:
-{ eval "no warnings 'unsafe' ; last Joe;" }
+{ eval "no warnings 'exiting' ; last Joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
@a = (1,2) ;
fred: @b = sort { last fred } @a ;
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
Fred: @b = sort { last Fred } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
EXPECT
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
-no warnings 'unsafe' ;
+no warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
Use of uninitialized value in hash dereference at - line 4.
########
# pp_hot.c [pp_aassign]
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my %X ; %X = (1,2,3) ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my %Y ; %Y = (1,2,3) ;
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp_hot.c [pp_aassign]
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my %X ; %X = [1 .. 3] ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my %Y ; %Y = [1 .. 3] ;
EXPECT
Reference found where even-sized list expected at - line 3.
EXPECT
########
# pp_hot.c [pp_concat]
-use warnings 'misc';
+use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
$x = "19" . $yy . "\n";
$x = "319$yy\n";
$x = "319" . $yy . "\n";
-no warnings 'misc';
+no warnings 'y2k';
$x = "19$yy\n";
$x = "19" . $yy . "\n";
EXPECT
$a = "ABC123" ; $a =~ /(?=a)*/'
/%.127s/: Unrecognized escape \\%c passed through" [S_regatom]
- /\m/
+ $x = '\m' ; /$x/
Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
__END__
# regcomp.c [S_regpiece]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
my $a = "ABC123" ;
$a =~ /(?=a)*/ ;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$a =~ /(?=a)*/ ;
EXPECT
(?=a)* matches null string many times at - line 4.
########
# regcomp.c [S_study_chunk]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$_ = "" ;
/(?=a)?/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/(?=a)?/;
EXPECT
Strange *+?{} on zero-length expression at - line 4.
########
# regcomp.c [S_regatom]
-use warnings 'unsafe' ;
-$a =~ /a\mb\b/ ;
-no warnings 'unsafe' ;
-$a =~ /a\mb\b/ ;
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
EXPECT
-Unrecognized escape \m passed through at - line 3.
+/a\m/: Unrecognized escape \m passed through at - line 4.
########
# regcomp.c [S_regpposixcc S_checkposixcc]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$_ = "" ;
/[:alpha:]/;
/[.bar.]/;
/[[.foo.]]/;
/[[=bar=]]/;
/[:zog:]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[:alpha:]/;
/[.foo.]/;
/[=bar=]/;
########
# regcomp.c [S_regclass]
$_ = "";
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
}
use utf8;
$_ = "";
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 19.
########
# regcomp.c [S_regclass S_regclassutf8]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$a =~ /[a\zb]/ ;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$a =~ /[a\zb]/ ;
EXPECT
/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3.
__END__
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
Invalid conversion in printf: "%\002" at - line 8.
########
# sv.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
*a = undef ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
*b = undef ;
EXPECT
Undefined value assigned to typeglob at - line 3.
\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 12.
########
# sv.c
-use warnings 'misc';
+use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
$x = sprintf "19%02d\n", 78;
$x = printf "319%02d\n", $yy;
$x = sprintf "319%02d\n", $yy;
-no warnings 'misc';
+no warnings 'y2k';
$x = printf "19%02d\n", $yy;
$x = sprintf "19%02d\n", $yy;
$x = printf "19%02d\n", 78;
warn(warn_reserved
$a = abc;
- chmod: mode argument is missing initial 0
+ chmod() mode argument is missing initial 0
chmod 3;
Possible attempt to separate words with commas
Unquoted string "abc" may clash with future reserved word at - line 3.
########
# toke.c
-use warnings 'octal' ;
+use warnings 'chmod' ;
chmod 3;
-no warnings 'octal' ;
+no warnings 'chmod' ;
chmod 3;
EXPECT
-chmod: mode argument is missing initial 0 at - line 3.
+chmod() mode argument is missing initial 0 at - line 3.
########
# toke.c
-use warnings 'syntax' ;
+use warnings 'qw' ;
@a = qw(a, b, c) ;
-no warnings 'syntax' ;
+no warnings 'qw' ;
@a = qw(a, b, c) ;
EXPECT
Possible attempt to separate words with commas at - line 3.
########
# toke.c
-use warnings 'syntax' ;
+use warnings 'qw' ;
@a = qw(a b #) ;
-no warnings 'syntax' ;
+no warnings 'qw' ;
@a = qw(a b #) ;
EXPECT
Possible attempt to put comments in qw() list at - line 3.
########
# toke.c
-use warnings 'octal' ;
+use warnings 'umask' ;
umask 3;
-no warnings 'octal' ;
+no warnings 'umask' ;
umask 3;
EXPECT
umask: argument is missing initial 0 at - line 3.
Misplaced _ in number at - line 4.
########
# toke.c
-use warnings 'unsafe' ;
+use warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
-no warnings 'unsafe' ;
+no warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
EXPECT
$^W = 0 ;
open FOO || time;
{
- no warnings 'ambiguous' ;
+ no warnings 'precedence' ;
open FOO || time;
- use warnings 'ambiguous' ;
+ use warnings 'precedence' ;
open FOO || time;
}
open FOO || time;
Ambiguous use of * resolved as operator * at - line 10.
########
# toke.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a = "\m" ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$a = "\m" ;
EXPECT
Unrecognized escape \m passed through at - line 3.
*
* When building without USE_THREADS, these variables will be truly global.
* When building without USE_THREADS but with MULTIPLICITY, these variables
- * will be global per-interpreter.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING. That way,
- * we can keep binary compatibility of the curinterp structure */
+ * will be global per-interpreter. */
/* Important ones in the first cache line (if alignment is done right) */
PERLVAR(Ttop_env, JMPENV *) /* ptr. to current sigjmp() environment */
PERLVAR(Tstart_env, JMPENV) /* empty startup sigjmp() environment */
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
PERLVARI(Tprotect, protect_proc_t, MEMBER_TO_FPTR(Perl_default_protect))
+#endif
PERLVARI(Terrors, SV *, Nullsv) /* outstanding queued errors */
/* statics "owned" by various functions */
default:
{
dTHR;
- if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && isALPHA(*s))
+ Perl_warner(aTHX_ WARN_MISC,
"Unrecognized escape \\%c passed through",
*s);
/* default action is to copy the quoted character */
if (len > 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ Perl_warner(aTHX_ WARN_BAREWORD,
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
len -= 2;
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_CHMOD)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
- "chmod: mode argument is missing initial 0");
+ Perl_warner(aTHX_ WARN_CHMOD,
+ "chmod() mode argument is missing initial 0");
}
LOP(OP_CHMOD,XTERM);
char *t;
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
t = skipspace(d);
- if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS))
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE))
+ Perl_warner(aTHX_ WARN_PRECEDENCE,
"Precedence problem: open %.*s should be open(%.*s)",
d-s,s, d-s,s);
}
for (; isSPACE(*d) && len; --len, ++d) ;
if (len) {
char *b = d;
- if (!warned && ckWARN(WARN_SYNTAX)) {
+ if (!warned && ckWARN(WARN_QW)) {
for (; !isSPACE(*d) && len; --len, ++d) {
if (*d == ',') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to separate words with commas");
++warned;
}
else if (*d == '#') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to put comments in qw() list");
++warned;
}
LOP(OP_UTIME,XTERM);
case KEY_umask:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_UMASK)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
+ Perl_warner(aTHX_ WARN_UMASK,
"umask: argument is missing initial 0");
}
UNI(OP_UMASK);
/* parent thread's data needs to be locked while we make copy */
MUTEX_LOCK(&t->mutex);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = t->Tprotect;
+#endif
PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */
PL_defstash = t->Tdefstash; /* XXX maybe these should */
#: This file uses MMS syntax, and can be processed using DEC's MMS product,
#: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to
#: a Unix-style MAKE tool, run this file through mms2make.pl, which should
-#: be found in the same directory as this file. (There should be a pre-made
-#: copy of Makefile for VAXC in this directory to allow you to build perl.)
+#: be found in the same directory as this file.
#:
#: Lines beginning with "#:" will be removed by mms2make.pl when converting
#: this file to MAKE syntax.
@ $(NOOP)
utils : $(utils1) $(utils2)
@ $(NOOP)
-podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com [.lib.pod]pod2man.com
+podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com [.lib.pod]pod2man.com [.lib.pod]podchecker.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
-pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldelta.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod
-pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod
-pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllocale.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod
-pod5 = [.lib.pod]perlop.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod [.lib.pod]perlref.pod [.lib.pod]perlreftut.pod
-pod6 = [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod
-pod7 = [.lib.pod]perltie.pod [.lib.pod]perltoc.pod [.lib.pod]perltoot.pod
-pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
-
-perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod
+pod1 = [.lib.pod]perl.pod [.lib.pod]perl5004delta.pod [.lib.pod]perl5005delta.pod [.lib.pod]perlapi.pod [.lib.pod]perlapio.pod [.lib.pod]perlbook.pod
+pod2 = [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod [.lib.pod]perlcompile.pod [.lib.pod]perldata.pod [.lib.pod]perldbmfilter.pod [.lib.pod]perldebug.pod [.lib.pod]perldelta.pod
+pod3 = [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod [.lib.pod]perlembed.pod [.lib.pod]perlfork.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod
+pod4 = [.lib.pod]perlguts.pod [.lib.pod]perlhack.pod [.lib.pod]perlhist.pod [.lib.pod]perlipc.pod [.lib.pod]perllexwarn.pod [.lib.pod]perllocale.pod [.lib.pod]perllol.pod
+pod5 = [.lib.pod]perlmod.pod [.lib.pod]perlmodinstall.pod [.lib.pod]perlmodlib.pod [.lib.pod]perlobj.pod [.lib.pod]perlop.pod [.lib.pod]perlopentut.pod [.lib.pod]perlpod.pod
+pod6 = [.lib.pod]perlport.pod [.lib.pod]perlre.pod [.lib.pod]perlref.pod [.lib.pod]perlreftut.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod
+pod7 = [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod [.lib.pod]perltodo.pod
+pod8 = [.lib.pod]perltoot.pod [.lib.pod]perltootc.pod [.lib.pod]perltrap.pod [.lib.pod]perlunicode.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
+pod9 = [.lib.pod]perlfaq.pod [.lib.pod]perlfaq1.pod [.lib.pod]perlfaq2.pod [.lib.pod]perlfaq3.pod [.lib.pod]perlfaq4.pod [.lib.pod]perlfaq5.pod
+pod10 = [.lib.pod]perlfaq6.pod [.lib.pod]perlfaq7.pod [.lib.pod]perlfaq8.pod [.lib.pod]perlfaq9.pod
+
+perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) [.lib.pod]perlvms.pod [.lib.pod]README_vms.pod
@ $(NOOP)
archcorefiles : $(ac) $(acth) $(ARCHAUTO)time.stamp
$(MINIPERL) $(MMS$SOURCE)
Copy/Log [.pod]pod2text.com $(MMS$TARGET)
+[.lib.pod]podchecker.com : [.pod]podchecker.PL $(ARCHDIR)Config.pm
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ $(MINIPERL) $(MMS$SOURCE)
+ Copy/Log [.pod]podchecker.com $(MMS$TARGET)
+
preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM)
@ Write Sys$Output "Autosplitting Perl library . . ."
@ Create/Directory [.lib.auto]
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perl5004delta.pod : [.pod]perl5004delta.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perl5005delta.pod : [.pod]perl5005delta.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlapi.pod : [.pod]perlapi.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlapio.pod : [.pod]perlapio.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlcompile.pod : [.pod]perlcompile.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perldata.pod : [.pod]perldata.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perldbmfilter.pod : [.pod]perldbmfilter.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perldebug.pod : [.pod]perldebug.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlfaq.pod : [.pod]perlfaq.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq1.pod : [.pod]perlfaq1.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq2.pod : [.pod]perlfaq2.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq3.pod : [.pod]perlfaq3.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq4.pod : [.pod]perlfaq4.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq5.pod : [.pod]perlfaq5.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq6.pod : [.pod]perlfaq6.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq7.pod : [.pod]perlfaq7.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq8.pod : [.pod]perlfaq8.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfaq9.pod : [.pod]perlfaq9.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfilter.pod : [.pod]perlfilter.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfork.pod : [.pod]perlfork.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlform.pod : [.pod]perlform.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
-[.lib.pod]perllocale.pod : [.pod]perllocale.pod
+[.lib.pod]perlhack.pod : [.pod]perlhack.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlhist.pod : [.pod]perlhist.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlintern.pod : [.pod]perlintern.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perllexwarn.pod : [.pod]perllexwarn.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perllocale.pod : [.pod]perllocale.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perllol.pod : [.pod]perllol.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlmodinstall.pod : [.pod]perlmodinstall.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlmodlib.pod : [.pod]perlmodlib.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlobj.pod : [.pod]perlobj.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlopentut.pod : [.pod]perlopentut.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlpod.pod : [.pod]perlpod.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlport.pod : [.pod]perlport.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlre.pod : [.pod]perlre.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlreftut.pod : [.pod]perlreftut.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perlrun.pod : [.pod]perlrun.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perlthrtut.pod : [.pod]perlthrtut.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perltie.pod : [.pod]perltie.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]perltodo.pod : [.pod]perltodo.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
[.lib.pod]perltoot.pod : [.pod]perltoot.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
-[.lib.pod]perlreftut.pod : [.pod]perlreftut.pod
+[.lib.pod]perltootc.pod : [.pod]perltootc.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+[.lib.pod]README_vms.pod : README.vms
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlwin32.pod : README.win32
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
printconfig :
@ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS)
@ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(FULLLIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)"
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x)))
-#define WARN_IO 0
-#define WARN_CLOSED 1
-#define WARN_EXEC 2
-#define WARN_NEWLINE 3
-#define WARN_PIPE 4
-#define WARN_UNOPENED 5
-#define WARN_MISC 6
-#define WARN_NUMERIC 7
-#define WARN_ONCE 8
-#define WARN_RECURSION 9
-#define WARN_REDEFINE 10
-#define WARN_SEVERE 11
-#define WARN_DEBUGGING 12
-#define WARN_INPLACE 13
-#define WARN_INTERNAL 14
-#define WARN_SYNTAX 15
-#define WARN_AMBIGUOUS 16
-#define WARN_BAREWORD 17
-#define WARN_DEPRECATED 18
-#define WARN_DIGIT 19
-#define WARN_OCTAL 20
-#define WARN_PARENTHESIS 21
-#define WARN_PRINTF 22
-#define WARN_RESERVED 23
-#define WARN_SEMICOLON 24
-#define WARN_UNINITIALIZED 25
-#define WARN_UNSAFE 26
-#define WARN_CLOSURE 27
-#define WARN_OVERFLOW 28
-#define WARN_PORTABLE 29
-#define WARN_SIGNAL 30
-#define WARN_SUBSTR 31
-#define WARN_TAINT 32
-#define WARN_UNTIE 33
-#define WARN_UTF8 34
-#define WARN_VOID 35
-
-#define WARNsize 9
-#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125"
-#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0"
+#define WARN_CHMOD 0
+#define WARN_CLOSURE 1
+#define WARN_EXITING 2
+#define WARN_GLOB 3
+#define WARN_IO 4
+#define WARN_CLOSED 5
+#define WARN_EXEC 6
+#define WARN_NEWLINE 7
+#define WARN_PIPE 8
+#define WARN_UNOPENED 9
+#define WARN_MISC 10
+#define WARN_NUMERIC 11
+#define WARN_ONCE 12
+#define WARN_OVERFLOW 13
+#define WARN_PACK 14
+#define WARN_PORTABLE 15
+#define WARN_RECURSION 16
+#define WARN_REDEFINE 17
+#define WARN_REGEXP 18
+#define WARN_SEVERE 19
+#define WARN_DEBUGGING 20
+#define WARN_INPLACE 21
+#define WARN_INTERNAL 22
+#define WARN_MALLOC 23
+#define WARN_SIGNAL 24
+#define WARN_SUBSTR 25
+#define WARN_SYNTAX 26
+#define WARN_AMBIGUOUS 27
+#define WARN_BAREWORD 28
+#define WARN_DEPRECATED 29
+#define WARN_DIGIT 30
+#define WARN_PARENTHESIS 31
+#define WARN_PRECEDENCE 32
+#define WARN_PRINTF 33
+#define WARN_PROTOTYPE 34
+#define WARN_QW 35
+#define WARN_RESERVED 36
+#define WARN_SEMICOLON 37
+#define WARN_TAINT 38
+#define WARN_UMASK 39
+#define WARN_UNINITIALIZED 40
+#define WARN_UNPACK 41
+#define WARN_UNTIE 42
+#define WARN_UTF8 43
+#define WARN_VOID 44
+#define WARN_Y2K 45
+
+#define WARNsize 12
+#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
+#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0"
/* end of file warnings.h */
sub DEFAULT_OFF () { 2 }
my $tree = {
- 'unsafe' => { 'untie' => DEFAULT_OFF,
- 'substr' => DEFAULT_OFF,
- 'taint' => DEFAULT_OFF,
- 'signal' => DEFAULT_OFF,
- 'closure' => DEFAULT_OFF,
- 'overflow' => DEFAULT_OFF,
- 'portable' => DEFAULT_OFF,
- 'utf8' => DEFAULT_OFF,
- } ,
- 'io' => { 'pipe' => DEFAULT_OFF,
+ 'io' => { 'pipe' => DEFAULT_OFF,
'unopened' => DEFAULT_OFF,
'closed' => DEFAULT_OFF,
'newline' => DEFAULT_OFF,
'exec' => DEFAULT_OFF,
- #'wr in in file'=> DEFAULT_OFF,
},
- 'syntax' => { 'ambiguous' => DEFAULT_OFF,
+ 'syntax' => { 'ambiguous' => DEFAULT_OFF,
'semicolon' => DEFAULT_OFF,
+ 'precedence' => DEFAULT_OFF,
'bareword' => DEFAULT_OFF,
'reserved' => DEFAULT_OFF,
- 'octal' => DEFAULT_OFF,
'digit' => DEFAULT_OFF,
'parenthesis' => DEFAULT_OFF,
'deprecated' => DEFAULT_OFF,
'printf' => DEFAULT_OFF,
+ 'prototype' => DEFAULT_OFF,
+ 'qw' => DEFAULT_OFF,
},
- 'severe' => { 'inplace' => DEFAULT_ON,
+ 'severe' => { 'inplace' => DEFAULT_ON,
'internal' => DEFAULT_ON,
'debugging' => DEFAULT_ON,
+ 'malloc' => DEFAULT_ON,
},
- 'void' => DEFAULT_OFF,
- 'recursion' => DEFAULT_OFF,
- 'redefine' => DEFAULT_OFF,
- 'numeric' => DEFAULT_OFF,
- 'uninitialized'=> DEFAULT_OFF,
- 'once' => DEFAULT_OFF,
- 'misc' => DEFAULT_OFF,
+ 'void' => DEFAULT_OFF,
+ 'recursion' => DEFAULT_OFF,
+ 'redefine' => DEFAULT_OFF,
+ 'numeric' => DEFAULT_OFF,
+ 'uninitialized' => DEFAULT_OFF,
+ 'once' => DEFAULT_OFF,
+ 'misc' => DEFAULT_OFF,
+ 'regexp' => DEFAULT_OFF,
+ 'glob' => DEFAULT_OFF,
+ 'y2k' => DEFAULT_OFF,
+ 'chmod' => DEFAULT_OFF,
+ 'umask' => DEFAULT_OFF,
+ 'untie' => DEFAULT_OFF,
+ 'substr' => DEFAULT_OFF,
+ 'taint' => DEFAULT_OFF,
+ 'signal' => DEFAULT_OFF,
+ 'closure' => DEFAULT_OFF,
+ 'overflow' => DEFAULT_OFF,
+ 'portable' => DEFAULT_OFF,
+ 'utf8' => DEFAULT_OFF,
+ 'exiting' => DEFAULT_OFF,
+ 'pack' => DEFAULT_OFF,
+ 'unpack' => DEFAULT_OFF,
#'default' => DEFAULT_ON,
} ;
}
###########################################################################
+sub printTree
+{
+ my $tre = shift ;
+ my $prefix = shift ;
+ my $indent = shift ;
+ my ($k, $v) ;
+
+ my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
+
+ $prefix .= " " x $indent ;
+ foreach $k (sort keys %$tre) {
+ $v = $tre->{$k};
+ print $prefix . "|\n" ;
+ print $prefix . "+- $k" ;
+ if (ref $v)
+ {
+ print " " . "-" x ($max - length $k ) . "+\n" ;
+ printTree ($v, $prefix . "|" , $max + $indent - 1)
+ }
+ else
+ { print "\n" }
+ }
+
+}
+
+###########################################################################
sub mkHex
{
###########################################################################
+if (@ARGV && $ARGV[0] eq "tree")
+{
+ print " all -+\n" ;
+ printTree($tree, " ", 4) ;
+ exit ;
+}
#unlink "warnings.h";
#unlink "lib/warnings.pm";
}
print PM " );\n\n" ;
+print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
while (<DATA>) {
print PM $_ ;
}
use warnings "all";
no warnings "all";
+ if (warnings::enabled("void") {
+ warnings::warn("void", "some warning");
+ }
+
=head1 DESCRIPTION
If no import list is supplied, all possible warnings are either enabled
or disabled.
-See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
+Two functions are provided to assist module authors.
+
+=over 4
+
+=item warnings::enabled($category)
+
+Returns TRUE if the warnings category in C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
+
+
+=item warnings::warn($category, $message)
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
+
+=back
+
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
=cut
sub enabled
{
- my $string = shift ;
-
+ # If no parameters, check for any lexical warnings enabled
+ # in the users scope.
+ my $callers_bitmask = (caller(1))[9] ;
+ return ($callers_bitmask ne $NONE) if @_ == 0 ;
+
+ # otherwise check for the category supplied.
+ my $category = shift ;
+ return 0
+ unless $Bits{$category} ;
+ return 0 unless defined $callers_bitmask ;
return 1
- if $bits{$string} && ${^WARNING_BITS} & $bits{$string} ;
+ if ($callers_bitmask & $Bits{$category}) ne $NONE ;
return 0 ;
}
+sub warn
+{
+ croak "Usage: warnings::warn('category', 'message')"
+ unless @_ == 2 ;
+ my $category = shift ;
+ my $message = shift ;
+ local $Carp::CarpLevel = 1 ;
+ my $callers_bitmask = (caller(1))[9] ;
+ croak($message)
+ if defined $callers_bitmask &&
+ ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+ carp($message) ;
+}
+
1;
return g_win32_get_sitelib(pl);
}
+void
+PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
+{
+ win32_get_child_IO(ptr);
+}
+
struct IPerlEnv perlEnv =
{
PerlEnvGetenv,
PerlEnvOsId,
PerlEnvLibPath,
PerlEnvSiteLibPath,
+ PerlEnvGetChildIO,
};
#undef IPERL2HOST
return -1;
}
- EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */
+ /*
+ * If lockinitflag is FALSE, assume fd is device
+ * lockinitflag is set to TRUE by open.
+ */
+ if (_pioinfo(fh)->lockinitflag)
+ EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */
bytes_read = 0; /* nothing read yet */
buffer = (char*)buf;
}
functionexit:
- LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */
+ if (_pioinfo(fh)->lockinitflag)
+ LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */
return bytes_read;
}
int ret;
void* env;
char* dir;
+ child_IO_table tbl;
STARTUPINFO StartupInfo;
PROCESS_INFORMATION ProcessInformation;
DWORD create = 0;
}
memset(&StartupInfo,0,sizeof(StartupInfo));
StartupInfo.cb = sizeof(StartupInfo);
- StartupInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
- StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
- StartupInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);
+ PerlEnv_get_child_IO(&tbl);
+ StartupInfo.hStdInput = tbl.childStdIn;
+ StartupInfo.hStdOutput = tbl.childStdOut;
+ StartupInfo.hStdError = tbl.childStdErr;
if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE &&
StartupInfo.hStdOutput != INVALID_HANDLE_VALUE &&
StartupInfo.hStdError != INVALID_HANDLE_VALUE)
MALLOC_INIT;
}
+void
+win32_get_child_IO(child_IO_table* ptbl)
+{
+ ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
+ ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE);
+}
+
+
#ifdef USE_ITHREADS
# ifdef PERL_OBJECT
DllExport bool SetPerlInterpreter(void* interp);
DllExport void* GetPerlInterpreter(void);
+typedef struct {
+ HANDLE childStdIn;
+ HANDLE childStdOut;
+ HANDLE childStdErr;
+} child_IO_table;
+
+DllExport void win32_get_child_IO(child_IO_table* ptr);
+
#ifndef USE_SOCKETS_AS_HANDLES
extern FILE * my_fdopen(int, char *);
#endif
https://perl5.git.perl.org / perl5.git / commitdiff