diff options
| author | Charles Bailey <bailey@newman.upenn.edu> | 2000-02-26 07:04:55 +0000 |
|---|---|---|
| committer | bailey <bailey@newman.upenn.edu> | 2000-02-26 07:04:55 +0000 |
| commit | 2841d78411ddadd05a6fbe13e0be06f765fad3fb (patch) | |
| tree | 5654902690bfb2994f8fe0a17c4bb3c1d7e46797 | |
| parent | cdc0122e98f2421b6507acbc7231bee768f9d260 (diff) | |
| parent | ffb04cf170fa14d0606f2c3643c438d43784ee46 (diff) | |
| download | perl-2841d78411ddadd05a6fbe13e0be06f765fad3fb.tar.gz | |
Resync with mainline
p4raw-id: //depot/vmsperl@5269
330 files changed, 14887 insertions, 10728 deletions
@@ -14,37 +14,53 @@ releases.) 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: @@ -75,10 +91,1005 @@ indicator: ---------------- -Version v5.5.650 Development release working toward v5.6 +Version v5.5.660 Development release working toward v5.6 ---------------- ____________________________________________________________________________ +[ 5198] By: gsar on 2000/02/22 10:45:54 + Log: PodParser-1.093 update (from Brad Appleton's site) + Branch: perl + ! lib/Pod/Checker.pm lib/Pod/Find.pm lib/Pod/InputObjects.pm + ! lib/Pod/ParseUtils.pm lib/Pod/Parser.pm lib/Pod/Select.pm + ! lib/Pod/Usage.pm t/pod/poderrs.t t/pod/poderrs.xr + ! t/pod/special_seqs.t t/pod/special_seqs.xr +____________________________________________________________________________ +[ 5197] By: gsar on 2000/02/22 10:24:13 + Log: integrate cfgperl contents into mainline, update Changes + Branch: perl + ! Changes pod/perlhist.pod + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH hints/solaris_2.sh malloc.c perl.h + !> pod/perldelta.pod +____________________________________________________________________________ +[ 5196] By: gsar on 2000/02/22 10:10:36 + Log: dos-djgpp updates (from Laszlo Molnar <laszlo.molnar@eth.ericsson.se>) + Branch: perl + ! djgpp/config.over djgpp/configure.bat djgpp/djgppsed.sh + ! t/lib/glob-basic.t t/lib/glob-case.t t/lib/glob-global.t + ! t/lib/glob-taint.t t/lib/io_unix.t +____________________________________________________________________________ +[ 5195] By: gsar on 2000/02/22 10:01:49 + Log: s/undef/NO_INIT/g in change#5183 + Branch: perl + ! lib/ExtUtils/xsubpp pod/perlxs.pod +____________________________________________________________________________ +[ 5194] By: gsar on 2000/02/22 09:44:07 + Log: perlipc bug (spotted by Ben Low) + Branch: perl + ! pod/perlipc.pod +____________________________________________________________________________ +[ 5193] By: gsar on 2000/02/22 09:38:58 + Log: EPOC port update (from Olaf Flebbe <O.Flebbe@science-computing.de>) + Branch: perl + ! README.epoc epoc/config.sh epoc/createpkg.pl perl.c +____________________________________________________________________________ +[ 5192] By: gsar on 2000/02/22 09:26:06 + Log: improvements for high-bit text literals (from Gisle Aas) + Branch: perl + ! t/pragma/warn/doop t/pragma/warn/pp t/pragma/warn/sv + ! t/pragma/warn/toke t/pragma/warn/utf8 toke.c +____________________________________________________________________________ +[ 5191] By: gsar on 2000/02/22 07:35:47 + Log: allow C<print v10>, $h{v13.10} etc. + Branch: perl + ! t/op/ver.t toke.c +____________________________________________________________________________ +[ 5190] By: gsar on 2000/02/22 05:35:27 + Log: adjust for lost fp precision in require version check + Branch: perl + ! pp_ctl.c t/comp/require.t +____________________________________________________________________________ +[ 5189] By: jhi on 2000/02/22 05:14:35 + Log: Check the alignment of long doubles if they are to be used; + regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH + Branch: metaconfig + ! U/compline/alignbytes.U +____________________________________________________________________________ +[ 5188] By: gsar on 2000/02/22 04:45:57 + Log: use same treatment for EINVAL as for ETIMEDOUT + Branch: perl + ! ext/IO/lib/IO/Socket/INET.pm +____________________________________________________________________________ +[ 5187] By: gsar on 2000/02/21 23:15:12 + Log: type mismatch + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 5186] By: gsar on 2000/02/21 21:10:26 + Log: remove dual-valueness of v-strings (i.e., they are pure strings + now); avoid the word "tuple" to describe strings represented as + character ordinals; usurp $PERL_VERSION for $^V as suggested by + Larry, deprecate $] ; adjust the documentation and testsuite + accordingly + Branch: perl + ! MANIFEST lib/English.pm op.c pod/perldelta.pod + ! pod/perlfunc.pod pod/perlop.pod pod/perlvar.pod + ! t/comp/require.t t/op/ver.t toke.c +____________________________________________________________________________ +[ 5185] By: jhi on 2000/02/21 20:36:05 + Log: detypo + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5184] By: gsar on 2000/02/21 18:37:38 + Log: clarify "use Module VERSION LIST" (from Robin Barker) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 5183] By: gsar on 2000/02/21 18:31:42 + Log: allow optional XSUB parameters without being forced to use a + default (from Hugo van der Sanden) + Branch: perl + ! lib/ExtUtils/xsubpp pod/perlfunc.pod pod/perlxs.pod +____________________________________________________________________________ +[ 5182] By: jhi on 2000/02/21 18:22:47 + Log: Add Solaris LP64 notes. + Branch: cfgperl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 5181] By: gsar on 2000/02/21 16:53:39 + Log: generalize "%v" format into a flag for any integral format type: + "%vd", "%v#o", "%*vX", etc are allowed + Branch: perl + ! perl.c pod/perldelta.pod pod/perlfunc.pod sv.c t/op/ver.t + ! utils/perlbug.PL +____________________________________________________________________________ +[ 5180] By: gsar on 2000/02/21 07:11:00 + Log: detypo + Branch: perl + ! ext/B/B.xs +____________________________________________________________________________ +[ 5179] By: gsar on 2000/02/21 07:08:38 + Log: undo accidental delete + Branch: perl + ! ext/B/B.pm ext/B/B.xs +____________________________________________________________________________ +[ 5178] By: gsar on 2000/02/21 07:02:16 + Log: get Compiler "working" under useithreads + Branch: perl + ! ext/B/B.pm ext/B/B.xs ext/B/B/C.pm ext/B/B/CC.pm + ! ext/B/B/Deparse.pm ext/B/B/Xref.pm +____________________________________________________________________________ +[ 5177] By: jhi on 2000/02/21 03:16:24 + Log: Thou shalt not printf longs with %d. + Branch: cfgperl + ! malloc.c +____________________________________________________________________________ +[ 5176] By: jhi on 2000/02/21 01:37:35 + Log: Integrate with Sarathy. + Branch: cfgperl + +> t/pragma/warn/9enabled + !> (integrate 63 files) +____________________________________________________________________________ +[ 5175] By: gsar on 2000/02/21 00:25:00 + Log: misplaced braces + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 5174] By: gsar on 2000/02/21 00:09:16 + Log: more malloc.c tweaks for change#5070 + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 5173] By: gsar on 2000/02/21 00:01:17 + Log: malloc.c fixups in change#5170 need to fetch thx pointer + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 5172] By: gsar on 2000/02/20 23:52:39 + Log: missing file in change#5170 + Branch: perl + + t/pragma/warn/9enabled +____________________________________________________________________________ +[ 5171] By: gsar on 2000/02/20 23:49:17 + Log: skip conditionally defined symbols in change#5162 + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5170] By: gsar on 2000/02/20 22:58:09 + Log: lexical warnings update, ability to inspect bitmask in calling + scope, among other things (from Paul Marquess) + Branch: perl + ! MANIFEST lib/warnings.pm malloc.c mg.c op.c pod/perldiag.pod + ! pod/perlfunc.pod pod/perllexwarn.pod pp.c pp_ctl.c pp_hot.c + ! regcomp.c regexec.c sv.c t/op/substr.t t/pragma/warn/op + ! t/pragma/warn/pp t/pragma/warn/pp_ctl t/pragma/warn/pp_hot + ! t/pragma/warn/regcomp t/pragma/warn/regexec t/pragma/warn/sv + ! t/pragma/warn/toke toke.c warnings.h warnings.pl +____________________________________________________________________________ +[ 5169] By: gsar on 2000/02/20 22:22:28 + Log: windows fixes for virtualizing child std{in,out,err} handles, + attempts to lock uninitialized critical section in files that + were never explicitly opened (from Doug Lankshear) + Branch: perl + ! iperlsys.h win32/perlhost.h win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 5168] By: gsar on 2000/02/20 20:19:11 + Log: update Changes, credits + Branch: perl + ! Changes +____________________________________________________________________________ +[ 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 + ! op.c +____________________________________________________________________________ +[ 5111] By: gsar on 2000/02/15 20:45:10 + Log: export list tweak needed by change#5103 + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5110] By: gsar on 2000/02/15 19:32:56 + Log: add XS version of Sys::Hostname (from Greg Bacon + <gbacon@itsc.uah.edu>) + Branch: perl + + ext/Sys/Hostname/Hostname.pm ext/Sys/Hostname/Hostname.xs + + ext/Sys/Hostname/Makefile.PL + - lib/Sys/Hostname.pm + ! MANIFEST ext/DynaLoader/Makefile.PL ext/Sys/Syslog/Makefile.PL + ! pod/perldelta.pod t/lib/hostname.t win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 5109] By: gsar on 2000/02/15 18:35:28 + Log: UNIVERSAL::can and UNIVERSAL::isa should return undef when + given undefined values (from Graham Barr <gbarr@pobox.com>) + Branch: perl + ! universal.c +____________________________________________________________________________ +[ 5108] By: gsar on 2000/02/15 18:25:05 + Log: avoid accidental #line directives (from Rick Delaney + <rick@consumercontact.com>) + Branch: perl + ! pod/perlsyn.pod toke.c +____________________________________________________________________________ +[ 5107] By: gsar on 2000/02/15 18:04:31 + Log: locale guards needed (from Simon Cozens <simon@brecon.co.uk>) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5106] By: gsar on 2000/02/15 18:02:17 + Log: incorrect docs about delete() (spotted by Martyn Pearce + <martyn@inpharmatica.co.uk>) + Branch: perl + ! pod/perldelta.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 5105] By: gsar on 2000/02/15 17:43:27 + Log: s/use vars/our/ (from Gisle Aas) + Branch: perl + ! bytecode.pl +____________________________________________________________________________ +[ 5104] By: gsar on 2000/02/15 17:42:06 + Log: optimize pseudohash slice in array slice at compile time (from + John Tobey <jtobey@john-edwin-tobey.org>) + Branch: perl + ! op.c t/lib/fields.t +____________________________________________________________________________ +[ 5103] By: gsar on 2000/02/15 17:18:12 + Log: provide malloc stats via get_mstats() (from Ilya Zakharevich) + Branch: perl + ! embed.h embed.pl global.sym makedef.pl malloc.c objXSUB.h + ! perl.h perlapi.c proto.h vos/vos_dummies.c +____________________________________________________________________________ +[ 5102] By: gsar on 2000/02/15 17:05:12 + Log: doc patches from Rick Delaney and Chris Nandor; update Todo-5.6 + Branch: perl + ! Todo-5.6 pod/perldata.pod pod/perlport.pod +____________________________________________________________________________ +[ 5101] By: gsar on 2000/02/15 17:02:51 + Log: fix regen_headers target to make all the autogenerated files + writable first + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 5100] By: gsar on 2000/02/15 16:41:53 + Log: fix misoptimization of C<my($x,$y); $x = $y = 1 + $z;> (from + Ilya Zakharevich) + Branch: perl + ! op.c t/op/lex_assign.t +____________________________________________________________________________ +[ 5099] By: gsar on 2000/02/15 16:17:36 + Log: more complete File::Spec support for Mac and VMS, tests (from + Barrie Slaymaker <barries@slaysys.com>) + Branch: perl + ! lib/File/Spec/Mac.pm lib/File/Spec/Unix.pm + ! lib/File/Spec/VMS.pm lib/File/Spec/Win32.pm t/lib/filespec.t +____________________________________________________________________________ +[ 5098] By: gsar on 2000/02/15 16:10:46 + Log: fix incompatibility with bison generated parser (from + Ignasi Roca <ignasi.roca@fujitsu.siemens.es>) + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 5097] By: gsar on 2000/02/15 16:07:17 + Log: propagate st_mode bits to group/other for Borland build + (from Vadim Konovalov <vkonovalov@lucent.com>) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 5096] By: jhi on 2000/02/15 14:22:23 + Log: Integrate with Sarathy. + Branch: cfgperl + !> win32/Makefile win32/bin/exetype.pl win32/makefile.mk +____________________________________________________________________________ +[ 5095] By: jhi on 2000/02/15 14:19:22 + Log: cc_r can be in different places (/usr/ibmcxx/bin or /usr/bin), + easier just to drop the paranoid test. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 5094] By: gsar on 2000/02/15 05:42:17 + Log: update exetype.pl tool + Branch: perl + ! win32/Makefile win32/bin/exetype.pl win32/makefile.mk +____________________________________________________________________________ +[ 5093] By: jhi on 2000/02/15 05:24:02 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Porting/pumpkin.pod embed.h embed.pl ext/DB_File/DB_File.xs + !> ext/GDBM_File/GDBM_File.xs ext/NDBM_File/NDBM_File.xs + !> ext/ODBM_File/ODBM_File.xs ext/SDBM_File/SDBM_File.xs hv.c + !> perl.c proto.h sv.c t/op/ord.t t/pragma/warnings.t +____________________________________________________________________________ +[ 5092] By: jhi on 2000/02/15 05:22:09 + Log: Unroll the libs scan thanks to HP-UX. + Branch: cfgperl + ! Configure config_h.SH hints/hpux.sh + Branch: metaconfig + ! U/modified/libpth.U U/modified/libs.U + Branch: metaconfig/U/perl + ! Extensions.U dlsrc.U +____________________________________________________________________________ +[ 5091] By: gsar on 2000/02/15 05:17:56 + Log: fix leaks in *DBM_File; safemalloc()ed things need to be freed with + safefree() rather than Safefree() + Branch: perl + ! ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs + ! ext/NDBM_File/NDBM_File.xs ext/ODBM_File/ODBM_File.xs + ! ext/SDBM_File/SDBM_File.xs +____________________________________________________________________________ +[ 5090] By: gsar on 2000/02/15 04:54:17 + Log: fix memory leak in C<$x = *Y> provoked by change#4198, which + introduced XPVMG storage in arenas + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 5089] By: jhi on 2000/02/15 00:41:36 + Log: AIX perl linkage tweakage. + Branch: cfgperl + ! Makefile.SH +____________________________________________________________________________ +[ 5088] By: jhi on 2000/02/15 00:07:06 + Log: abort instead of just promising. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 5087] By: jhi on 2000/02/14 23:51:05 + Log: silly compilers don't know that croak() exits + and complain about unitialized RETVALs + Branch: cfgperl + ! ext/Sys/Syslog/Syslog.xs +____________________________________________________________________________ +[ 5086] By: jhi on 2000/02/14 21:13:24 + Log: Add lseektype and lseeksize to myconfig. + Branch: cfgperl + ! myconfig.SH +____________________________________________________________________________ +[ 5085] By: gsar on 2000/02/14 18:51:11 + Log: avoid warnings + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5084] By: gsar on 2000/02/14 18:26:08 + Log: fix small interpreter leaks identified by Purify + Branch: perl + ! Porting/pumpkin.pod embed.h embed.pl hv.c perl.c proto.h sv.c + ! t/op/ord.t t/pragma/warnings.t +____________________________________________________________________________ +[ 5083] By: jhi on 2000/02/14 17:50:52 + Log: Remove tagged core files. + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 5082] By: jhi on 2000/02/14 17:41:07 + Log: Prefer full_ar. + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 5081] By: jhi on 2000/02/14 17:20:32 + Log: Add ivtype, ivsize, nvtype, nvsize to myconfig. + Branch: cfgperl + ! myconfig.SH +____________________________________________________________________________ +[ 5080] By: jhi on 2000/02/14 15:33:03 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Porting/pumpkin.pod av.c malloc.c sv.c +____________________________________________________________________________ +[ 5079] By: gsar on 2000/02/14 08:50:06 + Log: notes about running Purify + Branch: perl + ! Porting/pumpkin.pod av.c sv.c +____________________________________________________________________________ +[ 5078] By: gsar on 2000/02/14 07:27:21 + Log: use system malloc() instead of sbrk() in Perl_malloc() under -DPURIFY + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 5077] By: gsar on 2000/02/14 07:25:44 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH epoc/config.sh hints/aix.sh hints/hpux.sh + !> hints/irix_6.sh hints/solaris_2.sh perl.h pod/perldelta.pod + !> vms/subconfigure.com vos/config.def vos/config.h + !> vos/config_h.SH_orig win32/config.bc win32/config.gc + !> win32/config.vc win32/config_H.bc win32/config_H.gc + !> win32/config_H.vc +____________________________________________________________________________ +[ 5076] By: jhi on 2000/02/14 05:01:56 + Log: Integrate with Sarathy. + Branch: cfgperl + !> embed.h embed.pl objXSUB.h perl.c perlapi.c proto.h sv.c +____________________________________________________________________________ +[ 5075] By: jhi on 2000/02/14 04:56:52 + Log: Configure -A stopped processing of any further options. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Options.U +____________________________________________________________________________ +[ 5074] By: gsar on 2000/02/14 04:45:01 + Log: remove outdated -DPURIFY code--it reports bogus errors during global + destruction since we actually depend on SVs being in arenas there + Branch: perl + ! embed.h embed.pl objXSUB.h perl.c perlapi.c proto.h sv.c +____________________________________________________________________________ +[ 5073] By: jhi on 2000/02/13 19:28:17 + Log: Integrate with Sarathy. + Branch: cfgperl + - Todo-5.005 + !> cop.h op.c perl.c pp_ctl.c regcomp.c regexec.c scope.c sv.c + !> util.c +____________________________________________________________________________ +[ 5072] By: gsar on 2000/02/13 19:02:07 + Log: more purification (pp_require() could access free memory; vdie() + could think message was random length when passed a null argument; + utilize() didn't set up the hash for the method name leading to + pp_method_named() accessing random state; PL_curpm wasn't zeroed + properly) + Branch: perl + ! cop.h op.c perl.c pp_ctl.c regcomp.c regexec.c scope.c sv.c + ! util.c +____________________________________________________________________________ +[ 5071] By: jhi on 2000/02/12 19:59:35 + Log: uselonglong sits deep. + Branch: cfgperl + ! Configure config_h.SH hints/solaris_2.sh + Branch: metaconfig/U/perl + ! use64bits.U +____________________________________________________________________________ +[ 5070] By: jhi on 2000/02/12 01:25:41 + Log: megalomaniac 64-bit update: most importantly, + uselonglong is eradicated, only backward + compatibility hooks in use64bits remain. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH epoc/config.sh hints/aix.sh hints/hpux.sh + ! hints/irix_6.sh hints/solaris_2.sh perl.h vms/subconfigure.com + ! vos/config.def vos/config.h vos/config_h.SH_orig + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + Branch: metaconfig + ! U/a_dvisory/quadtype.U U/modified/libpth.U U/modified/libs.U + Branch: metaconfig/U/perl + ! use64bits.U +____________________________________________________________________________ +[ 5069] By: jhi on 2000/02/11 21:13:41 + Log: undo #5064 for now; there seems to be no good selection + of flags to add the new option. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5068] By: jhi on 2000/02/11 21:01:21 + Log: Guard against accidental long long use. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5067] By: jhi on 2000/02/11 19:50:32 + Log: logic fixes + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig/U/perl + ! uselonglong.U +____________________________________________________________________________ +[ 5066] By: jhi on 2000/02/11 19:32:30 + Log: Clarify 64-bit issues. + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 5065] By: jhi on 2000/02/11 18:13:29 + Log: Integrate with Sarathy. + Branch: cfgperl + !> ext/Devel/Peek/Peek.xs regcomp.c t/comp/require.t t/comp/use.t + !> toke.c +____________________________________________________________________________ +[ 5064] By: jhi on 2000/02/11 18:11:47 + Log: Silence linker warnings about binary backward incompatibilities. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5063] By: gsar on 2000/02/11 16:36:14 + Log: fix uninitialized memory reads found by purify + Branch: perl + ! ext/Devel/Peek/Peek.xs regcomp.c +____________________________________________________________________________ +[ 5062] By: jhi on 2000/02/11 00:11:39 + Log: de-fancify the largefiles hints + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5061] By: gsar on 2000/02/10 19:17:09 + Log: longstanding bug in parsing "require VERSION", could reallocate + current line and not know it; exposed by change#5004; manifested + as parse failure of C<{require 5.003}> + Branch: perl + ! t/comp/require.t t/comp/use.t toke.c +____________________________________________________________________________ +[ 5060] By: jhi on 2000/02/10 13:29:25 + Log: Integrate with Sarathy. + Branch: cfgperl + !> makedef.pl pp_ctl.c t/op/write.t win32/vdir.h +____________________________________________________________________________ +[ 5059] By: gsar on 2000/02/10 06:21:21 + Log: make global symbol exports AIX-specific + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5058] By: gsar on 2000/02/10 06:16:57 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Makefile.SH Porting/Glossary Porting/config.sh + !> Porting/config_H config_h.SH makedef.pl perl.h + !> vms/subconfigure.com vos/config.def win32/config.bc + !> win32/config.gc win32/config.vc win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc win32/config_h.PL + !> win32/config_sh.PL +____________________________________________________________________________ +[ 5057] By: gsar on 2000/02/10 01:08:01 + Log: windows bugfixes for virtual directories under USE_ITHREADS: + allows path mapping to unknown devices to work properly; + special file names like CONOUT$ can be opened with sysopen() + again + Branch: perl + ! win32/vdir.h +____________________________________________________________________________ +[ 5056] By: gsar on 2000/02/10 00:56:27 + Log: formline() could wipe out readonly-ness, freeing constants + prematurely, or affect cloning of pad constants + Branch: perl + ! pp_ctl.c t/op/write.t +____________________________________________________________________________ +[ 5055] By: jhi on 2000/02/09 19:48:58 + Log: Regenerate Configure for I_SYSLOG. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 5054] By: jhi on 2000/02/09 19:38:04 + Log: fix AIX and multiplicity problems + Branch: cfgperl + ! Makefile.SH makedef.pl +____________________________________________________________________________ +[ 5053] By: bailey on 2000/02/09 10:58:11 + Log: remove redundant archcore directory prefix in installperl + Branch: vmsperl + ! installperl +____________________________________________________________________________ +[ 5052] By: bailey on 2000/02/09 10:44:22 + Log: Work around prefixing bug in older DECC preprocessors + Branch: vmsperl + ! vms/vms.c vms/vmsish.h +____________________________________________________________________________ +[ 5051] By: bailey on 2000/02/09 09:52:06 + Log: Eliminate unnecessary (and sometimes confounding) test for + word boundary + Branch: vmsperl + ! lib/ExtUtils/MM_VMS.pm +____________________________________________________________________________ +[ 5050] By: bailey on 2000/02/09 09:29:06 + Log: Minor fixes to assuage picky compilers (unsigned comparisons and + alias rules lead to compilation warnings) + Branch: vmsperl + ! av.c mg.h pp_sys.c scope.c sv.c vms/vms.c +____________________________________________________________________________ +[ 5049] By: bailey on 2000/02/09 09:09:45 + Log: Resync with mainline + Branch: vmsperl + +> Todo-5.6 ext/Sys/Syslog/Makefile.PL ext/Sys/Syslog/Syslog.pm + +> ext/Sys/Syslog/Syslog.xs lib/Pod/Find.pm lib/Pod/ParseUtils.pm + +> pod/perlapi.pod pod/perlintern.pod pod/perlunicode.pod + +> t/op/exists_sub.t t/op/ver.t t/pragma/diagnostics.t + +> vos/config.def vos/config.pl win32/bin/exetype.pl + - Todo-5.005 lib/Sys/Syslog.pm lib/caller.pm + ! vms/subconfigure.com + !> (integrate 358 files) +____________________________________________________________________________ +[ 5048] By: jhi on 2000/02/09 03:54:05 + Log: OS/2 gcc doesn't like -o foo.exe and -Zexe simultaneously + (reported by Yitzchak Scott-Thoennes in p5p) + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Cppsym.U +____________________________________________________________________________ +[ 5047] By: jhi on 2000/02/09 02:56:43 + Log: (fake) use of getcwd. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h +____________________________________________________________________________ +[ 5046] By: jhi on 2000/02/09 02:22:50 + Log: lib scan fix + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/libs.U +____________________________________________________________________________ +[ 5045] By: jhi on 2000/02/09 02:17:34 + Log: Reintroduce #5019 via metaconfig. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/installdirs/inc_version_list.U +____________________________________________________________________________ +[ 5044] By: jhi on 2000/02/09 02:07:08 + Log: Add/restore probes for getcwd/mk*temp*/mmap. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h vms/subconfigure.com vos/config.def + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/config_sh.PL + Branch: metaconfig + ! U/modified/d_mkstemp.U U/modified/libs.U + Branch: metaconfig/U/perl + + d_mkdtemp.U d_mkstemps.U +____________________________________________________________________________ +[ 5043] By: jhi on 2000/02/08 20:58:02 + Log: Integrate with Sarathy. + Branch: cfgperl + +> Todo-5.6 t/op/ver.t win32/bin/exetype.pl + !> (integrate 110 files) +____________________________________________________________________________ +[ 5042] By: gsar on 2000/02/08 20:32:12 + Log: avoid exiting just because we didn't scan for libm ('libs' may still + have it, but we avoided scan for things in 'libs') + Branch: perl + ! Configure + +---------------- +Version v5.5.650 +---------------- + +____________________________________________________________________________ +[ 5041] By: gsar on 2000/02/08 07:57:11 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ [ 5040] By: gsar on 2000/02/08 07:51:20 Log: documentation patches (from Michael Schwern and Yitzchak Scott-Thoennes) @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Fri Feb 4 21:57:24 EET 2000 [metaconfig 3.0 PL70] +# Generated on Sat Feb 26 05:10:12 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -354,6 +354,7 @@ d_fgetpos='' d_flexfnam='' d_flock='' d_fork='' +d_fpos64_t='' d_fs_data_s='' d_fseeko='' d_fsetpos='' @@ -362,6 +363,8 @@ d_ftello='' d_ftime='' d_gettimeod='' d_Gconvert='' +d_getcwd='' +d_getfsstat='' d_getgrent='' d_getgrps='' d_gethbyaddr='' @@ -401,7 +404,7 @@ d_hasmntopt='' d_htonl='' d_iconv='' d_inetaton='' -d_int64t='' +d_int64_t='' d_isascii='' d_killpg='' d_lchown='' @@ -413,6 +416,7 @@ d_longdbl='' longdblsize='' d_longlong='' longlongsize='' +d_lseekproto='' d_lstat='' d_mblen='' d_mbstowcs='' @@ -423,14 +427,23 @@ d_memcpy='' d_memmove='' d_memset='' d_mkdir='' +d_mkdtemp='' d_mkfifo='' +d_mkstemp='' +d_mkstemps='' d_mktime='' +d_mmap='' +mmaptype='' +d_mprotect='' d_msg='' d_msgctl='' d_msgget='' d_msgrcv='' d_msgsnd='' +d_msync='' +d_munmap='' d_nice='' +d_off64_t='' d_open3='' d_fpathconf='' d_pathconf='' @@ -505,6 +518,7 @@ d_socket='' d_sockpair='' sockethdr='' socketlib='' +d_socklen_t='' d_sqrtl='' d_statblks='' d_statfs_f_flags='' @@ -642,6 +656,9 @@ i_bsdioctl='' i_sysfilio='' i_sysioctl='' i_syssockio='' +i_syslog='' +i_sysmman='' +i_sysmode='' i_sysmount='' i_sysndir='' i_sysparam='' @@ -655,6 +672,7 @@ i_systimes='' i_systypes='' i_sysuio='' i_sysun='' +i_sysutsname='' i_sysvfs='' i_syswait='' i_sgtty='' @@ -681,8 +699,6 @@ installusrbinperl='' intsize='' longsize='' shortsize='' -d_fpos64_t='' -d_off64_t='' libc='' ldlibpthname='' libperl='' @@ -698,6 +714,7 @@ libs='' libsdirs='' libsfiles='' libsfound='' +libspath='' lns='' d_PRIEldbl='' d_PRIFldbl='' @@ -762,8 +779,10 @@ api_subversion='' api_version='' api_versionstring='' patchlevel='' +revision='' subversion='' version='' +perl5='' perladmin='' perlpath='' d_nv_preserves_uv='' @@ -846,6 +865,7 @@ siteprefix='' siteprefixexp='' sizetype='' so='' +socksizetype='' sharpbang='' shsharp='' spitshell='' @@ -863,10 +883,10 @@ uidsign='' uidsize='' uidtype='' archname64='' -use64bits='' +use64bitall='' +use64bitint='' uselargefiles='' uselongdouble='' -uselonglong='' usemorebits='' usemultiplicity='' nm_opt='' @@ -895,6 +915,8 @@ vendorprefix='' vendorprefixexp='' defvoidused='' voidflags='' +pm_apiversion='' +xs_apiversion='' CONFIG='' define='define' @@ -931,16 +953,16 @@ inclwanted='' groupstype='' : change the next line if compiling for Xenix/286 on Xenix/386 xlibpth='/usr/lib/386 /lib/386' - : Possible local library directories to search. loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" : general looking path for locating libraries -glibpth="/shlib /usr/shlib /lib/pa1.1 /usr/lib/large" -glibpth="$glibpth /lib /usr/lib $xlibpth" +glibpth="/usr/lib/large /lib /usr/lib $xlibpth" glibpth="$glibpth /lib/large /usr/lib/small /lib/small" glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib" +test -f /usr/shlib/libc.so && glibpth="/usr/shlib $glibpth" +test -f /shlib/libc.so && glibpth="/shlib $glibpth" : Private path used by Configure to find libraries. Its value : is prepended to libpth. This variable takes care of special @@ -1253,6 +1275,7 @@ while test $# -gt 0; do echo "$yyy=$zzz" >> posthint.sh ;; *) echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;; esac + shift ;; -V) echo "$me generated by metaconfig 3.0 PL70." >&2 exit 0;; @@ -1862,7 +1885,6 @@ ln more nm nroff -perl pg test uname @@ -2388,12 +2410,12 @@ EOM : specified already. case "$hintfile" in ''|' ') - file=`echo "${osname}_${osvers}" | $sed -e 's@\.@_@g' -e 's@_$@@'` + file=`echo "${osname}_${osvers}" | $sed -e 's%\.%_%g' -e 's%_$%%'` : Also try without trailing minor version numbers. - xfile=`echo $file | $sed -e 's@_[^_]*$@@'` - xxfile=`echo $xfile | $sed -e 's@_[^_]*$@@'` - xxxfile=`echo $xxfile | $sed -e 's@_[^_]*$@@'` - xxxxfile=`echo $xxxfile | $sed -e 's@_[^_]*$@@'` + xfile=`echo $file | $sed -e 's%_[^_]*$%%'` + xxfile=`echo $xfile | $sed -e 's%_[^_]*$%%'` + xxxfile=`echo $xxfile | $sed -e 's%_[^_]*$%%'` + xxxxfile=`echo $xxxfile | $sed -e 's%_[^_]*$%%'` case "$file" in '') dflt=none ;; *) case "$osvers" in @@ -2596,21 +2618,23 @@ $undef$define) . ./whoa; eval "$var=\$tu";; *) eval "$var=$val";; esac' +case "$usethreads" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; +esac cat <<EOM Perl can be built to take advantage of threads on some systems. -To do so, Configure must be run with -Dusethreads. +To do so, Configure can be run with -Dusethreads. Note that threading is a highly experimental feature, and some known race conditions still remain. If you choose to try it, be very sure to not actually deploy it for production purposes. README.threads has more details, and is required reading if you enable threads. + +If this doesn't make any sense to you, just accept the default '$dflt'. EOM -case "$usethreads" in -$define|true|[yY]*) dflt='y';; -*) dflt='n';; -esac rp='Build a threading Perl?' . ./myread case "$ans" in @@ -2704,12 +2728,12 @@ This multiple interpreter support is required for interpreter-based threads. EOM val="$define" ;; -*) - echo 'Normally you do not need this and you should answer no.' - case "$usemultiplicity" in +*) case "$usemultiplicity" in $define|true|[yY]*) dflt='y';; *) dflt='n';; esac + echo " " + echo "If this doesn't make any sense to you, just accept the default '$dflt'." rp='Build Perl for multiplicity?' . ./myread case "$ans" in @@ -3043,7 +3067,7 @@ int main() { exit(0); } EOM -if $cc -o gccvers gccvers.c; then +if $cc $ldflags -o gccvers gccvers.c; then gccversion=`./gccvers` case "$gccversion" in '') echo "You are not using GNU cc." ;; @@ -3647,18 +3671,17 @@ case "$firstmakefile" in '') firstmakefile='makefile';; esac +case "$usesocks" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; +esac cat <<EOM Perl can be built to use the SOCKS proxy protocol library. To do so, Configure must be run with -Dusesocks. -Normally you do not need this and you should answer no. - +If this doesn't make any sense to you, just accept the default '$dflt'. EOM -case "$usesocks" in -$define|true|[yY]*) dflt='y';; -*) dflt='n';; -esac rp='Build Perl for SOCKS?' . ./myread case "$ans" in @@ -3683,48 +3706,70 @@ $define) libswanted="$libswanted socks5 socks5_sh" ;; esac +libsfound='' +libsfiles='' +libsdirs='' +libspath='' +for thisdir in $libpth $xlibpth; do + test -d $thisdir && libspath="$libspath $thisdir" +done for thislib in $libswanted; do - - libname="$thislib" - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; - $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then - libstyle=shared - elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then - libstyle=shared - elif xxx=`./loc lib$thislib$_a X $libpth`; $test -f "$xxx"; then - libstyle=static - elif xxx=`./loc $thislib$_a X $libpth`; $test -f "$xxx"; then - libstyle=static - elif xxx=`./loc lib${thislib}_s$_a X $libpth`; $test -f "$xxx"; then - libstyle=static - libname=${thislib}_s - elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then - libstyle="static" - fi - if $test -f "$xxx"; then - eval $libscheck - fi - if $test -f "$xxx"; then + for thisdir in $libspath; do + xxx='' + if $test ! -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then + xxx=`ls $thisdir/lib$thislib.$so.[0-9] 2>/dev/null|tail -1` + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=shared + fi + if test ! -f "$xxx"; then + xxx=$thisdir/lib$thislib.$so + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=shared + fi + if test ! -f "$xxx"; then + xxx=$thisdir/lib$thislib$_a + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=static + fi + if test ! -f "$xxx"; then + xxx=$thisdir/$thislib$_a + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=static + fi + if test ! -f "$xxx"; then + xxx=$thisdir/lib${thislib}_s$_a + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=static + fi + if test ! -f "$xxx"; then + xxx=$thisdir/Slib$thislib$_a + $test -f "$xxx" && eval $libscheck + $test -f "$xxx" && libstyle=static + fi + if $test -f "$xxx"; then case "$libstyle" in - shared) echo "Found -l$libname (shared)." ;; - static) echo "Found -l$libname." ;; - *) echo "Found -l$libname ($libstyle)." ;; + shared) echo "Found -l$thislib (shared)." ;; + static) echo "Found -l$thislib." ;; + *) echo "Found -l$thislib ($libstyle)." ;; esac case " $dflt " in *"-l$thislib "*);; - *) dflt="$dflt -l$libname" + *) dflt="$dflt -l$thislib" libsfound="$libsfound $xxx" yyy=`basename $xxx` libsfiles="$libsfiles $yyy" - yyy=`echo $xxx|sed "s@/$yyy\\$@@"` + yyy=`echo $xxx|$sed -e "s%/$yyy\\$%%"` case " $libsdirs " in *" $yyy "*) ;; *) libsdirs="$libsdirs $yyy" ;; esac ;; esac - else - echo "No -l$thislib." + break + fi + done + if $test ! -f "$xxx"; then + echo "No -l$thislib." fi done set X $dflt @@ -4182,7 +4227,7 @@ set off_t lseektype long stdio.h sys/types.h eval $typedef_ask echo " " -$echo $n "Checking to see how big your file offsets are...$c" >&4 +echo "Checking to see how big your file offsets are..." >&4 $cat >try.c <<EOCP #include <sys/types.h> #include <stdio.h> @@ -4195,7 +4240,7 @@ EOCP set try if eval $compile_ok; then lseeksize=`./try` - $echo " $lseeksize bytes." >&4 + echo "Your file offsets are $lseeksize bytes long." else dflt=$longsize echo " " @@ -4216,7 +4261,7 @@ case "$fpostype" in *_t) zzz="$fpostype" ;; *) zzz="fpos_t" ;; esac -$echo $n "Checking the size of $zzz...$c" >&4 +echo "Checking the size of $zzz..." >&4 cat > try.c <<EOCP #include <sys/types.h> #include <stdio.h> @@ -4230,16 +4275,15 @@ if eval $compile_ok; then yyy=`./try` case "$yyy" in '') fpossize=4 - echo " " echo "(I can't execute the test program--guessing $fpossize.)" >&4 ;; *) fpossize=$yyy - echo " $fpossize bytes." + echo "Your $zzz is $fpossize bytes long." ;; esac else dflt="$longsize" - echo " " + echo " " >&4 echo "(I can't compile the test program. Guessing...)" >&4 rp="What is the size of your file positions (in bytes)?" . ./myread @@ -4248,23 +4292,35 @@ fi +# Backward compatibility (uselfs is deprecated). +case "$uselfs" in +"$define"|true|[yY]*) + cat <<EOM >&4 + +*** Configure -Duselfs is deprecated, using -Duselargefiles instead. + +EOM + uselargefiles="$define" + ;; +esac + case "$lseeksize:$fpossize" in 8:8) cat <<EOM You can have files larger than 2 gigabytes. EOM val="$define" ;; -*) cat <<EOM +*) case "$uselargefiles" in + "$undef"|false|[nN]*) dflt='n' ;; + *) dflt='y' ;; + esac + cat <<EOM Perl can be built to understand large files (files larger than 2 gigabytes) -on some systems. To do so, Configure must be run with -Duselargefiles. +on some systems. To do so, Configure can be run with -Duselargefiles. -If this doesn't make any sense to you, just accept the default 'y'. +If this doesn't make any sense to you, just accept the default '$dflt'. EOM - case "$uselargefiles" in - "$undef"|false|[nN]*) dflt='n' ;; - *) dflt='y' ;; - esac rp='Try to understand large files, if available?' . ./myread case "$ans" in @@ -4284,7 +4340,7 @@ case "$uselargefiles" in echo "Your platform has some specific hints for large file builds, using them..." . ./uselfs.cbu echo " " - $echo $n "Rechecking to see how big your file offsets are...$c" >&4 + echo "Rechecking to see how big your file offsets are..." >&4 $cat >try.c <<EOCP #include <sys/types.h> #include <stdio.h> @@ -4297,7 +4353,7 @@ EOCP set try if eval $compile_ok; then lseeksize=`./try` - $echo " $lseeksize bytes." >&4 + $echo "Your file offsets are now $lseeksize bytes long." else dflt="$lseeksize" echo " " @@ -4328,7 +4384,7 @@ EOCP echo "(I can't execute the test program--guessing $fpossize.)" >&4 ;; *) fpossize=$yyy - echo " $fpossize bytes." + echo " $fpossize bytes." >&4 ;; esac else @@ -4347,7 +4403,7 @@ esac case "$usemorebits" in "$define"|true|[yY]*) - use64bits="$define" + use64bitint="$define" uselongdouble="$define" usemorebits="$define" ;; @@ -4356,70 +4412,152 @@ case "$usemorebits" in esac -case "$intsize:$longsize" in -8:*|*:8) cat <<EOM +# Backward compatibility (uselonglong is deprecated). +case "$uselonglong" in +"$define"|true|[yY]*) + cat <<EOM >&4 + +*** Configure -Duselonglong is deprecated, using -Duse64bitint instead. -You have natively 64-bit integers. EOM - val="$define" ;; -*) cat <<EOM + use64bitint="$define" + ;; +esac +# Backward compatibility (use64bits is deprecated). +case "$use64bits" in +"$define"|true|[yY]*) + cat <<EOM >&4 + +*** Configure -Duse64bits is deprecated, using -Duse64bitint instead. + +EOM + use64bitint="$define" + ;; +esac +# Thinko compatibility +case "$use64bitints" in +"$define"|true|[yY]*) + cat <<EOM >&4 + +*** There is no Configure -Duse64bitints, using -Duse64bitint instead. + +EOM + use64bitint="$define" + ;; +esac + +case "$ccflags" in +*-DUSE_LONG_LONG*|*-DUSE_64_BIT_INT*|*-DUSE_64_BIT_ALL*) use64bitint="$define";; +esac +case "$use64bitall" in +"$define"|true|[yY]*) use64bitint="$define" ;; +esac + +case "$longsize" in +8) cat <<EOM + +You have natively 64-bit long integers. +EOM + val="$define" + ;; +*) case "$use64bitint" in + "$define"|true|[yY]*) dflt='y';; + *) dflt='n';; + esac + cat <<EOM Perl can be built to take advantage of 64-bit integer types -on some systems. To do so, Configure must be run with -Duse64bits. - -If this doesn't make any sense to you, just accept the default. -EOM - case "$use64bits" in - $define|true|[yY]*) dflt='y';; - *) dflt='n';; - esac - rp='Try to use 64-bit integers, if available?' - . ./myread - case "$ans" in - y|Y) val="$define" ;; - *) val="$undef" ;; - esac - ;; -esac -set use64bits -eval $setvar +on some systems. To do so, Configure can be run with -Duse64bitint. +Choosing this option will most probably introduce binary incompatibilities. -case "$archname64" in -'') archname64='' ;; # not a typo +If this doesn't make any sense to you, just accept the default '$dflt'. +EOM + rp='Try to use 64-bit integers, if available?' + . ./myread + case "$ans" in + [yY]*) val="$define" ;; + *) val="$undef" ;; + esac + ;; esac +set use64bitint +eval $setvar -case "$use64bits" in +case "$use64bitall" in +"$define"|true|[yY]*) val="$define" ;; +*) case "$use64bitint" in + "$define") case "$longsize" in + 4) dflt='n' + cat <<EOM + +Since you chose 64-bitness you may want to try maximal 64-bitness. +What you have chosen is minimal 64-bitness which means just enough +to get 64-bit integers. The maximal means using as much 64-bitness +as is possible on the platform. This in turn means even more binary +incompatibilities. On the other hand, your platform may not have +any more maximal 64-bitness than what you already have chosen. + +If this doesn't make any sense to you, just accept the default '$dflt'. +EOM + rp='Try to use full 64-bit support, if available?' + . ./myread + case "$ans" in + [yY]*) val="$define" ;; + *) val="$undef" ;; + esac + ;; + 8) val="$define" ;; + *) val="$undef" ;; + esac + ;; + *) val="$undef" ;; + esac + ;; +esac +set use64bitall +eval $setvar + +case "$use64bitint" in "$define"|true|[yY]*) : Look for a hint-file generated 'call-back-unit'. If the : user has specified that a 64-bit perl is to be built, : we may need to set or change some other defaults. - if $test -f use64bits.cbu; then + if $test -f use64bitint.cbu; then echo "Your platform has some specific hints for 64-bit builds, using them..." - . ./use64bits.cbu - else - $cat <<EOM -(Your platform doesn't have any specific hints for 64-bit builds.) -EOM - case "$intsize:$longsize" in -8:*|*:8) cat <<EOM -(This is probably okay, as your system is a natively 64-bit system.) -EOM - ;; - esac - case "$gccversion" in - '') ;; - *) case "$ccflags" in - *-DUSE_LONG_LONG*) ;; - *) $cat <<EOM -But since you seem to be using gcc, I will now add -DUSE_LONG_LONG -to the compilation flags. -EOM - ccflags="$ccflags -DUSE_LONG_LONG" - ;; - esac - ;; - esac + . ./use64bitint.cbu + fi + case "$longsize" in + 4) case "$ccflags" in + *-DUSE_64_BIT_INT*) ;; + *) ccflags="$ccflags -DUSE_64_BIT_INT";; + esac + case "$archname64" in + '') archname64=64int ;; + esac + ;; + esac + ;; +esac + +case "$use64bitall" in +"$define"|true|[yY]*) +: Look for a hint-file generated 'call-back-unit'. If the +: user has specified that a full 64-bit perl is to be built, +: we may need to set or change some other defaults. + if $test -f use64bitall.cbu; then + echo "Your platform has some specific hints for full 64-bit builds, using them..." + . ./use64bitall.cbu fi + case "$longsize" in + 4) case "$ccflags" in + *-DUSE_64_BIT_ALL*) ;; + *) ccflags="$ccflags -DUSE_64_BIT_ALL";; + esac + case "$archname64" in + ''|64) archname64=64all ;; + esac + ;; + esac ;; esac @@ -4477,7 +4615,7 @@ $define) esac ;; esac -case "$use64bits" in +case "$use64bitint" in $define) case "$archname64" in '') @@ -4607,44 +4745,39 @@ prefixit='case "$3" in esac;; esac' -: set the base revision -baserev=5.0 - : get the patchlevel echo " " echo "Getting the current patchlevel..." >&4 if $test -r $rsrc/patchlevel.h;then + revision=`awk '/define[ ]+PERL_REVISION/ {print $3}' $rsrc/patchlevel.h` patchlevel=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h` subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $rsrc/patchlevel.h` api_revision=`awk '/define[ ]+PERL_API_REVISION/ {print $3}' $rsrc/patchlevel.h` api_version=`awk '/define[ ]+PERL_API_VERSION/ {print $3}' $rsrc/patchlevel.h` api_subversion=`awk '/define[ ]+PERL_API_SUBVERSION/ {print $3}' $rsrc/patchlevel.h` else + revision=0 patchlevel=0 subversion=0 api_revision=0 api_version=0 api_subversion=0 fi -$echo $n "(You have $package" $c -case "$package" in -"*$baserev") ;; -*) $echo $n " $baserev" $c ;; -esac +$echo $n "(You have $package revision $revision" $c $echo $n " patchlevel $patchlevel" $c test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c echo ".)" case "$osname" in dos|vms) : XXX Should be a Configure test for double-dots in filenames. - version=`echo $baserev $patchlevel $subversion | \ + version=`echo $revision $patchlevel $subversion | \ $awk '{ printf "%d_%d_%d\n", $1, $2, $3 }'` api_versionstring=`echo $api_revision $api_version $api_subversion | \ $awk '{ printf "%d_%d_%d\n", $1, $2, $3 }'` ;; *) - version=`echo $baserev $patchlevel $subversion | \ + version=`echo $revision $patchlevel $subversion | \ $awk '{ printf "%d.%d.%d\n", $1, $2, $3 }'` api_versionstring=`echo $api_revision $api_version $api_subversion | \ $awk '{ printf "%d.%d.%d\n", $1, $2, $3 }'` @@ -5099,7 +5232,12 @@ EOM rp='Do you want to configure vendor-specific add-on directories?' case "$usevendorprefix" in define|true|[yY]*) dflt=y ;; -*) dflt=n ;; +*) : User may have set vendorprefix directly on Configure command line. + case "$vendorprefix" in + ''|' ') dflt=n ;; + *) dflt=y ;; + esac + ;; esac . ./myread case "$ans" in @@ -5110,6 +5248,7 @@ case "$ans" in *) dflt=$vendorprefix ;; esac . ./getfile + : XXX Prefixit unit does not yet support siteprefix and vendorprefix oldvendorprefix='' case "$vendorprefix" in '') ;; @@ -5137,24 +5276,30 @@ case "$vendorprefix" in *) d_vendorlib="$define" : determine where vendor-supplied modules go. : Usual default is /usr/local/lib/perl5/vendor_perl/$version - prog=`echo $package | $sed 's/-*[0-9.]*$//'` - case "$installstyle" in - *lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog/$version ;; - *) dflt=$vendorprefix/lib/vendor_$prog/$version ;; + case "$vendorlib" in + '') + prog=`echo $package | $sed 's/-*[0-9.]*$//'` + case "$installstyle" in + *lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog/$version ;; + *) dflt=$vendorprefix/lib/vendor_$prog/$version ;; + esac + ;; + *) dflt="$vendorlib" + ;; esac fn=d~+ rp='Pathname for the vendor-supplied library files?' . ./getfile vendorlib="$ans" vendorlibexp="$ansexp" - : Change installation prefix, if necessary. - if $test X"$prefix" != X"$installprefix"; then - installvendorlib=`echo $vendorlibexp | $sed "s#^$prefix#$installprefix#"` - else - installvendorlib="$vendorlibexp" - fi ;; esac +: Change installation prefix, if necessary. +if $test X"$prefix" != X"$installprefix"; then + installvendorlib=`echo $vendorlibexp | $sed "s#^$prefix#$installprefix#"` +else + installvendorlib="$vendorlibexp" +fi : Cruising for prototypes echo " " @@ -5217,6 +5362,28 @@ else installbin="$binexp" fi +: Find perl5.005 or later. +echo "Looking for a previously installed perl5.005 or later... " +case "$perl5" in +'') for tdir in `echo "$binexp:$PATH" | $sed "s/$path_sep/ /g"`; do + : Check if this perl is recent and can load a simple module + if $test -x $tdir/perl && $tdir/perl -Mless -e 'use 5.005;' >/dev/null 2>&1; then + perl5=$tdir/perl + break; + elif $test -x $tdir/perl5 && $tdir/perl5 -Mless -e 'use 5.005;' >/dev/null 2>&1; then + perl5=$tdir/perl + break; + fi + done + ;; +*) perl5="$perl5" + ;; +esac +case "$perl5" in +'') echo "None found. That's ok.";; +*) echo "Using $perl5." ;; +esac + $cat <<EOM After $package is installed, you may wish to install various @@ -5240,11 +5407,11 @@ case "$siteprefix" in *) dflt=$siteprefix ;; esac . ./getfile +: XXX Prefixit unit does not yet support siteprefix and vendorprefix oldsiteprefix='' case "$siteprefix" in '') ;; -*) - case "$ans" in +*) case "$ans" in "$prefix") ;; *) oldsiteprefix="$prefix";; esac @@ -5258,9 +5425,14 @@ siteprefixexp="$ansexp" : The default "style" setting is made in installstyle.U : XXX No longer works with Prefixit stuff. prog=`echo $package | $sed 's/-*[0-9.]*$//'` -case "$installstyle" in -*lib/perl5*) dflt=$siteprefix/lib/$package/site_$prog/$version ;; -*) dflt=$siteprefix/lib/site_$prog/$version ;; +case "$sitelib" in +'') case "$installstyle" in + *lib/perl5*) dflt=$siteprefix/lib/$package/site_$prog/$version ;; + *) dflt=$siteprefix/lib/site_$prog/$version ;; + esac + ;; +*) dflt="$sitelib" + ;; esac $cat <<EOM @@ -5277,14 +5449,14 @@ sitelib="$ans" sitelibexp="$ansexp" : Change installation prefix, if necessary. if $test X"$prefix" != X"$installprefix"; then - installsitelib=`echo $sitelibexp | sed "s#^$prefix#$installprefix#"` + installsitelib=`echo $sitelibexp | $sed "s#^$prefix#$installprefix#"` else installsitelib="$sitelibexp" fi : Determine list of previous versions to include in @INC $cat > getverlist <<EOPL -#!$perl -w +#!$perl5 -w use File::Basename; \$api_versionstring = "$api_versionstring"; \$version = "$version"; @@ -5295,7 +5467,7 @@ EOPL # Can't have leading @ because metaconfig interprets it as a command! ;@inc_version_list=(); $stem=dirname($sitelib); -# Redo to do opendir/readdir? +# XXX Redo to do opendir/readdir? if (-d $stem) { chdir($stem); ;@candidates = glob("5.*"); @@ -5335,8 +5507,8 @@ else { EOPL chmod +x getverlist case "$inc_version_list" in -'') if test -x $perl; then - dflt=`$perl getverlist` +'') if test -x "$perl5"; then + dflt=`$perl5 getverlist` else dflt='none' fi @@ -5344,6 +5516,9 @@ case "$inc_version_list" in $undef) dflt='none' ;; *) dflt="$inc_version_list" ;; esac +case "$dflt" in +''|' ') dflt=none ;; +esac $cat <<'EOM' In order to ease the process of upgrading, this version of perl @@ -5361,7 +5536,7 @@ EOM rp='List of earlier versions to include in @INC?' . ./myread case "$ans" in -[Nn]one) inc_version_list=' ' ;; +[Nn]one|''|' ') inc_version_list=' ' ;; *) inc_version_list="$ans" ;; esac case "$inc_version_list" in @@ -5920,7 +6095,7 @@ y*) usedl="$define" . ./getfile usedl="$define" : emulate basename - dlsrc=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@'` + dlsrc=`echo $ans | $sed -e 's%.*/\([^/]*\)$%\1%'` $cat << EOM @@ -6008,7 +6183,7 @@ EOM case "$lddlflags" in '') case "$osname" in beos) dflt='-nostart' ;; - hpux) dflt='-b' ;; + hpux) dflt='-b +vnocompatwarnings' ;; linux|irix*) dflt='-shared' ;; next) dflt='none' ;; solaris) dflt='-G' ;; @@ -6927,21 +7102,22 @@ fi : sitelib default is /usr/local/lib/perl5/site_perl/$version : sitearch default is /usr/local/lib/perl5/site_perl/$version/$archname : sitelib may have an optional trailing /share. -tdflt=`echo $sitelib | $sed 's,/share$,,'` -tdflt="$tdflt/$archname" -set sitearch sitearch none -eval $prefixit case "$sitearch" in -'') dflt="$tdflt" ;; -*) dflt="$sitearch" ;; +'') dflt=`echo $sitelib | $sed 's,/share$,,'` + dflt="$dflt/$archname" + ;; +*) dflt="$sitearch" + ;; esac +set sitearch sitearch none +eval $prefixit $cat <<EOM The installation process will also create a directory for architecture-dependent site-specific extensions and modules. EOM -fn=nd~+ +fn=d~+ rp='Pathname for the site-specific architecture-dependent library files?' . ./getfile sitearch="$ans" @@ -6956,7 +7132,7 @@ fi : determine where add-on public executables go case "$sitebin" in '') dflt=$siteprefix/bin ;; -*) dflt=$sitebin ;; +*) dflt=$sitebin ;; esac fn=d~ rp='Pathname where the add-on public executables should be installed?' @@ -6974,14 +7150,6 @@ fi set sqrtl d_sqrtl eval $inlibc -cat <<EOM - -Perl can be built to take advantage of long doubles which -(if available) may give more accuracy and range for floating point numbers. - -If this doesn't make any sense to you, just accept the default 'n'. -EOM - case "$ccflags" in *-DUSE_LONG_DOUBLE*|*-DUSE_MORE_BITS*) uselongdouble="$define" ;; esac @@ -6990,6 +7158,13 @@ case "$uselongdouble" in $define|true|[yY]*) dflt='y';; *) dflt='n';; esac +cat <<EOM + +Perl can be built to take advantage of long doubles which +(if available) may give more accuracy and range for floating point numbers. + +If this doesn't make any sense to you, just accept the default '$dflt'. +EOM rp='Try to use long doubles if available?' . ./myread case "$ans" in @@ -7031,50 +7206,10 @@ EOM ;; esac -cat <<EOM - -Perl can be built to take advantage of long longs which -(if available) may give more range for integer numbers. - -If this doesn't make any sense to you, just accept the default 'n'. -EOM - -case "$ccflags" in -*-DUSE_LONG_LONG*) uselonglong="$define" ;; -esac - -case "$uselonglong" in -'') dflt='y';; -esac -rp='Try to use long longs if available?' -. ./myread -case "$ans" in -y|Y) val="$define" ;; -*) val="$undef" ;; -esac -set uselonglong -eval $setvar - -case "$uselonglong" in -true|[yY]*) uselonglong="$define" ;; -esac - -case "$uselonglong" in -$define) -: Look for a hint-file generated 'call-back-unit'. If the -: user has specified that long longs should be used, -: we may need to set or change some other defaults. - if $test -f uselonglong.cbu; then - echo "Your platform has some specific hints for long longs, using them..." - . ./uselonglong.cbu - else - $cat <<EOM -(Your platform doesn't have any specific hints for long longs.) -EOM - fi - ;; +case "$useperlio" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; esac - cat <<EOM Previous version of $package used the standard IO mechanisms as defined @@ -7085,12 +7220,8 @@ have sfio installed) or regular stdio. Using PerlIO with sfio may cause problems with some extension modules. Using PerlIO with stdio is safe, but it is slower than plain stdio and therefore is not the default. -If this doesn't make any sense to you, just accept the default 'n'. +If this doesn't make any sense to you, just accept the default '$dflt'. EOM -case "$useperlio" in -$define|true|[yY]*) dflt='y';; -*) dflt='n';; -esac rp='Use the experimental PerlIO abstraction layer?' . ./myread case "$ans" in @@ -7112,26 +7243,29 @@ case "$vendorprefix" in ;; *) d_vendorbin="$define" : determine where vendor-supplied executables go. - dflt=$vendorprefix/bin + case "$vendorbin" in + '') dflt=$vendorprefix/bin ;; + *) dflt="$vendorbin" ;; + esac fn=d~+ rp='Pathname for the vendor-supplied executables directory?' . ./getfile vendorbin="$ans" vendorbinexp="$ansexp" - : Change installation prefix, if necessary. - if $test X"$prefix" != X"$installprefix"; then - installvendorbin=`echo $vendorbinexp | $sed "s#^$prefix#$installprefix#"` - else - installvendorbin="$vendorbinexp" - fi ;; esac +: Change installation prefix, if necessary. +if $test X"$prefix" != X"$installprefix"; then + installvendorbin=`echo $vendorbinexp | $sed "s#^$prefix#$installprefix#"` +else + installvendorbin="$vendorbinexp" +fi : check for length of double echo " " case "$doublesize" in '') - $echo $n "Checking to see how big your double precision numbers are...$c" >&4 + echo "Checking to see how big your double precision numbers are..." >&4 $cat >try.c <<'EOCP' #include <stdio.h> int main() @@ -7143,7 +7277,7 @@ EOCP set try if eval $compile_ok; then doublesize=`./try` - $echo " $doublesize bytes." >&4 + echo "Your double is $doublesize bytes long." else dflt='8' echo "(I can't seem to compile the test program. Guessing...)" @@ -7157,15 +7291,15 @@ $rm -f try.c try : check for long doubles echo " " -$echo $n "Checking to see if your system supports long double..." $c >&4 +echo "Checking to see if you have long double..." >&4 echo 'int main() { long double x = 7.0; }' > try.c set try if eval $compile; then val="$define" - echo " Yes, it does." >&4 + echo "You have long double." else val="$undef" - echo " No, it doesn't." >&4 + echo "You do not have long double." fi $rm try.* set d_longdbl @@ -7175,7 +7309,7 @@ eval $setvar case "${d_longdbl}${longdblsize}" in $define) echo " " - $echo $n "Checking to see how big your long doubles are..." $c >&4 + echo "Checking to see how big your long doubles are..." >&4 $cat >try.c <<'EOCP' #include <stdio.h> int main() @@ -7187,7 +7321,7 @@ EOCP set try if eval $compile; then longdblsize=`./try$exe_ext` - $echo " $longdblsize bytes." >&4 + echo "Your long doubles are $longdblsize bytes long." else dflt='8' echo " " @@ -8812,43 +8946,20 @@ set fpathconf d_fpathconf eval $inlibc -: check for off64_t -echo " " -echo "Checking to see if your system supports off64_t..." >&4 -$cat >try.c <<EOCP -#include <sys/types.h> -#include <unistd.h> -int main() { off64_t x = 7; }' -EOCP -set try -if eval $compile; then - val="$define" - echo "Yes, it does." -else - val="$undef" - echo "No, it doesn't." - case "$lseeksize" in - 8) echo "(Your off_t is 64 bits, so you could use that.)" ;; - esac -fi -$rm -f try.* try -set d_off64_t -eval $setvar - : check for fpos64_t echo " " -echo "Checking to see if your system supports fpos64_t..." >&4 +echo "Checking to see if you have fpos64_t..." >&4 $cat >try.c <<EOCP -#include <sys/stdio.h> -int main() { fpos64_t x x = 7; }' +#include <stdio.h> +int main() { fpos64_t x = 7; } EOCP set try if eval $compile; then val="$define" - echo "Yes, it does." + echo "You have fpos64_t." else val="$undef" - echo "No, it doesn't." + echo "You do not have fpos64_t." case "$fpossize" in 8) echo "(Your fpos_t is 64 bits, so you could use that.)" ;; esac @@ -8930,6 +9041,15 @@ case "$longsize" in 8) echo "(Your long is 64 bits, so you could use ftell.)" ;; esac +: see if getcwd exists +set getcwd d_getcwd +eval $inlibc + + +: see if getfsstat exists +set getfsstat d_getfsstat +eval $inlibc + : see if getgrent exists set getgrent d_getgrent eval $inlibc @@ -9268,6 +9388,51 @@ set d_index; eval $setvar set inet_aton d_inetaton eval $inlibc +: see if inttypes.h is available +: we want a real compile instead of Inhdr because some systems +: have an inttypes.h which includes non-existent headers +echo " " +$cat >try.c <<EOCP +#include <inttypes.h> +int main() { + static int32_t foo32 = 0x12345678; +} +EOCP +set try +if eval $compile; then + echo "<inttypes.h> found." >&4 + val="$define" +else + echo "<inttypes.h> NOT found." >&4 + val="$undef" +fi +$rm -f try.c try +set i_inttypes +eval $setvar + +: check for int64_t +echo " " +echo "Checking to see if you have int64_t..." >&4 +$cat >try.c <<EOCP +#include <sys/types.h> +#$i_inttypes I_INTTYPES +#ifdef I_INTTYPES +#include <inttypes.h> +#endif +int main() { int64_t x = 7; } +EOCP +set try +if eval $compile; then + val="$define" + echo "You have int64_t." +else + val="$undef" + echo "You do not have int64_t." +fi +$rm -f try try.* +set d_int64_t +eval $setvar + : Look for isascii echo " " $cat >isascii.c <<'EOCP' @@ -9370,15 +9535,15 @@ eval $inlibc : check for long long echo " " -$echo $n "Checking to see if your system supports long long..." $c >&4 +echo "Checking to see if you have long long..." >&4 echo 'int main() { long long x = 7; return 0; }' > try.c set try if eval $compile; then val="$define" - echo " Yes, it does." >&4 + echo "You have have long long." else val="$undef" - echo " No, it doesn't." >&4 + echo "You do not have long long." fi $rm try.* set d_longlong @@ -9388,7 +9553,7 @@ eval $setvar case "${d_longlong}${longlongsize}" in $define) echo " " - $echo $n "Checking to see how big your long longs are..." $c >&4 + echo "Checking to see how big your long longs are..." >&4 $cat >try.c <<'EOCP' #include <stdio.h> int main() @@ -9400,7 +9565,7 @@ EOCP set try if eval $compile_ok; then longlongsize=`./try$exe_ext` - $echo " $longlongsize bytes." >&4 + echo "Your long longs are $longlongsize bytes long." else dflt='8' echo " " @@ -9416,6 +9581,11 @@ EOCP esac $rm -f try.* try +: see if prototype for lseek is available +echo " " +set d_lseekproto lseek $i_systypes sys/types.h $i_unistd unistd.h +eval $hasproto + : see if lstat exists set lstat d_lstat eval $inlibc @@ -9456,14 +9626,57 @@ eval $inlibc set mkdir d_mkdir eval $inlibc +: see if mkdtemp exists +set mkdtemp d_mkdtemp +eval $inlibc + : see if mkfifo exists set mkfifo d_mkfifo eval $inlibc +: see if mkstemp exists +set mkstemp d_mkstemp +eval $inlibc + +: see if mkstemps exists +set mkstemps d_mkstemps +eval $inlibc + : see if mktime exists set mktime d_mktime eval $inlibc +: see if this is a sys/mman.h system +set sys/mman.h i_sysmman +eval $inhdr + +: see if mmap exists +set mmap d_mmap +eval $inlibc +: see what shmat returns +: default to something harmless +mmaptype='void *' +case "$i_sysmman$d_mmap" in +"$define$define") + $cat >mmap.c <<'END' +#include <sys/mman.h> +void *mmap(); +END + if $cc $ccflags -c mmap.c >/dev/null 2>&1; then + mmaptype='void *' + else + mmaptype='caddr_t' + fi + echo "and it returns ($mmaptype)." >&4 + ;; +esac + + + +: see if mprotect exists +set mprotect d_mprotect +eval $inlibc + : see if msgctl exists set msgctl d_msgctl eval $inlibc @@ -9516,54 +9729,17 @@ fi set d_msg eval $setvar -: see if nice exists -set nice d_nice +: see if msync exists +set msync d_msync eval $inlibc -: see if inttypes.h is available -: we want a real compile instead of Inhdr because some systems -: have an inttypes.h which includes non-existent headers -echo " " -$cat >try.c <<EOCP -#include <inttypes.h> -int main() { - static int32_t foo32 = 0x12345678; -} -EOCP -set try -if eval $compile; then - echo "<inttypes.h> found." >&4 - val="$define" -else - echo "<inttypes.h> NOT found." >&4 - val="$undef" -fi -$rm -f try.c try -set i_inttypes -eval $setvar +: see if munmap exists +set munmap d_munmap +eval $inlibc -: check for int64_t -echo " " -$echo $n "Checking to see if your system supports int64_t...$c" >&4 -$cat >try.c <<EOCP -#include <sys/types.h> -#$i_inttypes I_INTTYPES -#ifdef I_INTTYPES -#include <inttypes.h> -#endif -int main() { int64_t x = 7; } -EOCP -set try -if eval $compile; then - val="$define" - echo " Yes, it does." >&4 -else - val="$undef" - echo " No, it doesn't." >&4 -fi -$rm -f try try.* -set d_int64t -eval $setvar +: see if nice exists +set nice d_nice +eval $inlibc echo " " @@ -9597,7 +9773,7 @@ case "$intsize" in eval $setvar quadkind=3 ;; - *) case "$d_int64t" in + *) case "$d_int64_t" in define) val=int64_t set quadtype @@ -9616,14 +9792,10 @@ case "$intsize" in esac case "$quadtype" in -'') case "$uselonglong:$d_longlong:$longlongsize" in - undef:define:8) - echo "(You would have 'long long', but you are not using it.)" >&4 ;; - *) echo "Alas, no 64-bit integer types in sight." >&4 ;; - esac +'') echo "Alas, no 64-bit integer types in sight." >&4 d_quad="$undef" ;; -*) if test X"$use64bits" = Xdefine -o X"$longsize" = X8; then +*) if test X"$use64bitint" = Xdefine -o X"$longsize" = X8; then verb="will" else verb="could" @@ -9667,7 +9839,7 @@ $rm -f try.c try echo " " $echo "Choosing the C types to be used for Perl's internal types..." >&4 -case "$use64bits:$d_quad:$quadtype" in +case "$use64bitint:$d_quad:$quadtype" in define:define:?*) ivtype="$quadtype" uvtype="$uquadtype" @@ -9870,6 +10042,30 @@ esac $rm -f try.* try + +: check for off64_t +echo " " +echo "Checking to see if you have off64_t..." >&4 +$cat >try.c <<EOCP +#include <sys/types.h> +#include <unistd.h> +int main() { off64_t x = 7; } +EOCP +set try +if eval $compile; then + val="$define" + echo "You have off64_t." +else + val="$undef" + echo "You do not have off64_t." + case "$lseeksize" in + 8) echo "(Your off_t is 64 bits, so you could use that.)" ;; + esac +fi +$rm -f try.* try +set d_off64_t +eval $setvar + : see if POSIX threads are available set pthread.h i_pthread eval $inhdr @@ -11448,7 +11644,7 @@ case "$crosscompile" in esac case "$osname" in -next|rhapsody) multiarch="$define" ;; +next|rhapsody|darwin) multiarch="$define" ;; esac case "$multiarch" in ''|[nN]*) multiarch="$undef" ;; @@ -11470,11 +11666,20 @@ EOM *) case "$alignbytes" in '') echo "Checking alignment constraints..." >&4 - $cat >try.c <<'EOCP' + if $test "X$uselongdouble" = Xdefine -a "X$d_longdbl" = Xdefine; then + $cat >try.c <<'EOCP' +typedef long double NV; +EOCP + else + $cat >try.c <<'EOCP' +typedef double NV; +EOCP + fi + $cat >>try.c <<'EOCP' #include <stdio.h> struct foobar { char foo; - double bar; + NV bar; } try_algn; int main() { @@ -11501,6 +11706,9 @@ EOCP esac +: set the base revision +baserev=5.0 + : check for ordering of bytes in a long echo " " case "$crosscompile$multiarch" in @@ -12277,7 +12485,7 @@ if eval $compile_ok; then echo "(I can't execute the test program--guessing $gidsize.)" >&4 ;; *) gidsize=$yyy - echo "Your $zzz size is $gidsize bytes." + echo "Your $zzz is $gidsize bytes long." ;; esac else @@ -12814,11 +13022,20 @@ rp="What is the type of process ids on this system?" set pid_t pidtype int stdio.h sys/types.h eval $typedef_ask +: Find earliest binary compatible site_perl subdirectory perl can use. +case "$bincompat5005" in +"$define") xs_apiversion='5.005' ;; +*) xs_apiversion=$version ;; # The current site_perl version. +esac +: Find earliest pure perl site_perl subdirectory perl can use. +: The versioned directories started at 5.005. +pm_apiversion='5.005' + : check for length of pointer echo " " case "$ptrsize" in '') - $echo $n "Checking to see how big your pointers are...$c" >&4 + echo "Checking to see how big your pointers are..." >&4 if test "$voidflags" -gt 7; then echo '#define VOID_PTR char *' > try.c else @@ -12835,7 +13052,7 @@ EOCP set try if eval $compile_ok; then ptrsize=`./try` - $echo " $ptrsize bytes." >&4 + echo "Your pointers are $ptrsize bytes long." else dflt='4' echo "(I can't seem to compile the test program. Guessing...)" >&4 @@ -13299,6 +13516,69 @@ echo $sig_name | $awk \ }' $rm -f signal signal.c signal.awk signal.lst signal_cmd +: check for socklen_t +echo " " +echo "Checking to see if you have socklen_t..." >&4 +$cat >try.c <<EOCP +#include <sys/types.h> +#$d_socket HAS_SOCKET +#ifdef HAS_SOCKET +#include <sys/socket.h> +#endif +int main() { socklen_t x = 16; } +EOCP +set try +if eval $compile; then + val="$define" + echo "You have socklen_t." +else + val="$undef" + echo "You do not have socklen_t." + case "$sizetype" in + size_t) echo "(You do have size_t, that might work.)" ;; + esac +fi +$rm -f try try.* +set d_socklen_t +eval $setvar + +: check for type of the size argument to socket calls +case "$d_socket" in +"$define") + $cat <<EOM + +Checking to see what type is the last argument of accept(). +EOM + hdrs="$define sys/types.h $d_socket sys/socket.h" + yyy='' + case "$d_socklen_t" in + "$define") yyy="$yyy socklen_t" + esac + yyy="$yyy $sizetype int long" + for xxx in $yyy; do + case "$socksizetype" in + '') try="extern int accept(int, struct sockaddr *, $xxx *);" + if ./protochk "$try" $hdrs; then + echo "Your system accepts '$xxx *' for the last argument of accept()." + socksizetype="$xxx" + fi + ;; + esac + done +: In case none of those worked, prompt the user. + case "$socksizetype" in + '') rp='What is the type for the last argument to accept()?' + dflt='int' + . ./myread + socksizetype=$ans + ;; + esac + ;; +*) : no sockets, so pick relatively harmless defaults + socksizetype='char *' + ;; +esac + : see what type is used for signed size_t set ssize_t ssizetype int stdio.h sys/types.h eval $typedef @@ -13414,7 +13694,7 @@ if eval $compile_ok; then echo "(I can't execute the test program--guessing $uidsize.)" >&4 ;; *) uidsize=$yyy - echo "Your $zzz size is $uidsize bytes." + echo "Your $zzz is $uidsize bytes long." ;; esac else @@ -13775,7 +14055,7 @@ ccflags="$ccflags" ldflags="$ldflags" libs="$libs" exe_ext="$exe_ext" -$cc $optimize $ccflags $ldflags -o try$exe_ext try.c $libs && ./try$exe_ext +$cc $optimize $ccflags $ldflags -o try try.c $libs && ./try$exe_ext EOSH chmod +x Cppsym.try $eunicefix Cppsym.try @@ -14047,6 +14327,16 @@ fi set i_sysioctl eval $setvar + +: see if this is a syslog.h system +set syslog.h i_syslog +eval $inhdr + + +: see if this is a sys/mode.h system +set sys/mode.h i_sysmode +eval $inhdr + : see if sys/resource.h has to be included set sys/resource.h i_sysresrc eval $inhdr @@ -14067,6 +14357,11 @@ eval $inhdr set sys/un.h i_sysun eval $inhdr + +: see if this is a sys/utsname.h system +set sys/utsname.h i_sysutsname +eval $inhdr + : see if this is a syswait system set sys/wait.h i_syswait eval $inhdr @@ -14177,12 +14472,30 @@ for xxx in $known_extensions ; do ;; NDBM_File|ndbm_fil) case "$i_ndbm" in - $define) avail_ext="$avail_ext $xxx" ;; + $define) + case "$osname-$use64bitint" in + hpux-define) + case "$libs" in + *-lndbm*) avail_ext="$avail_ext $xxx" ;; + esac + ;; + *) avail_ext="$avail_ext $xxx" ;; + esac + ;; esac ;; ODBM_File|odbm_fil) case "${i_dbm}${i_rpcsvcdbm}" in - *"${define}"*) avail_ext="$avail_ext $xxx" ;; + *"${define}"*) + case "$osname-$use64bitint" in + hpux-define) + case "$libs" in + *-ldbm*) avail_ext="$avail_ext $xxx" ;; + esac + ;; + *) avail_ext="$avail_ext $xxx" ;; + esac + ;; esac ;; POSIX|posix) @@ -14559,6 +14872,8 @@ d_fstatfs='$d_fstatfs' d_fstatvfs='$d_fstatvfs' d_ftello='$d_ftello' d_ftime='$d_ftime' +d_getcwd='$d_getcwd' +d_getfsstat='$d_getfsstat' d_getgrent='$d_getgrent' d_getgrps='$d_getgrps' d_gethbyaddr='$d_gethbyaddr' @@ -14597,7 +14912,7 @@ d_htonl='$d_htonl' d_iconv='$d_iconv' d_index='$d_index' d_inetaton='$d_inetaton' -d_int64t='$d_int64t' +d_int64_t='$d_int64_t' d_isascii='$d_isascii' d_killpg='$d_killpg' d_lchown='$d_lchown' @@ -14607,6 +14922,7 @@ d_locconv='$d_locconv' d_lockf='$d_lockf' d_longdbl='$d_longdbl' d_longlong='$d_longlong' +d_lseekproto='$d_lseekproto' d_lstat='$d_lstat' d_mblen='$d_mblen' d_mbstowcs='$d_mbstowcs' @@ -14617,8 +14933,13 @@ d_memcpy='$d_memcpy' d_memmove='$d_memmove' d_memset='$d_memset' d_mkdir='$d_mkdir' +d_mkdtemp='$d_mkdtemp' d_mkfifo='$d_mkfifo' +d_mkstemp='$d_mkstemp' +d_mkstemps='$d_mkstemps' d_mktime='$d_mktime' +d_mmap='$d_mmap' +d_mprotect='$d_mprotect' d_msg='$d_msg' d_msg_ctrunc='$d_msg_ctrunc' d_msg_dontroute='$d_msg_dontroute' @@ -14629,6 +14950,8 @@ d_msgctl='$d_msgctl' d_msgget='$d_msgget' d_msgrcv='$d_msgrcv' d_msgsnd='$d_msgsnd' +d_msync='$d_msync' +d_munmap='$d_munmap' d_mymalloc='$d_mymalloc' d_nice='$d_nice' d_nv_preserves_uv='$d_nv_preserves_uv' @@ -14705,6 +15028,7 @@ d_shmget='$d_shmget' d_sigaction='$d_sigaction' d_sigsetjmp='$d_sigsetjmp' d_socket='$d_socket' +d_socklen_t='$d_socklen_t' d_sockpair='$d_sockpair' d_sqrtl='$d_sqrtl' d_statblks='$d_statblks' @@ -14857,6 +15181,9 @@ i_sysfile='$i_sysfile' i_sysfilio='$i_sysfilio' i_sysin='$i_sysin' i_sysioctl='$i_sysioctl' +i_syslog='$i_syslog' +i_sysmman='$i_sysmman' +i_sysmode='$i_sysmode' i_sysmount='$i_sysmount' i_sysndir='$i_sysndir' i_sysparam='$i_sysparam' @@ -14873,6 +15200,7 @@ i_systimes='$i_systimes' i_systypes='$i_systypes' i_sysuio='$i_sysuio' i_sysun='$i_sysun' +i_sysutsname='$i_sysutsname' i_sysvfs='$i_sysvfs' i_syswait='$i_syswait' i_termio='$i_termio' @@ -14925,6 +15253,7 @@ libs='$libs' libsdirs='$libsdirs' libsfiles='$libsfiles' libsfound='$libsfound' +libspath='$libspath' libswanted='$libswanted' line='$line' lint='$lint' @@ -14957,6 +15286,7 @@ man3ext='$man3ext' medium='$medium' mips_type='$mips_type' mkdir='$mkdir' +mmaptype='$mmaptype' models='$models' modetype='$modetype' more='$more' @@ -14990,6 +15320,7 @@ pager='$pager' passcat='$passcat' patchlevel='$patchlevel' path_sep='$path_sep' +perl5='$perl5' perl='$perl' perladmin='$perladmin' perlpath='$perlpath' @@ -14997,6 +15328,7 @@ pg='$pg' phostname='$phostname' pidtype='$pidtype' plibpth='$plibpth' +pm_apiversion='$pm_apiversion' pmake='$pmake' pr='$pr' prefix='$prefix' @@ -15012,6 +15344,7 @@ randfunc='$randfunc' randseedtype='$randseedtype' ranlib='$ranlib' rd_nodata='$rd_nodata' +revision='$revision' rm='$rm' rmail='$rmail' runnm='$runnm' @@ -15063,6 +15396,7 @@ small='$small' so='$so' sockethdr='$sockethdr' socketlib='$socketlib' +socksizetype='$socksizetype' sort='$sort' spackage='$spackage' spitshell='$spitshell' @@ -15110,12 +15444,12 @@ uname='$uname' uniq='$uniq' uquadtype='$uquadtype' use5005threads='$use5005threads' -use64bits='$use64bits' +use64bitall='$use64bitall' +use64bitint='$use64bitint' usedl='$usedl' useithreads='$useithreads' uselargefiles='$uselargefiles' uselongdouble='$uselongdouble' -uselonglong='$uselonglong' usemorebits='$usemorebits' usemultiplicity='$usemultiplicity' usemymalloc='$usemymalloc' @@ -15146,6 +15480,7 @@ version='$version' vi='$vi' voidflags='$voidflags' xlibpth='$xlibpth' +xs_apiversion='$xs_apiversion' zcat='$zcat' zip='$zip' EOT @@ -369,13 +369,13 @@ be used for installing those add-on modules and scripts. Configure variable Default value $siteprefix $prefix $sitebin $siteprefix/bin - $sitescriptdir $siteprefix/bin + $sitescript $siteprefix/bin $sitelib $siteprefix/lib/perl5/site_perl/$version $sitearch $siteprefix/lib/perl5/site_perl/$version/$archname - $siteman1dir $siteprefix/man/man1 - $siteman3dir $siteprefix/man/man3 - $sitehtml1dir (none) - $sitehtml3dir (none) + $siteman1 $siteprefix/man/man1 + $siteman3 $siteprefix/man/man3 + $sitehtml1 (none) + $sitehtml3 (none) By default, ExtUtils::MakeMaker will install architecture-independent modules into $sitelib and architecture-dependent modules into $sitearch. @@ -390,13 +390,13 @@ for you to use to distribute add-on modules. $vendorprefix (none) (The next ones are set only if vendorprefix is set.) $vendorbin $vendorprefix/bin - $vendorscriptdir $vendorprefix/bin + $vendorscript $vendorprefix/bin $vendorlib $vendorprefix/lib/perl5/vendor_perl/$version $vendorarch $vendorprefix/lib/perl5/vendor_perl/$version/$archname - $vendorman1dir $vendorprefix/man/man1 - $vendorman3dir $vendorprefix/man/man3 - $vendorhtml1dir (none) - $vendorhtml3dir (none) + $vendorman1 $vendorprefix/man/man1 + $vendorman3 $vendorprefix/man/man3 + $vendorhtml1 (none) + $vendorhtml3 (none) These are normally empty, but may be set as needed. For example, a vendor might choose the following settings: @@ -415,18 +415,18 @@ This would have the effect of setting the following: $man3dir /usr/man/man3 $sitebin /usr/local/bin - $sitescriptdir /usr/local/bin + $sitescript /usr/local/bin $sitelib /usr/local/lib/perl5/site_perl/$version $sitearch /usr/local/lib/perl5/site_perl/$version/$archname - $siteman1dir /usr/local/man/man1 - $siteman3dir /usr/local/man/man3 + $siteman1 /usr/local/man/man1 + $siteman3 /usr/local/man/man3 - $vendorbin /usr/bin - $vendorscriptdir /usr/bin + $vendorbin /usr/bin + $vendorscript /usr/bin $vendorlib /usr/lib/perl5/vendor_perl/$version $vendorarch /usr/lib/perl5/vendor_perl/$version/$archname - $vendorman1dir /usr/man/man1 - $vendorman3dir /usr/man/man3 + $vendorman1 /usr/man/man1 + $vendorman3 /usr/man/man3 Note how in this example, the vendor-supplied directories are in the /usr hierarchy, while the directories reserved for the end-user are in @@ -740,7 +740,7 @@ You can elect to build a shared libperl by To build a shared libperl, the environment variable controlling shared library search (LD_LIBRARY_PATH in most systems, DYLD_LIBRARY_PATH for -NeXTSTEP/OPENSTEP/Rhapsody, LIBRARY_PATH for BeOS, SHLIB_PATH for +NeXTSTEP/OPENSTEP/Darwin, LIBRARY_PATH for BeOS, SHLIB_PATH for HP-UX, LIBPATH for AIX, PATH for Cygwin) must be set up to include the Perl build directory because that's where the shared libperl will be created. Configure arranges makefile to have the correct shared @@ -45,11 +45,11 @@ README.mpeix Notes about MPE/iX port 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 @@ -68,6 +68,7 @@ configure.com Configure-equivalent for VMS configure.gnu Crude emulation of GNU configure cop.h Control operator header cv.h Code value header +cygwin/cygwin.c Additional code for Cygwin port cygwin/Makefile.SHs Shared library generation for Cygwin port cygwin/ld2.in ld wrapper template for Cygwin port cygwin/perlld.in dll generator template for Cygwin port @@ -234,11 +235,11 @@ ext/DynaLoader/dl_aix.xs AIX implementation ext/DynaLoader/dl_beos.xs BeOS implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation +ext/DynaLoader/dl_dyld.xs NeXT/Apple dyld implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation ext/DynaLoader/dl_mpeix.xs MPE/iX implementation -ext/DynaLoader/dl_next.xs Next implementation +ext/DynaLoader/dl_next.xs NeXT implementation ext/DynaLoader/dl_none.xs Stub implementation -ext/DynaLoader/dl_rhapsody.xs Rhapsody implementation ext/DynaLoader/dl_vmesa.xs VM/ESA implementation ext/DynaLoader/dl_vms.xs VMS implementation ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files @@ -364,6 +365,9 @@ ext/SDBM_File/typemap SDBM extension interface types ext/Socket/Makefile.PL Socket extension makefile writer ext/Socket/Socket.pm Socket extension Perl module ext/Socket/Socket.xs Socket extension external subroutines +ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer +ext/Sys/Hostname/Hostname.pm Sys::Hostname extension Perl module +ext/Sys/Hostname/Hostname.xs Sys::Hostname extension external subroutines ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer ext/Sys/Syslog/Syslog.pm Sys::Syslog extension Perl module ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines @@ -436,6 +440,7 @@ hints/bsdos.sh Hints for named architecture hints/convexos.sh Hints for named architecture hints/cxux.sh Hints for named architecture hints/cygwin.sh Hints for named architecture +hints/darwin.sh Hints for named architecture hints/dcosx.sh Hints for named architecture hints/dec_osf.sh Hints for named architecture hints/dgux.sh Hints for named architecture @@ -646,7 +651,6 @@ lib/SelectSaver.pm Enforce proper select scoping lib/SelfLoader.pm Load functions only on demand lib/Shell.pm Make AUTOLOADed system() calls lib/Symbol.pm Symbol table manipulation routines -lib/Sys/Hostname.pm Hostname methods lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine lib/Term/ReadLine.pm Stub readline library @@ -679,8 +683,8 @@ lib/bigfloat.pl An arbitrary precision floating point package lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" -lib/byte.pm Pragma to enable byte operations -lib/byte_heavy.pl Support routines for byte pragma +lib/bytes.pm Pragma to enable byte operations +lib/bytes_heavy.pl Support routines for byte pragma lib/cacheout.pl Manages output filehandles when you need too many lib/charnames.pm Character names lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead) @@ -734,8 +738,6 @@ lib/unicode/CombiningClass.pl Unicode character database lib/unicode/CompExcl.txt Unicode character database lib/unicode/Decomposition.pl Unicode character database lib/unicode/EAWidth.txt Unicode character database -lib/unicode/Eq/Latin1.pl Unicode character database -lib/unicode/Eq/Unicode.pl Unicode character database lib/unicode/In/AlphabeticPresentationForms.pl Unicode character database lib/unicode/In/Arabic.pl Unicode character database lib/unicode/In/ArabicPresentationForms-A.pl Unicode character database @@ -1388,7 +1390,7 @@ t/op/undef.t See if undef works t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works t/op/vec.t See if vectors work -t/op/ver.t See if version tuples work +t/op/ver.t See if v-strings and the %v format flag work t/op/wantarray.t See if wantarray works t/op/write.t See if write works t/pod/emptycmd.t Test empty pod directives @@ -1443,6 +1445,7 @@ t/pragma/warn/5nolint Tests for -X switch 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 diff --git a/Makefile.SH b/Makefile.SH index c3e5c851cd..0817c99c2e 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -45,6 +45,14 @@ true) -compatibility_version 1 -current_version $patchlevel \ -prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@" ;; + rhapsody*|darwin*) + shrpldflags="${ldflags} -dynamiclib \ + -compatibility_version 1 \ + -current_version \ + ${api_version}.${api_subversion} \ + -image_base 0x4be00000 \ + -install_name \$(shrpdir)/\$@" + ;; cygwin*) linklibperl="-lperl" ;; @@ -76,9 +84,6 @@ true) os2) ldlibpth='' ;; - rhapsody) - eval "ldlibpth=\"$ldlibpthname=`pwd`/Perl:\$$ldlibpthname\"" - ;; *) eval "ldlibpth=\"$ldlibpthname=`pwd`:\$$ldlibpthname\"" ;; @@ -320,9 +325,6 @@ ext.libs: $(static_ext) # How to build libperl. This is still rather convoluted. # Load up custom Makefile.SH fragment for shared loading and executables: case "$osname" in -cygwin*) - Makefile_s="cygwin/Makefile.SHs" - ;; *) Makefile_s="$osname/Makefile.SHs" ;; @@ -444,6 +446,15 @@ miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest !NO!SUBS! ;; + aix*) + $spitshell >>Makefile <<'!NO!SUBS!' +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) + $(CC) -o miniperl $(CLDFLAGS) \ + `echo $(obj) | sed 's/ op$(OBJ_EXT) / /'` \ + miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) perl$(OBJ_EXT) $(libs) + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest +!NO!SUBS! + ;; *) $spitshell >>Makefile <<'!NO!SUBS!' miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) @@ -518,11 +529,16 @@ $(plextract): miniperl lib/Config.pm 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-strip: + $(MAKE) STRIPFLAGS=-s install install: all install.perl install.man @@ -534,7 +550,7 @@ install.perl: all installperl cd ../pod; $(MAKE) compile; \ else :; \ fi - $(LDLIBPTH) ./perl installperl + $(LDLIBPTH) ./perl installperl $(STRIPFLAGS) install.man: all installman $(LDLIBPTH) ./perl installman @@ -542,6 +558,9 @@ install.man: all installman # 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 \ @@ -588,24 +607,29 @@ SYMH = perlvars.h intrpvar.h thrdvar.h CHMOD_W = chmod +w # The following files are generated automatically -# keywords.h: keywords.pl -# opcode.h: opcode.pl -# pp_proto.h: opcode.pl -# pp.sym: opcode.pl -# embed.h: embed.pl [* needs pp.sym generated by opcode.pl! *] -# embedvar.h: embed.pl [* needs pp.sym generated by opcode.pl! *] -# ext/ByteLoader/byterun.h: bytecode.pl -# ext/ByteLoader/byterun.c: bytecode.pl -# ext/B/Asmdata.pm: bytecode.pl -# global.sym: embed.pl -# regnodes.h: regcomp.pl -# warnings.h lib/warnings.pm: warnings.pl +# keywords.pl: keywords.h +# opcode.pl: opcode.h opnames.h pp_proto.h pp.sym +# [* embed.pl needs pp.sym generated by opcode.pl! *] +# embed.pl: proto.h embed.h embedvar.h global.sym objXSUB.h +# perlapi.h perlapi.c pod/perlintern.pod +# pod/perlapi.pod +# bytecode.pl: ext/ByteLoader/byterun.h ext/ByteLoader/byterun.c +# ext/B/B/Asmdata.pm +# regcomp.pl: regnodes.h +# warnings.pl: warnings.h lib/warnings.pm # The correct versions should be already supplied with the perl kit, # in case you don't have perl available. -# To force them to run, type +# To force them to be regenerated, type # make regen_headers + +AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h pp.sym embed.h \ + embedvar.h global.sym pod/perlintern.pod pod/perlapi.pod \ + objXSUB.h perlapi.h perlapi.c ext/ByteLoader/byterun.h \ + ext/ByteLoader/byterun.c ext/B/B/Asmdata.pm regnodes.h \ + warnings.h lib/warnings.pm + regen_headers: FORCE - $(CHMOD_W) proto.h warnings.h lib/warnings.pm + $(CHMOD_W) $(AUTOGEN_FILES) perl keywords.pl perl opcode.pl perl embed.pl @@ -649,6 +673,7 @@ distclean: clobber _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 @@ -673,7 +698,7 @@ _cleaner: -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \ $(LDLIBPTH) sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \ done - rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) + rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) .nfs* .*.c rm -rf $(addedbyconf) rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old rm -f $(private) diff --git a/Policy_sh.SH b/Policy_sh.SH index b953046f9d..0d9c1dfbc7 100644 --- a/Policy_sh.SH +++ b/Policy_sh.SH @@ -86,8 +86,8 @@ esac for var in \ bin scriptdir privlib archlib man1dir man3dir html1dir html3dir \ - sitebin sitescriptdir sitelib sitearch \ - siteman1dir siteman3dir sitehtml1dir sitehtml3dir \ + sitebin sitescript sitelib sitearch \ + siteman1 siteman3 sitehtml1 sitehtml3 \ vendorbin vendorscript vendorlib vendorarch \ vendorman1 vendorman3 vendorhtml1 vendorhtml3 do @@ -124,8 +124,7 @@ do # Directories for site-specific add-on files sitebin) dflt=$siteprefix/bin ;; - # The scriptdir test is more complex, but this is probably usually ok. - sitescriptdir) + sitescript) if $test -d $siteprefix/script; then dflt=$siteprefix/script else @@ -140,10 +139,10 @@ do ;; sitearch) dflt="$sitelib/$archname" ;; - siteman1dir) dflt="$siteprefix/man/man1" ;; - siteman3dir) dflt="$siteprefix/man/man3" ;; + siteman1) dflt="$siteprefix/man/man1" ;; + siteman3) dflt="$siteprefix/man/man3" ;; # We don't know what to do with these yet. - sitehtml1dir) dflt='' ;; + sitehtml1) dflt='' ;; sitehtm31dir) dflt='' ;; # Directories for vendor-supplied add-on files @@ -154,10 +153,7 @@ do else case "$var" in vendorbin) dflt=$vendorprefix/bin ;; - - # The scriptdir test is more complex, - # but this is probably usually ok. - vendorscriptdir) + vendorscript) if $test -d $vendorprefix/script; then dflt=$vendorprefix/script else @@ -172,11 +168,11 @@ do ;; vendorarch) dflt="$vendorlib/$archname" ;; - vendorman1dir) dflt="$vendorprefix/man/man1" ;; - vendorman3dir) dflt="$vendorprefix/man/man3" ;; + vendorman1) dflt="$vendorprefix/man/man1" ;; + vendorman3) dflt="$vendorprefix/man/man3" ;; # We don't know what to do with these yet. - vendorhtml1dir) dflt='' ;; - vendorhtm31dir) dflt='' ;; + vendorhtml1) dflt='' ;; + vendorhtm3) dflt='' ;; esac # End of vendorprefix != '' fi diff --git a/Porting/Glossary b/Porting/Glossary index 17b408de2e..71d97f8ea9 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -26,7 +26,8 @@ afs (afs.U): alignbytes (alignbytes.U): This variable holds the number of bytes required to align a - double. Usual values are 2, 4 and 8. + double-- or a long double when applicable. Usual values are + 2, 4 and 8. The default is eight, for safety. ansi2knr (ansi2knr.U): This variable is set if the user needs to run ansi2knr. @@ -193,8 +194,6 @@ ccflags (ccflags.U): ccsymbols (Cppsym.U): The variable contains the symbols defined by the C compiler alone. - The symbols defined by cpp or by cc when it calls cpp are not in - this list, see cppsymbols and cppccsymbols. The list is a space-separated list of symbol=value tokens. cf_by (cf_who.U): @@ -268,9 +267,9 @@ cpp_stuff (cpp_stuff.U): used by the C preprocessor. cppccsymbols (Cppsym.U): - The variable contains the symbols defined by the C compiler - when it calls cpp. The symbols defined by the cc alone or cpp - alone are not in this list, see ccsymbols and cppsymbols. + The variable contains the symbols defined by both + the bare C compiler and during a compilation that + includes stdio.h. The list is a space-separated list of symbol=value tokens. cppflags (ccflags.U): @@ -302,9 +301,8 @@ cppstdin (cppstdin.U): preprocessor symbols. cppsymbols (Cppsym.U): - The variable contains the symbols defined by the C preprocessor - alone. The symbols defined by cc or by cc when it calls cpp are - not in this list, see ccsymbols and cppccsymbols. + The variable contains the symbols during a compilation + that includes stdio.h. The list is a space-separated list of symbol=value tokens. crosscompile (crosscompile.U): @@ -568,7 +566,7 @@ d_fpathconf (d_pathconf.U): to determine file-system related limits and options associated with a given open file descriptor. -d_fpos64_t (io64.U): +d_fpos64_t (d_fpos64_t.U): This symbol will be defined if the C compiler supports fpos64_t. d_fs_data_s (d_fs_data_s.U): @@ -609,6 +607,15 @@ d_Gconvert (d_gconvert.U): d_Gconvert='gcvt((x),(n),(b))' d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_getcwd (d_getcwd.U): + This variable conditionally defines the HAS_GETCWD symbol, which + indicates to the C program that the getcwd() routine is available + to get the current working directory. + +d_getfsstat (d_getfsstat.U): + This variable conditionally defines the HAS_GETFSSTAT symbol, which + indicates to the C program that the getfsstat() routine is available. + d_getgrent (d_getgrent.U): This variable conditionally defines the HAS_GETGRENT symbol, which indicates to the C program that the getgrent() routine is available @@ -780,6 +787,10 @@ d_htonl (d_htonl.U): This variable conditionally defines HAS_HTONL if htonl() and its friends are available to do network order byte swapping. +d_iconv (d_iconv.U): + This variable conditionally defines the HAS_ICONV symbol, which + indicates to the C program that the iconv() routine is available. + d_index (d_strchr.U): This variable conditionally defines HAS_INDEX if index() and rindex() are available for string searching. @@ -789,7 +800,7 @@ d_inetaton (d_inetaton.U): indicates to the C program that the inet_aton() function is available to parse IP address "dotted-quad" strings. -d_int64t (d_int64t.U): +d_int64_t (d_int64_t.U): This symbol will be defined if the C compiler supports int64_t. d_isascii (d_isascii.U): @@ -831,6 +842,12 @@ d_longlong (d_longlong.U): This variable conditionally defines HAS_LONG_LONG if the long long type is supported. +d_lseekproto (d_lseekproto.U): + This variable conditionally defines the HAS_LSEEK_PROTO symbol, + which indicates to the C program that the system provides + a prototype for the lseek() function. Otherwise, it is + up to the program to supply one. + d_lstat (d_lstat.U): This variable conditionally defines HAS_LSTAT if lstat() is available to do file stats on symbolic links. @@ -880,14 +897,38 @@ d_mkdir (d_mkdir.U): indicates to the C program that the mkdir() routine is available to create directories.. +d_mkdtemp (d_mkdtemp.U): + This variable conditionally defines the HAS_MKDTEMP symbol, which + indicates to the C program that the mkdtemp() routine is available + to exclusively create a uniquely named temporary directory. + d_mkfifo (d_mkfifo.U): This variable conditionally defines the HAS_MKFIFO symbol, which indicates to the C program that the mkfifo() routine is available. +d_mkstemp (d_mkstemp.U): + This variable conditionally defines the HAS_MKSTEMP symbol, which + indicates to the C program that the mkstemp() routine is available + to exclusively create and open a uniquely named temporary file. + +d_mkstemps (d_mkstemps.U): + This variable conditionally defines the HAS_MKSTEMPS symbol, which + indicates to the C program that the mkstemps() routine is available + to exclusively create and open a uniquely named (with a suffix) + temporary file. + d_mktime (d_mktime.U): This variable conditionally defines the HAS_MKTIME symbol, which indicates to the C program that the mktime() routine is available. +d_mmap (d_mmap.U): + This variable conditionally defines HAS_MMAP if mmap() is + available to map a file into memory. + +d_mprotect (d_mprotect.U): + This variable conditionally defines HAS_MPROTECT if mprotect() is + available to modify the access protection of a memory mapped file. + d_msg (d_msg.U): This variable conditionally defines the HAS_MSG symbol, which indicates that the entire msg*(2) library is present. @@ -933,6 +974,14 @@ d_msgsnd (d_msgsnd.U): This variable conditionally defines the HAS_MSGSND symbol, which indicates to the C program that the msgsnd() routine is available. +d_msync (d_msync.U): + This variable conditionally defines HAS_MSYNC if msync() is + available to synchronize a mapped file. + +d_munmap (d_munmap.U): + This variable conditionally defines HAS_MUNMAP if munmap() is + available to unmap a region mapped by mmap(). + d_mymalloc (mallocsrc.U): This variable conditionally defines MYMALLOC in case other parts of the source want to take special action if MYMALLOC is used. @@ -946,7 +995,7 @@ d_nv_preserves_uv (perlxv.U): This variable indicates whether a variable of type nvtype can preserve all the bits a variable of type uvtype. -d_off64_t (io64.U): +d_off64_t (d_off64_t.U): This symbol will be defined if the C compiler supports off64_t. d_old_pthread_create_joinable (d_pthrattrj.U): @@ -1320,6 +1369,9 @@ d_socket (d_socket.U): This variable conditionally defines HAS_SOCKET, which indicates that the BSD socket interface is supported. +d_socklen_t (d_socklen_t.U): + This symbol will be defined if the C compiler supports socklen_t. + d_sockpair (d_socket.U): This variable conditionally defines the HAS_SOCKETPAIR symbol, which indicates that the BSD socketpair() is supported. @@ -1862,6 +1914,10 @@ i_grp (i_grp.U): This variable conditionally defines the I_GRP symbol, and indicates whether a C program should include <grp.h>. +i_iconv (i_iconv.U): + This variable conditionally defines the I_ICONV symbol, and indicates + whether a C program should include <iconv.h>. + i_inttypes (i_inttypes.U): This variable conditionally defines the I_INTTYPES symbol, and indicates whether a C program should include <inttypes.h>. @@ -1998,6 +2054,18 @@ i_sysioctl (i_sysioctl.U): indicates to the C program that <sys/ioctl.h> exists and should be included. +i_syslog (i_syslog.U): + This variable conditionally defines the I_SYSLOG symbol, + and indicates whether a C program should include <syslog.h>. + +i_sysmman (i_sysmman.U): + This variable conditionally defines the I_SYS_MMAN symbol, and + indicates whether a C program should include <sys/mman.h>. + +i_sysmode (i_sysmode.U): + This variable conditionally defines the I_SYSMODE symbol, + and indicates whether a C program should include <sys/mode.h>. + i_sysmount (i_sysmount.U): This variable conditionally defines the I_SYSMOUNT symbol, and indicates whether a C program should include <sys/mount.h>. @@ -2066,6 +2134,10 @@ i_sysun (i_sysun.U): to the C program that it should include <sys/un.h> to get UNIX domain socket definitions. +i_sysutsname (i_sysutsname.U): + This variable conditionally defines the I_SYSUTSNAME symbol, + and indicates whether a C program should include <sys/utsname.h>. + i_sysvfs (i_sysvfs.U): This variable conditionally defines the I_SYSVFS symbol, and indicates whether a C program should include <sys/vfs.h>. @@ -2313,6 +2385,21 @@ libs (libs.U): This variable holds the additional libraries we want to use. It is up to the Makefile to deal with it. +libsdirs (libs.U): + This variable holds the directory names aka dirnames of the libraries + we found and accepted, duplicates are removed. + +libsfiles (libs.U): + This variable holds the filenames aka basenames of the libraries + we found and accepted. + +libsfound (libs.U): + This variable holds the full pathnames of the libraries + we found and accepted. + +libspath (libs.U): + This variable holds the directory names probed for libraries. + libswanted (Myinit.U): This variable holds a list of all the libraries we want to search. The order is chosen to pick up the c library @@ -2478,6 +2565,11 @@ mkdir (Loc.U): full pathname (if any) of the mkdir program. After Configure runs, the value is reset to a plain "mkdir" and is not useful. +mmaptype (d_mmap.U): + This symbol contains the type of pointer returned by mmap() + (and simultaneously the type of the first argument). + It can be 'void *' or 'caddr_t'. + models (models.U): This variable contains the list of memory models supported by this system. Possible component values are none, split, unsplit, small, @@ -2640,16 +2732,20 @@ patchlevel (patchlevel.U): The patchlevel level of this package. The value of patchlevel comes from the patchlevel.h file. In a version number such as 5.6.1, this is the "6". - In patchlevel.h, this is referred to as the "PERL_VERSION". + In patchlevel.h, this is referred to as "PERL_VERSION". path_sep (Unix.U): This is an old synonym for p_ in Head.U, the character used to separate elements in the command shell search PATH. +perl5 (perl5.U): + This variable contains the full path (if any) to a previously + installed perl5.005 or later suitable for running the script + to determine inc_version_list. + perl (Loc.U): - This variable is used internally by Configure to determine the - full pathname (if any) of the perl program. After Configure runs, - the value is reset to a plain "perl" and is not useful. + This variable is defined but not used by Configure. + The value is a plain '' and is not useful. PERL_REVISION (Oldsyms.U): In a Perl version number such as 5.6.2, this is the 5. @@ -2693,6 +2789,21 @@ plibpth (libpth.U): Its value is prepend to libpth. This variable takes care of special machines, like the mips. Usually, it should be empty. +pm_apiversion (xs_apiversion.U): + This variable contains the version of the oldest perl + compatible with the present perl. (That is, pure perl modules + written for $pm_apiversion will still work for the current + version). perl.c:incpush() and lib/lib.pm will automatically + search in $sitelib for older directories across major versions + back to pm_apiversion. This is only useful if you have a perl + library directory tree structured like the default one. The + versioned site_perl library was introduced in 5.005, so that's + the default setting for this variable. It's hard to imagine + it changing before Perl6. It is included here for symmetry + with xs_apiveprsion -- the searching algorithms will + (presumably) be similar. + See the INSTALL file for how this works. + pmake (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. @@ -2762,6 +2873,11 @@ rd_nodata (nblock_io.U): used, which is a shame because you cannot make the difference between no data and an EOF.. Sigh! +revision (patchlevel.U): + The value of revision comes from the patchlevel.h file. + In a version number such as 5.6.1, this is the "5". + In patchlevel.h, this is referred to as "PERL_REVISION". + rm (Loc.U): This variable is used internally by Configure to determine the full pathname (if any) of the rm program. After Configure runs, @@ -2977,6 +3093,11 @@ sockethdr (d_socket.U): socketlib (d_socket.U): This variable has the names of any libraries needed for socket support. +socksizetype (socksizetype.U): + This variable holds the type used for the size argument + for various socket calls like accept. Usual values include + socklen_t, size_t, and int. + sort (Loc.U): This variable is used internally by Configure to determine the full pathname (if any) of the sort program. After Configure runs, @@ -3121,6 +3242,7 @@ subversion (patchlevel.U): The subversion level of this package. The value of subversion comes from the patchlevel.h file. In a version number such as 5.6.1, this is the "1". + In patchlevel.h, this is referred to as "PERL_SUBVERSION". This is unique to perl. sysman (sysman.U): @@ -3236,10 +3358,23 @@ use5005threads (usethreads.U): and indicates that Perl should be built to use the 5.005-based threading implementation. -use64bits (use64bits.U): - This variable conditionally defines the USE_64_BITS symbol, +use64bitall (use64bits.U): + This variable conditionally defines the USE_64_BIT_ALL symbol, and indicates that 64-bit integer types should be used - when available. + when available. The maximal possible + 64-bitness is employed: LP64 or ILP64, meaning that you will + be able to use more than 2 gigabytes of memory. This mode is + even more binary incompatible than USE_64_BIT_INT. You may not + be able to run the resulting executable in a 32-bit CPU at all or + you may need at least to reboot your OS to 64-bit mode. + +use64bitint (use64bits.U): + This variable conditionally defines the USE_64_BIT_INT symbol, + and indicates that 64-bit integer types should be used + when available. The minimal possible 64-bitness + is employed, just enough to get 64-bit integers into Perl. + This may mean using for example "long longs", while your memory + may still be limited to 2 gigabytes. usedl (dlsrc.U): This variable indicates if the system supports dynamic @@ -3253,16 +3388,12 @@ useithreads (usethreads.U): uselargefiles (uselfs.U): This variable conditionally defines the USE_LARGE_FILES symbol, and indicates that large file interfaces should be used when - available. The use64bits symbol will also be turned on if necessary. + available. uselongdouble (uselongdbl.U): This variable conditionally defines the USE_LONG_DOUBLE symbol, and indicates that long doubles should be used when available. -uselonglong (uselonglong.U): - This variable conditionally defines the USE_LONG_LONG symbol, - and indicates that long longs should be used when available. - usemorebits (usemorebits.U): This variable conditionally defines the USE_MORE_BITS symbol, and indicates that explicit 64-bit interfaces and long doubles @@ -3393,7 +3524,7 @@ vendorprefixexp (vendorprefix.U): version (patchlevel.U): The full version number of this package, such as 5.6.1 (or 5_6_1). - This combines baserev, patchlevel, and subversion to get the + This combines revision, patchlevel, and subversion to get the full version number, including any possible subversions. This is suitable for use as a directory name, and hence is filesystem dependent. @@ -3412,6 +3543,23 @@ xlibpth (libpth.U): libraries on this platform, for example CPU-specific libraries (on multi-CPU platforms) may be listed here. +xs_apiversion (xs_apiversion.U): + This variable contains the version of the oldest perl binary + compatible with the present perl. perl.c:incpush() and + lib/lib.pm will automatically search in $sitearch for older + directories across major versions back to xs_apiversion. + This is only useful if you have a perl library directory tree + structured like the default one. + See INSTALL for how this works. + The versioned site_perl directory was introduced in 5.005, + so that is the lowest possible value. + Since this can depend on compile time options (such as + bincompat) it is set by Configure. Other non-default sources + of potential incompatibility, such as multiplicity, threads, + debugging, 64bits, sfio, etc., are not checked for currently, + though in principle we could go snooping around in old + Config.pm files. + zcat (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. diff --git a/Porting/config.sh b/Porting/config.sh index c91d1d16a6..9476ce0684 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Wed Jan 26 09:55:17 EET 2000 +# Configuration time: Sat Feb 26 03:04:10 EET 2000 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -35,8 +35,8 @@ api_subversion='0' api_version='5' api_versionstring='5.005' ar='ar' -archlib='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' -archlibexp='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' +archlib='/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi' +archlibexp='/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi' archname64='' archname='alpha-dec_osf-thread-multi' archobjs='' @@ -54,12 +54,12 @@ castflags='0' cat='cat' cc='cc' cccdlflags=' ' -ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi/CORE' +ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi/CORE' ccflags='-pthread -std -DLANGUAGE_C' -ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1' +ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1 unix=1' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Wed Jan 26 09:55:17 EET 2000' +cf_time='Sat Feb 26 03:04:10 EET 2000' charsize='1' chgrp='' chmod='' @@ -72,13 +72,13 @@ cp='cp' cpio='' cpp='cpp' cpp_stuff='42' -cppccsymbols='LANGUAGE_C=1 unix=1' +cppccsymbols='LANGUAGE_C=1' cppflags='-pthread -std -DLANGUAGE_C' cpplast='' cppminus='' cpprun='/usr/bin/cpp' cppstdin='cppstdin' -cppsymbols='' +cppsymbols='_AES_SOURCE=1 __alpha=1 __ALPHA=1 _ANSI_C_SOURCE=1 __LANGUAGE_C__=1 _LONGLONG=1 __osf__=1 _OSF_SOURCE=1 _POSIX_C_SOURCE=199506 _POSIX_SOURCE=1 _REENTRANT=1 __STDC__=1 _SYSTYPE_BSD=1 __unix__=1 _XOPEN_SOURCE=1' crosscompile='undef' cryptlib='' csh='csh' @@ -158,6 +158,8 @@ d_fstatfs='define' d_fstatvfs='define' d_ftello='undef' d_ftime='undef' +d_getcwd='define' +d_getfsstat='define' d_getgrent='define' d_getgrps='define' d_gethbyaddr='define' @@ -193,9 +195,10 @@ d_gnulibc='undef' d_grpasswd='define' d_hasmntopt='undef' d_htonl='define' +d_iconv='undef' d_index='undef' d_inetaton='define' -d_int64t='undef' +d_int64_t='undef' d_isascii='define' d_killpg='define' d_lchown='define' @@ -205,6 +208,7 @@ d_locconv='define' d_lockf='define' d_longdbl='define' d_longlong='define' +d_lseekproto='define' d_lstat='define' d_mblen='define' d_mbstowcs='define' @@ -215,8 +219,13 @@ d_memcpy='define' d_memmove='define' d_memset='define' d_mkdir='define' +d_mkdtemp='undef' d_mkfifo='define' +d_mkstemp='define' +d_mkstemps='undef' d_mktime='define' +d_mmap='define' +d_mprotect='define' d_msg='define' d_msg_ctrunc='define' d_msg_dontroute='define' @@ -227,6 +236,8 @@ d_msgctl='define' d_msgget='define' d_msgrcv='define' d_msgsnd='define' +d_msync='define' +d_munmap='define' d_mymalloc='undef' d_nice='define' d_nv_preserves_uv='undef' @@ -303,6 +314,7 @@ d_shmget='define' d_sigaction='define' d_sigsetjmp='define' d_socket='define' +d_socklen_t='undef' d_sockpair='define' d_sqrtl='define' d_statblks='define' @@ -368,7 +380,7 @@ dlext='so' dlsrc='dl_dlopen.xs' doublesize='8' drand01='drand48()' -dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' +dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -377,7 +389,7 @@ emacs='' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno' +extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re Errno' fflushNULL='define' fflushall='undef' find='' @@ -423,6 +435,7 @@ i_fcntl='undef' i_float='define' i_gdbm='undef' i_grp='define' +i_iconv='define' i_inttypes='undef' i_limits='define' i_locale='define' @@ -454,6 +467,9 @@ i_sysfile='define' i_sysfilio='undef' i_sysin='undef' i_sysioctl='define' +i_syslog='define' +i_sysmman='define' +i_sysmode='define' i_sysmount='define' i_sysndir='undef' i_sysparam='define' @@ -470,6 +486,7 @@ i_systimes='define' i_systypes='define' i_sysuio='define' i_sysun='define' +i_sysutsname='define' i_sysvfs='undef' i_syswait='define' i_termio='undef' @@ -484,20 +501,20 @@ i_varhdr='stdarg.h' i_vfork='undef' ignore_versioned_solibs='' inc_version_list=' ' -inc_version_list_init='""' +inc_version_list_init='0' incpath='' inews='' -installarchlib='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' +installarchlib='/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.5.640' +installprivlib='/opt/perl/lib/5.5.660' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' +installsitearch='/opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi' installsitebin='/opt/perl/bin' -installsitelib='/opt/perl/lib/site_perl/5.5.640' +installsitelib='/opt/perl/lib/site_perl/5.5.660' installstyle='lib' installusrbinperl='define' installvendorbin='' @@ -506,11 +523,11 @@ intsize='4' ivdformat='"ld"' ivsize='8' ivtype='long' -known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' +known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re' ksh='' large='' ld='ld' -lddlflags='-shared -expect_unresolved "*" -msym -s' +lddlflags='-shared -expect_unresolved "*" -msym -std -s' ldflags='' ldlibpthname='LD_LIBRARY_PATH' less='less' @@ -519,6 +536,10 @@ libc='/usr/shlib/libc.so' libperl='libperl.so' libpth='/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /var/shlib' libs='-lgdbm -ldbm -ldb -lm -lpthread -lexc' +libsdirs=' /usr/shlib /usr/ccs/lib' +libsfiles=' libgdbm.so libdbm.a libdb.so libm.so libpthread.so libexc.so' +libsfound=' /usr/shlib/libgdbm.so /usr/ccs/lib/libdbm.a /usr/shlib/libdb.so /usr/shlib/libm.so /usr/shlib/libpthread.so /usr/shlib/libexc.so' +libspath=' /usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /var/shlib' libswanted='sfio socket inet nsl nm gdbm dbm db malloc dld ld sun m cposix posix ndir dir crypt sec ucb BSD x pthread exc' line='' lint='' @@ -551,6 +572,7 @@ man3ext='3' medium='' mips_type='' mkdir='mkdir' +mmaptype='void *' models='none' modetype='mode_t' more='more' @@ -584,19 +606,21 @@ pager='/c/bin/less' passcat='cat /etc/passwd' patchlevel='5' path_sep=':' -perl='perl' +perl5='/u/vieraat/vieraat/jhi/Perl/bin/perl' +perl='' perladmin='yourname@yourhost.yourplace.com' perlpath='/opt/perl/bin/perl' pg='pg' phostname='' pidtype='pid_t' plibpth='' +pm_apiversion='5.005' pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.5.640' -privlibexp='/opt/perl/lib/5.5.640' +privlib='/opt/perl/lib/5.5.660' +privlibexp='/opt/perl/lib/5.5.660' prototype='define' ptrsize='8' quadkind='2' @@ -606,6 +630,7 @@ randfunc='drand48' randseedtype='long' ranlib=':' rd_nodata='-1' +revision='5' rm='rm' rmail='' runnm='true' @@ -642,12 +667,12 @@ sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE" sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 6 6 16 20 23 23 23 29 48 ' sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' -sitearchexp='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' +sitearch='/opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi' +sitearchexp='/opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' -sitelib='/opt/perl/lib/site_perl/5.5.640' -sitelibexp='/opt/perl/lib/site_perl/5.5.640' +sitelib='/opt/perl/lib/site_perl/5.5.660' +sitelibexp='/opt/perl/lib/site_perl/5.5.660' siteprefix='/opt/perl' siteprefixexp='/opt/perl' sizetype='size_t' @@ -657,6 +682,7 @@ small='' so='so' sockethdr='' socketlib='' +socksizetype='int' sort='sort' spackage='Perl5' spitshell='cat' @@ -675,7 +701,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='_iob' strings='/usr/include/string.h' submit='' -subversion='640' +subversion='660' sysman='/usr/man/man1' tail='' tar='' @@ -704,12 +730,12 @@ uname='uname' uniq='uniq' uquadtype='unsigned long' use5005threads='undef' -use64bits='define' +use64bitall='define' +use64bitint='define' usedl='define' useithreads='define' uselargefiles='define' uselongdouble='undef' -uselonglong='undef' usemorebits='undef' usemultiplicity='define' usemymalloc='n' @@ -736,20 +762,21 @@ vendorlib='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.5.640' +version='5.5.660' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' +xs_apiversion='5.5.660' zcat='' zip='zip' # Configure command line arguments. config_arg0='Configure' -config_args='-Dprefix=/opt/perl -Doptimize=-O -Dusethreads -Duse64bits -Duselfs -Dcf_by=yourname -Dcf_email=yourname@yourhost.yourplace.com -Dperladmin=yourname@yourhost.yourplace.com -Dmydomain=.yourplace.com -Dmyhostname=yourhost -dE' +config_args='-Dprefix=/opt/perl -Doptimize=-O -Dusethreads -Duse64bitint -Duselfs -Dcf_by=yourname -Dcf_email=yourname@yourhost.yourplace.com -Dperladmin=yourname@yourhost.yourplace.com -Dmydomain=.yourplace.com -Dmyhostname=yourhost -dE' config_argc=11 config_arg1='-Dprefix=/opt/perl' config_arg2='-Doptimize=-O' config_arg3='-Dusethreads' -config_arg4='-Duse64bits' +config_arg4='-Duse64bitint' config_arg5='-Duselfs' config_arg6='-Dcf_by=yourname' config_arg7='-Dcf_email=yourname@yourhost.yourplace.com' @@ -759,7 +786,7 @@ config_arg10='-Dmyhostname=yourhost' config_arg11='-dE' PERL_REVISION=5 PERL_VERSION=5 -PERL_SUBVERSION=640 +PERL_SUBVERSION=660 PERL_API_REVISION=5 PERL_API_VERSION=5 PERL_API_SUBVERSION=0 diff --git a/Porting/config_H b/Porting/config_H index 03aafe7f9e..e34e1f38ac 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Wed Jan 26 09:55:17 EET 2000 + * Configuration time: Sat Feb 26 03:04:10 EET 2000 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -362,6 +362,18 @@ */ #define HAS_MKTIME /**/ +/* HAS_MSYNC: + * This symbol, if defined, indicates that the msync system call is + * available to synchronize a mapped file. + */ +#define HAS_MSYNC /**/ + +/* HAS_MUNMAP: + * This symbol, if defined, indicates that the munmap system call is + * available to unmap a region, usually mapped by mmap(). + */ +#define HAS_MUNMAP /**/ + /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -1064,8 +1076,8 @@ /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. The default is eight, - * for safety. + * double, or a long double when applicable. Usual values are 2, + * 4 and 8. The default is eight, for safety. */ #if defined(CROSSCOMPILE) || defined(MULTIARCH) # define MEM_ALIGNBYTES 8 @@ -1086,8 +1098,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB "/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.5.660/alpha-dec_osf-thread-multi" /**/ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -1330,6 +1342,11 @@ */ #define HAS_FD_SET /**/ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_FPOS64_T / **/ + /* HAS_STRUCT_FS_DATA: * This symbol, if defined, indicates that the struct fs_data * to do statfs() is supported. @@ -1347,6 +1364,7 @@ * available to stat filesystems by file descriptors. */ #define HAS_FSTATFS /**/ + /* HAS_FTELLO: * This symbol, if defined, indicates that the ftello routine is * available to ftell beyond 32 bits (useful for ILP32 hosts). @@ -1370,6 +1388,12 @@ */ #define Gconvert(x,n,t,b) gcvt((x),(n),(b)) +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +#define HAS_GETCWD /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1418,7 +1442,7 @@ */ #define HAS_GETHOSTNAME /**/ #define HAS_UNAME /**/ -#undef HAS_PHOSTNAME +/*#define HAS_PHOSTNAME / **/ #ifdef HAS_PHOSTNAME #define PHOSTNAME "" /* How to get the host name */ #endif @@ -1577,6 +1601,19 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ICONV: + * This symbol, if defined, indicates that the iconv routine is + * available to do character set conversions. + */ +/*#define HAS_ICONV / **/ + +/* HAS_INT64_T: + * This symbol will defined if the C compiler supports int64_t. + * Usually the <inttypes.h> needs to be included, but sometimes + * <sys/types.h> is enough. + */ +/*#define HAS_INT64_T / **/ + /* HAS_ISASCII: * This manifest constant lets the C program know that isascii * is available. @@ -1631,12 +1668,55 @@ */ #define HAS_MEMCHR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +/*#define HAS_MKDTEMP / **/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +#define HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to excluslvely create and open a uniquely named + * (with a suffix) temporary file. + */ +/*#define HAS_MKSTEMPS / **/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +#define HAS_MMAP /**/ +#define Mmap_t void * /**/ + +/* HAS_MPROTECT: + * This symbol, if defined, indicates that the mprotect system call is + * available to modify the access protection of a memory mapped file. + */ +#define HAS_MPROTECT /**/ + /* HAS_MSG: * This symbol, if defined, indicates that the entire msg*(2) library is * supported (IPC mechanism based on message queues). */ #define HAS_MSG /**/ +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/*#define HAS_OFF64_T / **/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -2164,6 +2244,12 @@ #define I_GRP /**/ #define GRPASSWD /**/ +/* I_ICONV: + * This symbol, if defined, indicates that <iconv.h> exists and + * should be included. + */ +#define I_ICONV /**/ + /* I_INTTYPES: * This symbol, if defined, indicates to the C program that it should * include <inttypes.h>. @@ -2264,6 +2350,18 @@ */ /*#define I_SOCKS / **/ +/* I_SYSLOG: + * This symbol, if defined, indicates that <syslog.h> exists and + * should be included. + */ +#define I_SYSLOG /**/ + +/* I_SYSMODE: + * This symbol, if defined, indicates that <sys/mode.h> exists and + * should be included. + */ +#define I_SYSMODE /**/ + /* I_SYS_MOUNT: * This symbol, if defined, indicates that <sys/mount.h> exists and * should be included. @@ -2287,6 +2385,12 @@ */ #define I_SYSUIO /**/ +/* I_SYSUTSNAME: + * This symbol, if defined, indicates that <sys/utsname.h> exists and + * should be included. + */ +#define I_SYSUTSNAME /**/ + /* I_SYS_VFS: * This symbol, if defined, indicates that <sys/vfs.h> exists and * should be included. @@ -2322,16 +2426,13 @@ * for a C initialization string. See the inc_version_list entry * in Porting/Glossary for more details. */ -#define PERL_INC_VERSION_LIST "" /**/ +#define PERL_INC_VERSION_LIST 0 /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. - */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. */ -/*#define HAS_OFF64_T / **/ -/*#define HAS_FPOS64_T / **/ +#define INSTALL_USR_BIN_PERL /**/ /* PERL_PRIfldbl: * This symbol, if defined, contains the string used by stdio to @@ -2562,8 +2663,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.5.640" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.5.640" /**/ +#define PRIVLIB "/opt/perl/lib/5.5.660" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.5.660" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2661,8 +2762,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2679,8 +2780,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "/opt/perl/lib/site_perl/5.5.640" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.5.640" /**/ +#define SITELIB "/opt/perl/lib/site_perl/5.5.660" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.5.660" /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2735,19 +2836,35 @@ */ #define Uid_t uid_t /* UID type */ -/* USE_64_BITS: +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -#define USE_64_BITS /**/ +/* USE_64_BIT_ALL: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be used (be they 32 or 64 bits). The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_INT +#define USE_64_BIT_INT /**/ +#endif + +#ifndef USE_64_BIT_ALL +#define USE_64_BIT_ALL /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES #define USE_LARGE_FILES /**/ @@ -2761,14 +2878,6 @@ /*#define USE_LONG_DOUBLE / **/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. - */ -#ifndef USE_LONG_LONG -/*#define USE_LONG_LONG / **/ -#endif - /* USE_MORE_BITS: * This symbol, if defined, indicates that 64-bit interfaces and * long doubles should be used when available. @@ -2781,7 +2890,7 @@ * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ -#ifndef MULTIPLICTY +#ifndef MULTIPLICITY #define MULTIPLICITY /**/ #endif @@ -2852,4 +2961,59 @@ #define M_VOID /* Xenix strikes again */ #endif +/* PERL_XS_APIVERSION: + * This variable contains the version of the oldest perl binary + * compatible with the present perl. perl.c:incpush() and + * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.5.660/alpha-dec_osf-thread-multi for older + * directories across major versions back to xs_apiversion. + * This is only useful if you have a perl library directory tree + * structured like the default one. + * See INSTALL for how this works. + * The versioned site_perl directory was introduced in 5.005, + * so that is the lowest possible value. + * Since this can depend on compile time options (such as + * bincompat) it is set by Configure. Other non-default sources + * of potential incompatibility, such as multiplicity, threads, + * debugging, 64bits, sfio, etc., are not checked for currently, + * though in principle we could go snooping around in old + * Config.pm files. + */ +/* PERL_PM_APIVERSION: + * This variable contains the version of the oldest perl + * compatible with the present perl. (That is, pure perl modules + * written for pm_apiversion will still work for the current + * version). perl.c:incpush() and lib/lib.pm will automatically + * search in /opt/perl/lib/site_perl/5.5.660 for older directories across major versions + * back to pm_apiversion. This is only useful if you have a perl + * library directory tree structured like the default one. The + * versioned site_perl library was introduced in 5.005, so that's + * the default setting for this variable. It's hard to imagine + * it changing before Perl6. It is included here for symmetry + * with xs_apiveprsion -- the searching algorithms will + * (presumably) be similar. + * See the INSTALL file for how this works. + */ +#define PERL_XS_APIVERSION "5.5.660" +#define PERL_PM_APIVERSION "5.005" + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. + */ +#define HAS_GETFSSTAT /**/ + +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); + */ +#define HAS_LSEEK_PROTO /**/ + +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + #endif diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 8e83d74b87..99776b50d2 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -47,63 +47,46 @@ Archives of the list are held at: =head1 How are Perl Releases Numbered? -Perl version numbers are floating point numbers, such as 5.004. -(Observations about the imprecision of floating point numbers for -representing reality probably have more relevance than you might -imagine :-) The major version number is 5 and the '004' is the -patchlevel. (Questions such as whether or not '004' is really a minor -version number can safely be ignored.:) +Beginning with v5.6.0, even versions will stand for maintenance releases +and odd versions for development releases, i.e., v5.6.x for maintenance +releases, and v5.7.x for development releases. Before v5.6.0, subversions +_01 through _49 were reserved for bug-fix maintenance releases, and +subversions _50 through _99 for unstable development versions. -The version number is available as the magic variable $], -and can be used in comparisons, e.g. +For example, in v5.6.1, the revision number is 5, the version is 6, +and 1 is the subversion. - print "You've got an old perl\n" if $] < 5.002; +For compatibility with the older numbering scheme the composite floating +point version number continues to be available as the magic variable $], +and amounts to C<$revision + $version/1000 + $subversion/1000000>. This +can still be used in comparisons. -You can also require particular version (or later) with + print "You've got an old perl\n" if $] < 5.005_03; - use 5.002; +In addition, the version is also available as a string in $^V. -At some point in the future, we may need to decide what to call the -next big revision. In the .package file used by metaconfig to -generate Configure, there are two variables that might be relevant: -$baserev=5.0 and $package=perl5. At various times, I have suggested -we might change them to $baserev=5.1 and $package=perl5.1 if want -to signify a fairly major update. Or, we might want to jump to perl6. -Let's worry about that problem when we get there. - -=head2 Subversions + print "You've got a new perl\n" if $^V and $^V ge v5.6.0; -In addition, there usually are sub-versions available. Sub-versions -are numbered with sub-version numbers. For example, version 5.003_04 -is the 4'th developer version built on top of 5.003. It might include -the _01, _02, and _03 changes, but it also might not. Sub-versions are -allowed to be subversive. (But see the next section for recent -changes.) +You can also require particular version (or later) with: -These sub-versions can also be used as floating point numbers, so -you can do things such as + use 5.006; - print "You've got an unstable perl\n" if $] == 5.00303; +or using the new syntax available only from v5.6 onward: -You can also require particular version (or later) with + use v5.6.0; - use 5.003_03; # the "_" is optional +At some point in the future, we may need to decide what to call the +next big revision. In the .package file used by metaconfig to +generate Configure, there are two variables that might be relevant: +$baserev=5 and $package=perl5. -Sub-versions produced by the members of perl5-porters are usually +Perl releases produced by the members of perl5-porters are usually available on CPAN in the F<src/5.0/maint> and F<src/5.0/devel> directories. =head2 Maintenance and Development Subversions -Starting with version 5.004, subversions _01 through _49 are reserved -for bug-fix maintenance releases, and subversions _50 through _99 for -unstable development versions. - -The separate bug-fix track is being established to allow us an easy -way to distribute important bug fixes without waiting for the -developers to untangle all the other problems in the current -developer's release. The first rule of maintenance work is "First, do -no harm." +The first rule of maintenance work is "First, do no harm." Trial releases of bug-fix maintenance releases are announced on perl5-porters. Trial releases use the new subversion number (to avoid @@ -113,17 +96,12 @@ string C<MAINT_TRIAL> to make clear that the file is not meant for public consumption. In general, the names of official distribution files for the public -always match the regular expression +always match the regular expression: - ^perl5\.\d{3}(_[0-4]\d)?\.tar\.gz$ + ^perl\d+\.(\d+)\.\d+(-MAINT_TRIAL_\d+)\.tar\.gz$ -Developer releases always match - - ^perl5\.\d{3}(_[5-9]\d)?\.tar\.gz$ - -And the trial versions for a new maintainance release match - - ^perl5\.\d{3}(_[0-4]\d)-MAINT_TRIAL_\d+\.tar\.gz$ +C<$1> in the pattern is always an even number for maintenance +versions, and odd for developer releases. In the past it has been observed that pumkings tend to invent new naming conventions on the fly. If you are a pumpking, before you @@ -132,26 +110,6 @@ please inform the guys from the CPAN who are doing indexing and provide the trees of symlinks and the like. They will have to know I<in advance> what you decide. -=head2 Why such a complicated scheme? - -Two reasons, really. At least. - -First, we need some way to identify and release collections of patches -that are known to have new features that need testing and exploration. The -subversion scheme does that nicely while fitting into the -C<use 5.004;> mold. - -Second, since most of the folks who help maintain perl do so on a -free-time voluntary basis, perl development does not proceed at a -precise pace, though it always seems to be moving ahead quickly. -We needed some way to pass around the "patch pumpkin" to allow -different people chances to work on different aspects of the -distribution without getting in each other's way. It wouldn't be -constructive to have multiple people working on incompatible -implementations of the same idea. Instead what was needed was -some kind of "baton" or "token" to pass around so everyone knew -whose turn was next. - =head2 Why is it called the patch pumpkin? Chip Salzenberg gets credit for that, with a nod to his cow orker, @@ -743,6 +701,42 @@ supports dynamic loading, you can also test static loading with You can also hand-tweak your config.h to try out different #ifdef branches. +=head1 Running Purify + +Purify is a commercial tool that is helpful in identifying memory +overruns, wild pointers, memory leaks and other such badness. Perl +must be compiled in a specific way for optimal testing with Purify. + +Use the following commands to test perl with Purify: + + sh Configure -des -Doptimize=-g -Uusemymalloc -Dusemultiplicity \ + -Accflags=-DPURIFY + setenv PURIFYOPTIONS "-chain-length=25" + make all pureperl + cd t + ln -s ../pureperl perl + setenv PERL_DESTRUCT_LEVEL 5 + ./perl TEST + +Disabling Perl's malloc allows Purify to monitor allocations and leaks +more closely; using Perl's malloc will make Purify report most leaks +in the "potential" leaks category. Enabling the multiplicity option +allows perl to clean up thoroughly when the interpreter shuts down, which +reduces the number of bogus leak reports from Purify. The -DPURIFY +enables any Purify-specific debugging code in the sources. + +Purify outputs messages in "Viewer" windows by default. If you don't have +a windowing environment or if you simply want the Purify output to +unobtrusively go to a log file instead of to the interactive window, +use the following options instead: + + setenv PURIFYOPTIONS "-chain-length=25 -windows=no -log-file=perl.log \ + -append-logfile=yes" + +The only currently known leaks happen when there are compile-time errors +within eval or require. (Fixing these is non-trivial, unfortunately, but +they must be fixed eventually.) + =head1 Common Gotcha's =over 4 diff --git a/README.cygwin b/README.cygwin index ab60a58a0a..e8d354f9d1 100644 --- a/README.cygwin +++ b/README.cygwin @@ -134,7 +134,7 @@ binaries to be stripped, you can either add a B<-s> option when Configure prompts you, Any additional ld flags (NOT including libraries)? [none] -s - Any special flags to pass to gcc to use dynamic loading? [none] -s + Any special flags to pass to gcc to use dynamic linking? [none] -s Any special flags to pass to ld2 to create a dynamically loaded library? [none] -s @@ -155,7 +155,7 @@ C<http://cygutils.netpedia.net/>. The crypt libraries in GNU libc have been ported to Cygwin. -The DES based Ultra Fast Crypt port was done by Alexey Truhan +The DES based Ultra Fast Crypt port was done by Alexey Truhan: http://dome.weeg.uiowa.edu/pub/domestic/sos/cw32crypt-dist-0.tgz @@ -183,12 +183,11 @@ F<ext/DB_File/DB_File.pm>. =item * C<-lcygipc> (C<use IPC::SysV>) -A port of SysV IPC is available for Cygwin: +A port of SysV IPC is available for Cygwin. - http://www.multione.capgemini.fr/tools/pack_ipc/ - -The 1.3 release does not include ftok(), but code for ftok() can be -borrowed from glibc. +NOTE: This has B<not> been extensively tested. In particular, +C<d_semctl_semun> is undefined because it fails a configure test and on +Win9x the shm*() functions seem to hang. =back @@ -213,7 +212,7 @@ want to force Perl to build with the system malloc(), you can either choose this when Configure prompts you or you can use the Configure command line option. -=item * C<-Dusemultiplicty> +=item * C<-Dusemultiplicity> Multiplicity is required when embedding Perl in a C program and using more than one interpreter instance. This works with the Cygwin port. @@ -222,17 +221,17 @@ more than one interpreter instance. This works with the Cygwin port. The PerlIO abstraction works with the Cygwin port. -=item * C<-Duse64bits -Duselonglong> +=item * C<-Duse64bits> I<gcc> supports 64-bit integers. However, several additional long long -functions are necessary to use them within Perl (I<{atol,strtoul}l>). +functions are necessary to use them within Perl (I<{strtol,strtoul}l>). These are B<not> yet available with Cygwin. =item * C<-Duselongdouble> I<gcc> supports long doubles (12 bytes). However, several additional long double math functions are necessary to use them within Perl -(I<{sqrt,pow,atan2,exp,fmod,log,cos,frexp,sin,floor,modf,atof}l>). +(I<{atan2,cos,exp,floor,fmod,frexp,log,modf,pow,sin,sqrt}l,strtold>). These are B<not> yet available with Cygwin. =item * C<-Dusethreads> @@ -242,7 +241,7 @@ POSIX threads are B<not> yet implemented in Cygwin. =item * C<-Duselargefiles> Although Win32 supports large files, Cygwin currently uses 32-bit ints -for internal size and positional calculations. +for internal size and position calculations. =back @@ -265,6 +264,21 @@ hint file. You should keep the recommended value. +=item * Win9x and d_eofnblk + +Win9x does not correctly report C<EOF> with a non-blocking read on a +closed pipe. You will see the following messages: + + But it also returns -1 to signal EOF, so be careful! + WARNING: you can't distinguish between EOF and no data! + + *** WHOA THERE!!! *** + The recommended value for $d_eofnblk on this machine was "define"! + Keep the recommended value? [y] + +At least for consistency with WinNT, you should keep the recommended +value. + =item * Checking how std your stdio is... Configure reports: @@ -273,6 +287,8 @@ Configure reports: This is correct. +=back + =head1 MAKE Simply run make and wait: @@ -313,8 +329,8 @@ The same tests are run both times, but more information is provided when running as `C<./perl harness>'. Test results vary depending on your host system and your Cygwin -configuration. It is possible that Cygwin will pass all the tests, but it -is more likely that some tests will fail for one of the the reasons below. +configuration. It is possible that Cygwin will pass all the tests, +but it is more likely that some tests will fail for one of these reasons. =head2 File Permissions @@ -337,7 +353,6 @@ options, these tests will fail: lib/db-hash.t 16 lib/db-recno.t 18 lib/gdbm.t 2 - lib/glob-basic.t 9 (directory always readable) lib/ndbm.t 2 lib/odbm.t 2 lib/sdbm.t 2 @@ -391,7 +406,7 @@ directories (although, this is B<not> recommended). =head2 /etc/group -Cygwin does not need F</etc/group>, in which case the F<op/grent.t> +Cygwin does not require F</etc/group>, in which case the F<op/grent.t> test will be skipped. The check performed by F<op/grent.t> expects to see entries that use the members field, otherwise this test will fail: @@ -401,18 +416,17 @@ see entries that use the members field, otherwise this test will fail: =head2 Unexplained Failures -Any additional tests that fail are likely due to bugs in Cygwin. It is -expected that by the time of the next net release most of these will -be solved so they are not described here. None of the current bugs are -serious enough that workarounds are needed. +Any additional tests that fail are likely due to bugs in Cygwin or the +optional libraries. It is expected that by the time of the next net +release most of these will be solved so they are not described here. =head2 Script Portability -Cygwin does an outstanding job of providing UNIX-like semantics on top -of Win32 systems. However, in addition to the items noted above, there -are some differences that you should know about. This is only a very -brief guide to portability, more information about Cygwin can be found -in the Cygwin documentation. +Cygwin does an outstanding job of providing UNIX-like semantics on +top of Win32 systems. However, in addition to the items noted above, +there are some differences that you should know about. This is only a +very brief guide to portability, more information can be found in the +Cygwin documentation. =over 4 @@ -439,15 +453,17 @@ F<cygwin1.dll> provided by Sergey Okhapkin at: =item * Text/Binary When a file is opened it is in either text or binary mode. In text mode -it is subject to CR/LF/Ctrl-Z translations. Perl provides a binmode() -function to force binary mode on files that otherwise would be treated -as text. With Cygwin, the default mode for an open() is determined by the -mode of the mount that underlies a file. For binmode() to be effective, -the underlying mount must be text. There is no way to force text mode -on a file underneath a binary mount. The text/binary issue is covered -at length in the Cygwin documentation. +a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default +mode for an open() is determined by the mode of the mount that underlies +the file. Perl provides a binmode() function to set binary mode on files +that otherwise would be treated as text. sysopen() with the C<O_TEXT> +flag sets text mode on files that otherwise would be treated as binary: + + sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT) + +lseek(), tell() and sysseek() only work with files opened in binary mode. -lseek() only works with files opened in binary mode. +The text/binary issue is covered at length in the Cygwin documentation. =item * F<.exe> @@ -458,8 +474,8 @@ automatically when building a program. However, when accessing an executable as a normal file (e.g., I<install> or I<cp> in a makefile) the F<.exe> is not transparent. -NOTE: There is a version of I<install> that understands F<.exe>, it can -be found at: +NOTE: There is a version of I<install> that understands the F<.exe> +semantics, it can be found at: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Humblet_Pierre_A/ @@ -474,8 +490,6 @@ although this is appropriate on Win9x since there is no security model. File locking using the C<F_GETLK> command to fcntl() is a stub that returns C<ENOSYS>. -Win32 can not unlink() an open file (but this is emulated by Cygwin). - Win9x can not rename() an open file (although WinNT can). =back @@ -484,7 +498,10 @@ Win9x can not rename() an open file (although WinNT can). This will install Perl, including man pages. - make install 2>&1 | tee log.make-install + make install | tee log.make-install + +NOTE: If C<STDERR> is redirected `C<make install>' will B<not> prompt +you to install I<perl> into F</usr/bin>. You may need to be I<Administrator> to run `C<make install>'. If you are not, you must have write access to the directories in question. @@ -503,10 +520,9 @@ be kept as clean as possible. =item Documentation - INSTALL + INSTALL README.cygwin Changes Changes5.005 Changes5.004 - AUTHORS MAINTAIN MANIFEST - README.cygwin README.win32 + AUTHORS MAINTAIN MANIFEST README.win32 pod/perl.pod pod/perlfaq3.pod pod/perlhist.pod pod/perlmodlib.pod pod/perlport.pod pod/perltoc.pod pod/perl5004delta.pod @@ -519,29 +535,35 @@ be kept as clean as possible. ext/NDBM_File/hints/cygwin.pl ext/ODBM_File/hints/cygwin.pl hints/cygwin.sh - Porting/patchls - cygwin in port list - Makefile.SH - linklibperl, cygwin/Makefile.SHs - makedepend.SH - uwinfix Configure - help finding hints from uname, shared libperl required for dynamic loading + Makefile.SH - linklibperl + Porting/patchls - cygwin in port list installman - man pages with :: translated to . - installperl - install dll, install to pods + installperl - install dll/ld2/perlld, install to pods + makedepend.SH - uwinfix =item Tests t/io/tell.t - binmode - t/op/magic.t - $^X WORKAROUND, s/.exe// - t/op/stat.t - no /dev, no -u (setuid) + t/lib/glob-basic.t - Win32 directory list access differs from read mode + t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// + t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk + (cache manager sometimes preserves ctime of file + previously created and deleted), no -u (setuid) =item Compiled Perl Source - doio.c - win9x can not rename a file when it is open EXTERN.h - __declspec(dllimport) XSUB.h - __declspec(dllexport) + cygwin/cygwin.c - os_extras (getcwd) + perl.c - os_extras perl.h - binmode + doio.c - win9x can not rename a file when it is open + pp_sys.c - do not define h_errno mg.c - environ WORKAROUND - util.c - environ WORKAROUND unixish.h - environ WORKAROUND + util.c - environ WORKAROUND =item Compiled Module Source @@ -553,15 +575,15 @@ be kept as clean as possible. =item Perl Modules/Scripts - lib/perl5db.pl - use stdin not /dev/tty - utils/perlcc.PL - DynaLoader.a in compile, -DUSEIMPORTLIB - utils/perldoc.PL - version comment - lib/File/Spec/Unix.pm - preserve //unc + lib/Cwd.pm - hook to internal Cwd::cwd lib/ExtUtils/MakeMaker.pm - require MM_Cygwin.pm lib/ExtUtils/MM_Cygwin.pm - canonpath, cflags, manifypods, perl_archive - lib/Cwd.pm - `pwd` + lib/File/Spec/Unix.pm - preserve //unc + lib/perl5db.pl - use stdin not /dev/tty + utils/perlcc.PL - DynaLoader.a in compile, -DUSEIMPORTLIB + utils/perldoc.PL - version comment =back @@ -587,4 +609,4 @@ Teun Burgers E<lt>burgers@ecn.nlE<gt>. =head1 HISTORY -Last updated: 28 January 2000 +Last updated: 25 February 2000 diff --git a/README.epoc b/README.epoc index 2ff36fd8f9..b4bcca60e4 100644 --- a/README.epoc +++ b/README.epoc @@ -4,7 +4,7 @@ Perl 5 README file for the EPOC operating system. Olaf Flebbe <o.flebbe@gmx.de> http://www.linuxstart.com/~oflebbe/perl/perl5.html -2000-01-08 +2000-02-20 ===================================================================== Introduction @@ -13,9 +13,9 @@ Introduction EPOC is a OS for palmtops and mobile phones. For more informations look at: http://www.symbian.com/ -This is a port of Perl version 5.005_63 to EPOC. It runs on the Perl -Series 5, Series 5mx. I have no reports about the Psion Revo, the -Ericcson (??) and the Psion NetBook. I only have acess to an Series 5. +This is a port of Perl version 5.5.650 to EPOC. It runs on the Perl +Series 5, Series 5mx and the Psion Revo. I have no reports for other +EPOC devices. Features are left out, because of restrictions of the POSIX support. @@ -105,8 +105,6 @@ The following things are left out of this perl port: directory very well (i.e. not at all, but it tries hard to emulate one) See PATH. -+ sockets seems to work now! - + You need the shell eshell.exe in order to run perl.exe and supply it with arguments. @@ -132,15 +130,13 @@ Sorry, this is far too short. Unpack the sources. - Build a native miniperl... + Build a native perl from this sources... cp epoc/* . - for i in *.SH ; do - sh $i - done + ./Configure -S make perl cp miniperl.native miniperl make perl - perl linkit perlmain.o lib/auto/DynaLoader/DynaLoader.a \ + perl link.pl perlmain.o lib/auto/DynaLoader/DynaLoader.a \ lib/auto/Data/Dumper.a \ lib/auto/File/Glob/Glob.a lib/auto/IO/IO.a \ lib/auto/Socket/Socket.a perl.a `cat ext.libs` @@ -149,10 +145,9 @@ Sorry, this is far too short. ==================================================================== -TODO +Wish List ==================================================================== -- Get the HTTPD::* working (Hey, It worked the first time for me!) - Threads ? - Acess to the GUI? diff --git a/README.threads b/README.threads index 1f5f7ea070..15d36de644 100644 --- a/README.threads +++ b/README.threads @@ -51,7 +51,7 @@ from the "Problems" section. * OpenBSD - * NeXTstep, OpenStep (Rhapsody?) + * NeXTstep, OpenStep * OS/2 diff --git a/README.vms b/README.vms index d9ea97ea52..e58e6ddfd7 100644 --- a/README.vms +++ b/README.vms @@ -1,110 +1,169 @@ -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" @@ -113,152 +172,230 @@ symbols are: 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 ! @@ -273,23 +410,7 @@ You'll need CMKRNL priv to install the new dcltables.exe. $ 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 @@ -298,53 +419,23 @@ and that is a reasonably large amount of IO to load each time perl is 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 @@ -352,94 +443,173 @@ the process of creating a bug report. This script includes details of your 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 + diff --git a/README.win32 b/README.win32 index 6889ab7c59..5499d3a4f4 100644 --- a/README.win32 +++ b/README.win32 @@ -121,9 +121,9 @@ GCC-2.95.2 binaries can be downloaded from: The GCC-2.95.2 bundle comes with Mingw32 libraries and headers. -Make sure you install the binaries as indicated in the README for -the GCC bundle. You may need to set up a few environment variables -(usually run from a batch file). +Make sure you install the binaries that work with MSVCRT.DLL as indicated +in the README for the GCC bundle. You may need to set up a few environment +variables (usually run from a batch file). You also need dmake. See L</"Borland C++"> above on how to get it. @@ -1,6 +1,9 @@ +Bugs + fix small memory leaks on compile-time failures + Unicode support finish byte <-> utf8 and localencoding <-> utf8 conversions - make "$bytestr$charstr" do the right conversion + make substr($bytestr,0,0, $charstr) do the right conversion add Unicode::Map equivivalent to core add support for I/O disciplines - open(F, "<!crlf!utf16", $file) @@ -11,6 +14,7 @@ Unicode support support C<print v1.2.3> make C<v123> mean C<chr(123)> (if !exists(&v123)) autoload utf8_heavy.pl's swash routines in swash_init() + check uv_to_utf8() calls for buffer overflow Multi-threading support "use Thread;" under useithreads @@ -64,7 +68,6 @@ Win32 stuff work out DLL versioning Miscellaneous - magic_setisa should be made to update %FIELDS [???] add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) replace pod2html with new PodtoHtml? (requires other modules from CPAN) automate testing with large parts of CPAN @@ -104,7 +104,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) IV itmp; #endif -#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) +#if defined(MYMALLOC) && !defined(LEAKTEST) newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; if (key <= newmax) diff --git a/bytecode.pl b/bytecode.pl index 00df48b957..0ffe8e4443 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -47,7 +47,7 @@ package B::Asmdata; use Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); -use vars qw(%insn_data @insn_name @optype @specialsv_name); +our(%insn_data, @insn_name, @optype, @specialsv_name); EOT print ASMDATA_PM <<"EOT"; diff --git a/config_h.SH b/config_h.SH index 8dfb5db1ec..ad136f26db 100644 --- a/config_h.SH +++ b/config_h.SH @@ -376,6 +376,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_mktime HAS_MKTIME /**/ +/* HAS_MSYNC: + * This symbol, if defined, indicates that the msync system call is + * available to synchronize a mapped file. + */ +#$d_msync HAS_MSYNC /**/ + +/* HAS_MUNMAP: + * This symbol, if defined, indicates that the munmap system call is + * available to unmap a region, usually mapped by mmap(). + */ +#$d_munmap HAS_MUNMAP /**/ + /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -1078,8 +1090,8 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. The default is eight, - * for safety. + * double, or a long double when applicable. Usual values are 2, + * 4 and 8. The default is eight, for safety. */ #if defined(CROSSCOMPILE) || defined(MULTIARCH) # define MEM_ALIGNBYTES 8 @@ -1344,6 +1356,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_fd_set HAS_FD_SET /**/ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +#$d_fpos64_t HAS_FPOS64_T /**/ + /* HAS_STRUCT_FS_DATA: * This symbol, if defined, indicates that the struct fs_data * to do statfs() is supported. @@ -1361,6 +1378,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * available to stat filesystems by file descriptors. */ #$d_fstatfs HAS_FSTATFS /**/ + /* HAS_FTELLO: * This symbol, if defined, indicates that the ftello routine is * available to ftell beyond 32 bits (useful for ILP32 hosts). @@ -1384,6 +1402,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Gconvert(x,n,t,b) $d_Gconvert +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +#$d_getcwd HAS_GETCWD /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1597,6 +1621,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_iconv HAS_ICONV /**/ +/* HAS_INT64_T: + * This symbol will defined if the C compiler supports int64_t. + * Usually the <inttypes.h> needs to be included, but sometimes + * <sys/types.h> is enough. + */ +#$d_int64_t HAS_INT64_T /**/ + /* HAS_ISASCII: * This manifest constant lets the C program know that isascii * is available. @@ -1651,12 +1682,55 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_memchr HAS_MEMCHR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +#$d_mkdtemp HAS_MKDTEMP /**/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +#$d_mkstemp HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to excluslvely create and open a uniquely named + * (with a suffix) temporary file. + */ +#$d_mkstemps HAS_MKSTEMPS /**/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +#$d_mmap HAS_MMAP /**/ +#define Mmap_t $mmaptype /**/ + +/* HAS_MPROTECT: + * This symbol, if defined, indicates that the mprotect system call is + * available to modify the access protection of a memory mapped file. + */ +#$d_mprotect HAS_MPROTECT /**/ + /* HAS_MSG: * This symbol, if defined, indicates that the entire msg*(2) library is * supported (IPC mechanism based on message queues). */ #$d_msg HAS_MSG /**/ +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +#$d_off64_t HAS_OFF64_T /**/ + /* HAS_OPEN3: * This manifest constant lets the C program know that the three * argument form of open(2) is available. @@ -2290,6 +2364,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_socks I_SOCKS /**/ +/* I_SYSLOG: + * This symbol, if defined, indicates that <syslog.h> exists and + * should be included. + */ +#$i_syslog I_SYSLOG /**/ + +/* I_SYSMODE: + * This symbol, if defined, indicates that <sys/mode.h> exists and + * should be included. + */ +#$i_sysmode I_SYSMODE /**/ + /* I_SYS_MOUNT: * This symbol, if defined, indicates that <sys/mount.h> exists and * should be included. @@ -2313,6 +2399,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_sysuio I_SYSUIO /**/ +/* I_SYSUTSNAME: + * This symbol, if defined, indicates that <sys/utsname.h> exists and + * should be included. + */ +#$i_sysutsname I_SYSUTSNAME /**/ + /* I_SYS_VFS: * This symbol, if defined, indicates that <sys/vfs.h> exists and * should be included. @@ -2350,14 +2442,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define PERL_INC_VERSION_LIST $inc_version_list_init /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. - */ -#$d_off64_t HAS_OFF64_T /**/ -#$d_fpos64_t HAS_FPOS64_T /**/ +#$installusrbinperl INSTALL_USR_BIN_PERL /**/ /* PERL_PRIfldbl: * This symbol, if defined, contains the string used by stdio to @@ -2761,19 +2850,35 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Uid_t $uidtype /* UID type */ -/* USE_64_BITS: +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -#$use64bits USE_64_BITS /**/ +/* USE_64_BIT_ALL: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be used (be they 32 or 64 bits). The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_INT +#$use64bitint USE_64_BIT_INT /**/ +#endif + +#ifndef USE_64_BIT_ALL +#$use64bitall USE_64_BIT_ALL /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES #$uselargefiles USE_LARGE_FILES /**/ @@ -2787,14 +2892,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$uselongdouble USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. - */ -#ifndef USE_LONG_LONG -#$uselonglong USE_LONG_LONG /**/ -#endif - /* USE_MORE_BITS: * This symbol, if defined, indicates that 64-bit interfaces and * long doubles should be used when available. @@ -2878,5 +2975,60 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define M_VOID /* Xenix strikes again */ #endif +/* PERL_XS_APIVERSION: + * This variable contains the version of the oldest perl binary + * compatible with the present perl. perl.c:incpush() and + * lib/lib.pm will automatically search in $sitearch for older + * directories across major versions back to xs_apiversion. + * This is only useful if you have a perl library directory tree + * structured like the default one. + * See INSTALL for how this works. + * The versioned site_perl directory was introduced in 5.005, + * so that is the lowest possible value. + * Since this can depend on compile time options (such as + * bincompat) it is set by Configure. Other non-default sources + * of potential incompatibility, such as multiplicity, threads, + * debugging, 64bits, sfio, etc., are not checked for currently, + * though in principle we could go snooping around in old + * Config.pm files. + */ +/* PERL_PM_APIVERSION: + * This variable contains the version of the oldest perl + * compatible with the present perl. (That is, pure perl modules + * written for pm_apiversion will still work for the current + * version). perl.c:incpush() and lib/lib.pm will automatically + * search in $sitelib for older directories across major versions + * back to pm_apiversion. This is only useful if you have a perl + * library directory tree structured like the default one. The + * versioned site_perl library was introduced in 5.005, so that's + * the default setting for this variable. It's hard to imagine + * it changing before Perl6. It is included here for symmetry + * with xs_apiveprsion -- the searching algorithms will + * (presumably) be similar. + * See the INSTALL file for how this works. + */ +#define PERL_XS_APIVERSION "$xs_apiversion" +#define PERL_PM_APIVERSION "$pm_apiversion" + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. + */ +#$d_getfsstat HAS_GETFSSTAT /**/ + +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); + */ +#$d_lseekproto HAS_LSEEK_PROTO /**/ + +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t $socksizetype /**/ + #endif !GROK!THIS! @@ -17,7 +17,7 @@ my $glossary = $ARGV[1] || 'Porting/Glossary'; open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n"; -$myver = $]; +$myver = sprintf "v%vd", $^V; print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG"; package Config; @@ -38,8 +38,9 @@ sub import { } ENDOFBEG_NOQ -\$] == $myver - or die "Perl lib version ($myver) doesn't match executable version (\$])"; +\$^V eq $myver + or die "Perl lib version ($myver) doesn't match executable version (" . + (sprintf "v%vd",\$^V) . ")"; # This file was created by configpm when Perl was built. Any changes # made to this file will be lost the next time perl is built. diff --git a/configure.com b/configure.com index 27253b398d..af423858d4 100644 --- a/configure.com +++ b/configure.com @@ -41,13 +41,14 @@ $ ans = "" $ macros = "" $ use_vmsdebug_perl = "N" $ use_debugging_perl = "Y" -$ use_64bit = "n" +$ use_64bitint = "n" $ C_Compiler_Replace = "CC=" $ Thread_Live_Dangerously = "MT=" $ use_two_pot_malloc = "N" $ use_pack_malloc = "N" $ use_debugmalloc = "N" $ d_secintgenv = "N" +$ cc_flags = "" $ use_multiplicity = "N" $ vms_default_directory_name = F$ENVIRONMENT("DEFAULT") $ max_allowed_dir_depth = 3 ! e.g. [A.B.PERL5_00n] not [A.B.C.PERL5_00n] @@ -1152,12 +1153,12 @@ $ WRITE CONFIG " exit(0);" $ WRITE CONFIG "}" $ CLOSE CONFIG $! -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: +$! DEFINE SYS$ERROR _NLA0: +$! DEFINE SYS$OUTPUT _NLA0: $ cc/NoObj/list=ccvms.lis ccvms.c $ tmp = $status -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR +$! DEASSIGN SYS$OUTPUT +$! DEASSIGN SYS$ERROR $ IF (silent) THEN GOSUB Shut_up $! echo "%Config-I-VMS, After cc compile $status = >''tmp'<" !diagnostic $! @@ -1199,7 +1200,7 @@ $ echo "%Config-I-VMS, You also have: ''line' ''archsufx' ''F$GETSYI("VERSIO $ vms_cc_available = vms_cc_available + "cc/decc " $ ENDIF $ ELSE -$ IF F$LOCATE("DEC",line).NE.F$LENGTH(line) +$ IF (F$LOCATE("DEC",line).NE.F$LENGTH(line)).or.(F$LOCATE("Compaq",line).NE.F$LENGTH(line)) $ THEN $ vms_cc_dflt = "/decc" $ vms_cc_available = vms_cc_available + "cc/decc " @@ -1269,7 +1270,7 @@ $ IF ans.NES."" $ THEN $ ans = F$EDIT(ans,"TRIM, COMPRESS, LOWERCASE") $ Mcc = ans -$ IF F$LOCATE("dec",ans).NE.F$LENGTH(ans) +$ IF (F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans)) $ THEN $ Mcc = "cc/decc" $ Using_Dec_C = "Yes" @@ -1283,7 +1284,7 @@ $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ IF Mcc.NES.dflt $ THEN -$ IF F$LOCATE("dec",dflt).NE.F$LENGTH(dflt) +$ IF (F$LOCATE("dec",dflt).NE.F$LENGTH(dflt)).or(F$LOCATE("compaq",dflt).NE.F$LENGTH(dflt)) $ THEN $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ELSE @@ -1367,6 +1368,8 @@ $ CLOSE CONFIG $! DELETE/NOLOG/NOCONFIRM deccvers.*; $ echo "You are using Dec C ''line'" $ Dec_C_Version = line +$ Dec_C_Version = Dec_C_Version + 0 +$ if Dec_C_Version.ge.60200000 THEN CC_FLAGS = CC_FLAGS + "/NOANSI_ALIAS" $ ENDIF $Vaxc_Invoke_check: $ IF "''Using_Vax_C'".EQS."Yes" @@ -1743,15 +1746,15 @@ $ echo "64 bit integers and 128 bit floating point variables. This gives $ echo "a much larger range for perl's mathematical operations. (Note that $ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't $ echo "do that yet)" -$ dflt = use_64bit -$ rp = "Build with 64 bits? [''dflt'] " +$ dflt = use_64bitint +$ rp = "Build with 64 bit integers and 128 bit floating point variable? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans = dflt $ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") $ THEN -$ use_64bit="Y" +$ use_64bitint="Y" $ ELSE -$ use_64bit="N" +$ use_64bitint="N" $ ENDIF $ ENDIF $! @@ -1895,6 +1898,7 @@ $ rp = "[''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans = "''dflt'" $ extensions = "''ans'" +$ perl_known_extensions = "''dflt'" $! $! %Config-I-VMS, determine build/make utility here (make gmake mmk mms) $ echo "" @@ -149,23 +149,28 @@ struct block_sub { struct block_eval { I32 old_in_eval; I32 old_op_type; - char * old_name; + SV * old_namesv; OP * old_eval_root; SV * cur_text; }; #define PUSHEVAL(cx,n,fgv) \ + STMT_START { \ cx->blk_eval.old_in_eval = PL_in_eval; \ cx->blk_eval.old_op_type = PL_op->op_type; \ - cx->blk_eval.old_name = (n ? savepv(n) : Nullch); \ + cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \ cx->blk_eval.old_eval_root = PL_eval_root; \ - cx->blk_eval.cur_text = PL_linestr; + cx->blk_eval.cur_text = PL_linestr; \ + } STMT_END #define POPEVAL(cx) \ + STMT_START { \ PL_in_eval = cx->blk_eval.old_in_eval; \ optype = cx->blk_eval.old_op_type; \ PL_eval_root = cx->blk_eval.old_eval_root; \ - Safefree(cx->blk_eval.old_name); + if (cx->blk_eval.old_namesv) \ + sv_2mortal(cx->blk_eval.old_namesv); \ + } STMT_END /* loop context */ struct block_loop { diff --git a/cygwin/Makefile.SHs b/cygwin/Makefile.SHs index 8d777788ba..df15826f64 100644 --- a/cygwin/Makefile.SHs +++ b/cygwin/Makefile.SHs @@ -25,6 +25,9 @@ esac addtopath=`pwd` $spitshell >>Makefile <<!GROK!THIS! +cygwin.c: cygwin/cygwin.c + \$(LNS) cygwin/cygwin.c + # shell script feeding perlld to decent perl ld2: $& Makefile perlld ${src}/cygwin/ld2.in @echo "extracting ld2 (with variable substitutions)" diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c new file mode 100644 index 0000000000..bece81b1e4 --- /dev/null +++ b/cygwin/cygwin.c @@ -0,0 +1,37 @@ +/* + * Cygwin extras + */ + +#include "EXTERN.h" +#include "perl.h" +#undef USE_DYNAMIC_LOADING +#include "XSUB.h" + +#include <unistd.h> + + +/* see also Cwd.pm */ +static +XS(Cygwin_cwd) +{ + dXSARGS; + char *cwd; + + if(items != 0) + Perl_croak(aTHX_ "Usage: Cwd::cwd()"); + if(cwd = getcwd(NULL, 0)) { + ST(0) = sv_2mortal(newSVpv(cwd, 0)); + safesysfree(cwd); + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +void +init_os_extras(void) +{ + char *file = __FILE__; + dTHX; + + newXS("Cwd::cwd", Cygwin_cwd, file); +} diff --git a/djgpp/config.over b/djgpp/config.over index f47e7fca91..1f567b4174 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -29,6 +29,7 @@ repair() -e 's/byteload/ByteLoader/'\ -e 's=devel/peek=Devel/Peek='\ -e 's=devel/dprof=Devel/DProf='\ + -e 's=sys/sys=Sys/Sys='\ -e 's=file/=='\ -e 's=File/=='\ -e 's=glob=='\ diff --git a/djgpp/configure.bat b/djgpp/configure.bat index e7d41d7130..370f5ed048 100644 --- a/djgpp/configure.bat +++ b/djgpp/configure.bat @@ -33,5 +33,5 @@ echo Running sed... sh djgpp/djgppsed.sh echo Running Configure... -sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9 +sh Configure -DPERL_EXTERNAL_GLOB %1 %2 %3 %4 %5 %6 %7 %8 %9 :end diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh index b62acfd6e9..bb95ad8538 100644 --- a/djgpp/djgppsed.sh +++ b/djgpp/djgppsed.sh @@ -24,6 +24,7 @@ SDBHASH='s=dbhash\.tmp=dbhash_tmp=g' SSTAT='s=\.\(stat\.\)=_\1=g' STMP2='s=tmp2=tm2=g' SPACKLIST='s=\.\(packlist\)=_\1=g' +SDOTTMP='s=\.tmp=_tmp=g' sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH @@ -33,7 +34,7 @@ sed -e $SEXISTS -e $SPACKLIST installperl >s; mv -f s installperl sed -e $SPOD2HTML lib/Pod/Html.pm |tr -d '\r' >s; mv -f s lib/Pod/Html.pm sed -e $SCC -e $SLIST -e $SFILEC -e $SCOR -e $SDEPTMP -e $SHSED makedepend.SH |tr -d '\r' >s; mv -f s makedepend.SH sed -e $SCPP t/comp/cpp.aux |tr -d '\r' >s; mv -f s t/comp/cpp.aux -sed -e $SARGV t/io/argv.t >s; mv -f s t/io/argv.t +sed -e $SARGV -e $SDOTTMP t/io/argv.t >s; mv -f s t/io/argv.t sed -e $SABC t/io/inplace.t >s; mv -f s t/io/inplace.t sed -e $SDBMX t/lib/anydbm.t >s; mv -f s t/lib/anydbm.t sed -e $SDBMX -e $SDBHASH t/lib/gdbm.t >s; mv -f s t/lib/gdbm.t @@ -41,12 +41,6 @@ # endif #endif -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif #ifdef O_EXCL # define OPEN_EXCL O_EXCL #else @@ -77,15 +71,6 @@ # endif #endif -/* Put this after #includes because <unistd.h> defines _XOPEN_*. */ -#ifndef Sock_size_t -# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) -# define Sock_size_t Size_t -# else -# define Sock_size_t int -# endif -#endif - bool Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) @@ -282,7 +282,7 @@ S_do_trans_CU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; I32 bits = 16; s = (U8*)SvPV(sv, len); @@ -956,6 +956,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) sv_setpvn(astr, s, 1); *s = '\0'; SvCUR_set(sv, len); + SvUTF8_off(sv); SvNIOK_off(sv); } else @@ -533,8 +533,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) #endif break; case OP_CONST: - Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv)); - break; case OP_METHOD_NAMED: Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv)); break; @@ -46,7 +46,6 @@ #if !defined(PERL_IMPLICIT_CONTEXT) #if defined(PERL_IMPLICIT_SYS) -#else #endif #if defined(USE_ITHREADS) # if defined(PERL_IMPLICIT_SYS) @@ -687,6 +686,7 @@ #define sv_usepvn Perl_sv_usepvn #define sv_vcatpvfn Perl_sv_vcatpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn +#define str_to_version Perl_str_to_version #define swash_init Perl_swash_init #define swash_fetch Perl_swash_fetch #define taint_env Perl_taint_env @@ -730,6 +730,7 @@ #define yywarn Perl_yywarn #if defined(MYMALLOC) #define dump_mstats Perl_dump_mstats +#define get_mstats Perl_get_mstats #endif #define safesysmalloc Perl_safesysmalloc #define safesyscalloc Perl_safesyscalloc @@ -773,8 +774,10 @@ #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 @@ -782,6 +785,10 @@ #define sv_pv Perl_sv_pv #define sv_pvutf8 Perl_sv_pvutf8 #define sv_pvbyte Perl_sv_pvbyte +#define sv_utf8_upgrade Perl_sv_utf8_upgrade +#define sv_utf8_downgrade Perl_sv_utf8_downgrade +#define sv_utf8_encode Perl_sv_utf8_encode +#define sv_utf8_decode Perl_sv_utf8_decode #define sv_force_normal Perl_sv_force_normal #define tmps_grow Perl_tmps_grow #define sv_rvweaken Perl_sv_rvweaken @@ -897,8 +904,13 @@ #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 @@ -914,6 +926,9 @@ #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 @@ -1033,12 +1048,6 @@ #define sv_unglob S_sv_unglob #define not_a_number S_not_a_number #define visit S_visit -# if defined(PURIFY) -#define reg_add S_reg_add -#define reg_remove S_reg_remove -# else -#define my_safemalloc S_my_safemalloc -# endif #define sv_add_backref S_sv_add_backref #define sv_del_backref S_sv_del_backref # if defined(DEBUGGING) @@ -1486,7 +1495,6 @@ #else /* PERL_IMPLICIT_CONTEXT */ #if defined(PERL_IMPLICIT_SYS) -#else #endif #if defined(USE_ITHREADS) # if defined(PERL_IMPLICIT_SYS) @@ -2106,6 +2114,7 @@ #define sv_usepvn(a,b,c) Perl_sv_usepvn(aTHX_ a,b,c) #define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g) #define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g) +#define str_to_version(a) Perl_str_to_version(aTHX_ a) #define swash_init(a,b,c,d,e) Perl_swash_init(aTHX_ a,b,c,d,e) #define swash_fetch(a,b) Perl_swash_fetch(aTHX_ a,b) #define taint_env() Perl_taint_env(aTHX) @@ -2147,6 +2156,7 @@ #define yywarn(a) Perl_yywarn(aTHX_ a) #if defined(MYMALLOC) #define dump_mstats(a) Perl_dump_mstats(aTHX_ a) +#define get_mstats(a,b,c) Perl_get_mstats(aTHX_ a,b,c) #endif #define safesysmalloc Perl_safesysmalloc #define safesyscalloc Perl_safesyscalloc @@ -2187,7 +2197,9 @@ #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) @@ -2195,6 +2207,10 @@ #define sv_pv(a) Perl_sv_pv(aTHX_ a) #define sv_pvutf8(a) Perl_sv_pvutf8(aTHX_ a) #define sv_pvbyte(a) Perl_sv_pvbyte(aTHX_ a) +#define sv_utf8_upgrade(a) Perl_sv_utf8_upgrade(aTHX_ a) +#define sv_utf8_downgrade(a,b) Perl_sv_utf8_downgrade(aTHX_ a,b) +#define sv_utf8_encode(a) Perl_sv_utf8_encode(aTHX_ a) +#define sv_utf8_decode(a) Perl_sv_utf8_decode(aTHX_ a) #define sv_force_normal(a) Perl_sv_force_normal(aTHX_ a) #define tmps_grow(a) Perl_tmps_grow(aTHX_ a) #define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a) @@ -2307,11 +2323,16 @@ # 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 @@ -2326,7 +2347,10 @@ #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) @@ -2445,12 +2469,6 @@ #define sv_unglob(a) S_sv_unglob(aTHX_ a) #define not_a_number(a) S_not_a_number(aTHX_ a) #define visit(a) S_visit(aTHX_ a) -# if defined(PURIFY) -#define reg_add(a) S_reg_add(aTHX_ a) -#define reg_remove(a) S_reg_remove(aTHX_ a) -# else -#define my_safemalloc S_my_safemalloc -# endif #define sv_add_backref(a,b) S_sv_add_backref(aTHX_ a,b) #define sv_del_backref(a) S_sv_del_backref(aTHX_ a) # if defined(DEBUGGING) @@ -2899,7 +2917,6 @@ #else /* PERL_OBJECT */ #if defined(PERL_IMPLICIT_SYS) -#else #endif #if defined(USE_ITHREADS) # if defined(PERL_IMPLICIT_SYS) @@ -4130,6 +4147,8 @@ #define sv_vcatpvfn Perl_sv_vcatpvfn #define Perl_sv_vsetpvfn CPerlObj::Perl_sv_vsetpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn +#define Perl_str_to_version CPerlObj::Perl_str_to_version +#define str_to_version Perl_str_to_version #define Perl_swash_init CPerlObj::Perl_swash_init #define swash_init Perl_swash_init #define Perl_swash_fetch CPerlObj::Perl_swash_fetch @@ -4208,6 +4227,8 @@ #if defined(MYMALLOC) #define Perl_dump_mstats CPerlObj::Perl_dump_mstats #define dump_mstats Perl_dump_mstats +#define Perl_get_mstats CPerlObj::Perl_get_mstats +#define get_mstats Perl_get_mstats #endif #define Perl_safesysmalloc CPerlObj::Perl_safesysmalloc #define safesysmalloc Perl_safesysmalloc @@ -4289,10 +4310,12 @@ #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 @@ -4307,6 +4330,14 @@ #define sv_pvutf8 Perl_sv_pvutf8 #define Perl_sv_pvbyte CPerlObj::Perl_sv_pvbyte #define sv_pvbyte Perl_sv_pvbyte +#define Perl_sv_utf8_upgrade CPerlObj::Perl_sv_utf8_upgrade +#define sv_utf8_upgrade Perl_sv_utf8_upgrade +#define Perl_sv_utf8_downgrade CPerlObj::Perl_sv_utf8_downgrade +#define sv_utf8_downgrade Perl_sv_utf8_downgrade +#define Perl_sv_utf8_encode CPerlObj::Perl_sv_utf8_encode +#define sv_utf8_encode Perl_sv_utf8_encode +#define Perl_sv_utf8_decode CPerlObj::Perl_sv_utf8_decode +#define sv_utf8_decode Perl_sv_utf8_decode #define Perl_sv_force_normal CPerlObj::Perl_sv_force_normal #define sv_force_normal Perl_sv_force_normal #define Perl_tmps_grow CPerlObj::Perl_tmps_grow @@ -4513,10 +4544,18 @@ #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 @@ -4541,6 +4580,10 @@ #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 @@ -4763,15 +4806,6 @@ #define not_a_number S_not_a_number #define S_visit CPerlObj::S_visit #define visit S_visit -# if defined(PURIFY) -#define S_reg_add CPerlObj::S_reg_add -#define reg_add S_reg_add -#define S_reg_remove CPerlObj::S_reg_remove -#define reg_remove S_reg_remove -# else -#define S_my_safemalloc CPerlObj::S_my_safemalloc -#define my_safemalloc S_my_safemalloc -# endif #define S_sv_add_backref CPerlObj::S_sv_add_backref #define sv_add_backref S_sv_add_backref #define S_sv_del_backref CPerlObj::S_sv_del_backref @@ -1293,9 +1293,8 @@ Ajno |PerlInterpreter* |perl_alloc_using \ |struct IPerlStdIO* io|struct IPerlLIO* lio \ |struct IPerlDir* d|struct IPerlSock* s \ |struct IPerlProc* p -#else -Ajnod |PerlInterpreter* |perl_alloc #endif +Ajnod |PerlInterpreter* |perl_alloc Ajnod |void |perl_construct |PerlInterpreter* interp Ajnod |void |perl_destruct |PerlInterpreter* interp Ajnod |void |perl_free |PerlInterpreter* interp @@ -2005,6 +2004,7 @@ Apd |void |sv_vcatpvfn |SV* sv|const char* pat|STRLEN patlen \ Apd |void |sv_vsetpvfn |SV* sv|const char* pat|STRLEN patlen \ |va_list* args|SV** svargs|I32 svmax \ |bool *maybe_tainted +Ap |NV |str_to_version |SV *sv Ap |SV* |swash_init |char* pkg|char* name|SV* listsv \ |I32 minbits|I32 none Ap |UV |swash_fetch |SV *sv|U8 *ptr @@ -2049,6 +2049,7 @@ p |int |yyparse p |int |yywarn |char* s #if defined(MYMALLOC) Ap |void |dump_mstats |char* s +Ap |int |get_mstats |perl_mstats_t *buf|int buflen|int level #endif Anp |Malloc_t|safesysmalloc |MEM_SIZE nbytes Anp |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size @@ -2096,10 +2097,12 @@ Ap |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm 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 @@ -2107,6 +2110,10 @@ Ap |char* |sv_2pvbyte_nolen|SV* sv Ap |char* |sv_pv |SV *sv Ap |char* |sv_pvutf8 |SV *sv Ap |char* |sv_pvbyte |SV *sv +Ap |void |sv_utf8_upgrade|SV *sv +Ap |bool |sv_utf8_downgrade|SV *sv|bool fail_ok +Ap |void |sv_utf8_encode |SV *sv +Ap |bool |sv_utf8_decode |SV *sv Ap |void |sv_force_normal|SV *sv Ap |void |tmps_grow |I32 n Ap |SV* |sv_rvweaken |SV *sv @@ -2232,11 +2239,16 @@ s |void |validate_suid |char *|char*|int # 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 @@ -2253,7 +2265,10 @@ s |int |div128 |SV *pnum|bool *done #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 @@ -2385,12 +2400,6 @@ s |void |del_xrv |XRV* p s |void |sv_unglob |SV* sv s |void |not_a_number |SV *sv s |void |visit |SVFUNC_t f -# if defined(PURIFY) -s |void |reg_add |SV *sv -s |void |reg_remove |SV *sv -# else -ns |void* |my_safemalloc |MEM_SIZE size -# endif s |void |sv_add_backref |SV *tsv|SV *sv s |void |sv_del_backref |SV *sv # if defined(DEBUGGING) diff --git a/epoc/config.sh b/epoc/config.sh index 55ca6bd51c..0d6017f906 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -34,8 +34,8 @@ apirevision='' apisubversion='' apiversion='' ar='arm-pe-ar' -archlib='/perl/lib/5.5.640/epoc' -archlibexp='/perl/lib/5.5.640/epoc' +archlib='/perl/lib/5.5.670/epoc' +archlibexp='/perl/lib/5.5.670/epoc' archname64='' archname='epoc' archobjs='epoc.o epocish.o epoc_stubs.o' @@ -156,6 +156,7 @@ d_fstatfs='define' d_fstatvfs='undef' d_ftello='undef' d_ftime='undef' +d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -204,6 +205,7 @@ d_locconv='undef' d_lockf='undef' d_longdbl='undef' d_longlong='define' +d_lseekproto='define' d_lstat='undef' d_madvise='undef' d_mblen='undef' @@ -575,8 +577,8 @@ pmake='' pr='' prefix='' prefixexp='' -privlib='/perl/lib/5.5.640' -privlibexp='/perl/lib/5.5.640' +privlib='/perl/lib/5.5.670' +privlibexp='/perl/lib/5.5.670' prototype='define' ptrsize='4' randbits='31' @@ -620,10 +622,10 @@ sig_name_init='"ZERO", 0' sig_num='0' sig_num_init='0, 0' signal_t='void' -sitearch='/perl/lib/site_perl/5.5.640/epoc' -sitearchexp='/perl/lib/site_perl/5.5.640/epoc' -sitelib='/perl/lib/site_perl/5.5.640/' -sitelibexp='/perl/lib/site_perl/5.5.640/' +sitearch='/perl/lib/site_perl/5.5.670/epoc' +sitearchexp='/perl/lib/site_perl/5.5.670/epoc' +sitelib='/perl/lib/site_perl/5.5.670/' +sitelibexp='/perl/lib/site_perl/5.5.670/' siteprefix='' siteprefixexp='' sizetype='size_t' @@ -631,6 +633,7 @@ sleep='' smail='' small='' so='' +socksizetype='int' sockethdr='' socketlib='' sort='sort' @@ -668,7 +671,8 @@ uidsign='1' uidtype='uid_t' uname='uname' uniq='uniq' -use64bits='undef' +use64bitall='undef' +use64bitint='undef' usedl='undef' uselargefiles='undef' uselongdouble='undef' @@ -691,7 +695,7 @@ vendorlib='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.5.640' +version='5.5.670' vi='' voidflags='15' xlibpth='' @@ -714,10 +718,10 @@ config_arg10='' config_arg11='' PERL_REVISION=5 PERL_VERSION=5 -PERL_SUBVERSION=640 +PERL_SUBVERSION=670 PERL_API_REVISION=5 PERL_API_VERSION=5 -PERL_API_SUBVERSION=640 +PERL_API_SUBVERSION=670 CONFIGDOTSH=true # Variables propagated from previous config.sh file. pp_sys_cflags='' @@ -758,7 +762,21 @@ d_ustat='undef' i_sysstatfs='undef' i_sysvfs='undef' i_ustat='undef' -uselonglong='define' uidsize='2' gidsize='2' - +ivdformat='"ld"' +uvuformat='"lu"' +uvoformat='"lo"' +uvxformat='"lx"' +uidformat='"hu"' +gidformat='"hu"' +d_strtold='undef' +d_strtoll='undef' +d_strtouq='undef' +d_nv_preserves_uv='define' +use5005threads='undef' +useithreads='undef' +d_iconv='undef' +i_iconv='undef' +inc_version_list=' ' +inc_version_list_init='0' diff --git a/epoc/createpkg.pl b/epoc/createpkg.pl index 7270504974..6977bd385f 100644 --- a/epoc/createpkg.pl +++ b/epoc/createpkg.pl @@ -3,17 +3,17 @@ use File::Find; use Cwd; -$VERSION="5.005"; -$PATCH=63; -$EPOC_VERSION=16; +$VERSION="5.5"; +$PATCH="650"; +$EPOC_VERSION=19; $CROSSCOMPILEPATH=cwd; -$CROSSREPLACEPATH="H:\\devel\\perl5.005_63"; +$CROSSREPLACEPATH="H:\\devel\\perl5.5.650"; sub filefound { my $f = $File::Find::name; - return if ( $f =~ /unicode|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$/i); + return if ( $f =~ /CVS|unicode|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$/i); my $back = $f; $back =~ s|$CROSSCOMPILEPATH||; @@ -22,7 +22,7 @@ sub filefound { my $psiback = $back; - $psiback =~ s/\\lib\\/\\perl\\lib\\$VERSION$PATCH\\/i; + $psiback =~ s/\\lib\\/\\perl\\lib\\$VERSION.$PATCH\\/i; print OUT "\"$CROSSREPLACEPATH$back\"-\"!:$psiback\"\n" if ( -f $f ); ; @@ -35,6 +35,6 @@ print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; print OUT "\"$CROSSREPLACEPATH\\perlmain.exe\"-\"!:\\perl.exe\"\n"; find(\&filefound, cwd.'/lib'); -print OUT "@\"G:\\lib\\stdlib.sis\",(0x010002c3)\n" +print OUT "@\"G:\\lib\\stdlib.sis\",(0x0100002c3)\n" diff --git a/ext/B/B.pm b/ext/B/B.pm index 8c46479c75..4512d916e6 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -420,6 +420,10 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>). =over 4 +=item is_empty + +This method returns TRUE if the GP field of the GV is NULL. + =item NAME =item STASH @@ -572,8 +576,8 @@ This returns the op name as a string (e.g. "add", "rv2av"). =item ppaddr -This returns the function name as a string (e.g. Perl_pp_add, -Perl_pp_rv2av). +This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]", +"PL_ppaddr[OP_RV2AV]"). =item desc diff --git a/ext/B/B.xs b/ext/B/B.xs index 260c0c7b41..9e2985582a 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -95,6 +95,11 @@ cc_opclass(pTHX_ OP *o) if (o->op_type == OP_SASSIGN) return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP); +#ifdef USE_ITHREADS + if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST) + return OPc_PADOP; +#endif + switch (PL_opargs[o->op_type] & OA_CLASS_MASK) { case OA_BASEOP: return OPc_BASEOP; @@ -158,8 +163,11 @@ cc_opclass(pTHX_ OP *o) * an SVOP (and op_sv is the GV for the filehandle argument). */ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP : +#ifdef USE_ITHREADS + (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP); +#else (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP); - +#endif case OA_LOOPEXOP: /* * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a @@ -566,10 +574,16 @@ OP_name(o) char * OP_ppaddr(o) B::OP o + PREINIT: + int i; + SV *sv = sv_newmortal(); CODE: - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), "Perl_pp_", 8); - sv_catpv(ST(0), PL_op_name[o->op_type]); + sv_setpvn(sv, "PL_ppaddr[OP_", 13); + sv_catpv(sv, PL_op_name[o->op_type]); + for (i=13; i<SvCUR(sv); ++i) + SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]); + sv_catpv(sv, "]"); + ST(0) = sv; char * OP_desc(o) @@ -679,8 +693,8 @@ PMOP_precomp(o) if (rx) sv_setpvn(ST(0), rx->precomp, rx->prelen); -#define SVOP_sv(o) cSVOPx_sv(o) -#define SVOP_gv(o) cGVOPx_gv(o) +#define SVOP_sv(o) cSVOPo->op_sv +#define SVOP_gv(o) ((GV*)cSVOPo->op_sv) MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_ @@ -992,6 +1006,14 @@ GvNAME(gv) CODE: ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv))); +bool +is_empty(gv) + B::GV gv + CODE: + RETVAL = GvGP(gv) == Null(GP*); + OUTPUT: + RETVAL + B::HV GvSTASH(gv) B::GV gv diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index fa1053f1e1..dafef33bb1 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -57,8 +57,6 @@ use FileHandle; use Carp; use strict; use Config; -my $handle_VC_problem = ""; -$handle_VC_problem="{0}," if $^O eq 'MSWin32' and $Config{cc} =~ /^cl/i; my $hv_index = 0; my $gv_index = 0; @@ -75,6 +73,7 @@ my %unused_sub_packages; my $nullop_count; my $pv_copy_on_grow = 0; my ($debug_cops, $debug_av, $debug_cv, $debug_mg); +my $max_string_len; my @threadsv_names; BEGIN { @@ -165,10 +164,12 @@ sub B::OP::save { $init->add(sprintf("(void)find_threadsv(%s);", cstring($threadsv_names[$op->targ]))); } - $opsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x", - ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, + $opsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x", + ${$op->next}, ${$op->sibling}, $op->targ, $type, $op_seq, $op->flags, $op->private)); - savesym($op, sprintf("&op_list[%d]", $opsect->index)); + my $ix = $opsect->index; + $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "&op_list[$ix]"); } sub B::FAKEOP::new { @@ -178,10 +179,12 @@ sub B::FAKEOP::new { sub B::FAKEOP::save { my ($op, $level) = @_; - $opsect->add(sprintf("%s, %s, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x", - $op->next, $op->sibling, $op->ppaddr, $op->targ, + $opsect->add(sprintf("%s, %s, NULL, %u, %u, %u, 0x%x, 0x%x", + $op->next, $op->sibling, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); - return sprintf("&op_list[%d]", $opsect->index); + my $ix = $opsect->index; + $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + return "&op_list[$ix]"; } sub B::FAKEOP::next { $_[0]->{"next"} || 0 } @@ -196,45 +199,53 @@ sub B::UNOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $unopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $unopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first})); - savesym($op, sprintf("(OP*)&unop_list[%d]", $unopsect->index)); + my $ix = $unopsect->index; + $init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&unop_list[$ix]"); } sub B::BINOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $binopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $binopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last})); - savesym($op, sprintf("(OP*)&binop_list[%d]", $binopsect->index)); + my $ix = $binopsect->index; + $init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&binop_list[$ix]"); } sub B::LISTOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $listopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, $op->children)); - savesym($op, sprintf("(OP*)&listop_list[%d]", $listopsect->index)); + my $ix = $listopsect->index; + $init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&listop_list[$ix]"); } sub B::LOGOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $logopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $logopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->other})); - savesym($op, sprintf("(OP*)&logop_list[%d]", $logopsect->index)); + my $ix = $logopsect->index; + $init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&logop_list[$ix]"); } sub B::LOOP::save { @@ -244,24 +255,28 @@ sub B::LOOP::save { #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n", # peekop($op->redoop), peekop($op->nextop), # peekop($op->lastop)); # debug - $loopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, $op->children, ${$op->redoop}, ${$op->nextop}, ${$op->lastop})); - savesym($op, sprintf("(OP*)&loop_list[%d]", $loopsect->index)); + my $ix = $loopsect->index; + $init->add(sprintf("loop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&loop_list[$ix]"); } sub B::PVOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, $handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $pvopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, %s", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, cstring($op->pv))); - savesym($op, sprintf("(OP*)&pvop_list[%d]", $pvopsect->index)); + my $ix = $pvopsect->index; + $init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + savesym($op, "(OP*)&pvop_list[$ix]"); } sub B::SVOP::save { @@ -269,25 +284,28 @@ sub B::SVOP::save { my $sym = objsym($op); return $sym if defined $sym; my $svsym = $op->sv->save; - $svopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullsv", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $svopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, Nullsv", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); - $init->add(sprintf("svop_list[%d].op_sv = %s;", $svopsect->index, "(SV*)$svsym")); - savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index)); + my $ix = $svopsect->index; + $init->add(sprintf("svop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + $init->add("svop_list[$ix].op_sv = (SV*)$svsym;"); + savesym($op, "(OP*)&svop_list[$ix]"); } sub B::PADOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $padopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $padopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, 0", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); - $init->add(sprintf("padop_list[%d].op_padix = %ld;", - $padopsect->index, $op->padix)); - savesym($op, sprintf("(OP*)&padop_list[%d]", $padopsect->index)); + $init->add(sprintf("padop_list[%d].op_ppaddr = %s;", $padopsect->index, $op->ppaddr)); + my $ix = $padopsect->index; + $init->add(sprintf("padop_list[$ix].op_padix = %ld;", $op->padix)); + savesym($op, "(OP*)&padop_list[$ix]"); } sub B::COP::save { @@ -296,15 +314,16 @@ sub B::COP::save { return $sym if defined $sym; warn sprintf("COP: line %d file %s\n", $op->line, $op->file) if $debug_cops; - $copsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u", - ${$op->next}, ${$op->sibling}, $op->ppaddr, + $copsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, cstring($op->label), $op->cop_seq, $op->arybase, $op->line)); - my $copix = $copsect->index; - $init->add(sprintf("CopFILE_set(&cop_list[%d], %s);", $copix, cstring($op->file)), - sprintf("CopSTASHPV_set(&cop_list[%d], %s);", $copix, cstring($op->stashpv))); - savesym($op, "(OP*)&cop_list[$copix]"); + my $ix = $copsect->index; + $init->add(sprintf("cop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); + $init->add(sprintf("CopFILE_set(&cop_list[$ix], %s);", cstring($op->file)), + sprintf("CopSTASHPV_set(&cop_list[$ix], %s);", cstring($op->stashpv))); + savesym($op, "(OP*)&cop_list[$ix]"); } sub B::PMOP::save { @@ -332,13 +351,14 @@ sub B::PMOP::save { # pmnext handling is broken in perl itself, I think. Bad op_pmnext # fields aren't noticed in perl's runtime (unless you try reset) but we # segfault when trying to dereference it to find op->op_pmnext->op_type - $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x", - ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ, + $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x", + ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, $op->children, $replrootfield, $replstartfield, $op->pmflags, $op->pmpermflags,)); my $pm = sprintf("pmop_list[%d]", $pmopsect->index); + $init->add(sprintf("$pm.op_ppaddr = %s;", $ppaddr)); my $re = $op->precomp; if (defined($re)) { my $resym = sprintf("re%d", $re_index++); @@ -349,7 +369,7 @@ sub B::PMOP::save { if ($gvsym) { $init->add("$pm.op_pmreplroot = (OP*)$gvsym;"); } - savesym($op, sprintf("(OP*)&pmop_list[%d]", $pmopsect->index)); + savesym($op, "(OP*)&$pm"); } sub B::SPECIAL::save { @@ -371,9 +391,10 @@ sub B::NULL::save { return $sym if defined $sym; # warn "Saving SVt_NULL SV\n"; # debug # debug - #if ($$sv == 0) { - # warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n"; - #} + if ($$sv == 0) { + warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n"; + return savesym($sv, "Nullsv /* XXX */"); + } $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS)); return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); } @@ -400,6 +421,27 @@ sub B::NV::save { return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); } +sub savepvn { + my ($dest,$pv) = @_; + my @res; + if (defined $max_string_len && length($pv) > $max_string_len) { + push @res, sprintf("New(0,%s,%u,char);", $dest, length($pv)+1); + my $offset = 0; + while (length $pv) { + my $str = substr $pv, 0, $max_string_len, ''; + push @res, sprintf("Copy(%s,$dest+$offset,%u,char);", + cstring($str), length($str)); + $offset += length $str; + } + push @res, sprintf("%s[%u] = '\\0';", $dest, $offset); + } + else { + push @res, sprintf("%s = savepvn(%s, %u);", $dest, + cstring($pv), length($pv)); + } + return @res; +} + sub B::PVLV::save { my ($sv) = @_; my $sym = objsym($sv); @@ -414,8 +456,8 @@ sub B::PVLV::save { $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x", $xpvlvsect->index, $sv->REFCNT , $sv->FLAGS)); if (!$pv_copy_on_grow) { - $init->add(sprintf("xpvlv_list[%d].xpv_pv = savepvn(%s, %u);", - $xpvlvsect->index, cstring($pv), $len)); + $init->add(savepvn(sprintf("xpvlv_list[%d].xpv_pv", + $xpvlvsect->index), $pv)); } $sv->save_magic; return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); @@ -432,8 +474,8 @@ sub B::PVIV::save { $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x", $xpvivsect->index, $sv->REFCNT , $sv->FLAGS)); if (!$pv_copy_on_grow) { - $init->add(sprintf("xpviv_list[%d].xpv_pv = savepvn(%s, %u);", - $xpvivsect->index, cstring($pv), $len)); + $init->add(savepvn(sprintf("xpviv_list[%d].xpv_pv", + $xpvivsect->index), $pv)); } return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); } @@ -453,8 +495,8 @@ sub B::PVNV::save { $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x", $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS)); if (!$pv_copy_on_grow) { - $init->add(sprintf("xpvnv_list[%d].xpv_pv = savepvn(%s,%u);", - $xpvnvsect->index, cstring($pv), $len)); + $init->add(savepvn(sprintf("xpvnv_list[%d].xpv_pv", + $xpvnvsect->index), $pv)); } return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); } @@ -471,8 +513,8 @@ sub B::BM::save { $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x", $xpvbmsect->index, $sv->REFCNT , $sv->FLAGS)); $sv->save_magic; - $init->add(sprintf("xpvbm_list[%d].xpv_pv = savepvn(%s, %u);", - $xpvbmsect->index, cstring($pv), $len), + $init->add(savepvn(sprintf("xpvbm_list[%d].xpv_pv", + $xpvbmsect->index), $pv), sprintf("xpvbm_list[%d].xpv_cur = %u;", $xpvbmsect->index, $len - 257)); return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); @@ -489,8 +531,8 @@ sub B::PV::save { $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x", $xpvsect->index, $sv->REFCNT , $sv->FLAGS)); if (!$pv_copy_on_grow) { - $init->add(sprintf("xpv_list[%d].xpv_pv = savepvn(%s, %u);", - $xpvsect->index, cstring($pv), $len)); + $init->add(savepvn(sprintf("xpv_list[%d].xpv_pv", + $xpvsect->index), $pv)); } return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); } @@ -507,8 +549,8 @@ sub B::PVMG::save { $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x", $xpvmgsect->index, $sv->REFCNT , $sv->FLAGS)); if (!$pv_copy_on_grow) { - $init->add(sprintf("xpvmg_list[%d].xpv_pv = savepvn(%s, %u);", - $xpvmgsect->index, cstring($pv), $len)); + $init->add(savepvn(sprintf("xpvmg_list[%d].xpv_pv", + $xpvmgsect->index), $pv)); } $sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); $sv->save_magic; @@ -723,24 +765,31 @@ sub B::GV::save { $sym = savesym($gv, "gv_list[$ix]"); #warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug } + my $is_empty = $gv->is_empty; my $gvname = $gv->NAME; my $name = cstring($gv->STASH->NAME . "::" . $gvname); #warn "GV name is $name\n"; # debug - my $egv = $gv->EGV; my $egvsym; - if ($$gv != $$egv) { - #warn(sprintf("EGV name is %s, saving it now\n", - # $egv->STASH->NAME . "::" . $egv->NAME)); # debug - $egvsym = $egv->save; + unless ($is_empty) { + my $egv = $gv->EGV; + if ($$gv != $$egv) { + #warn(sprintf("EGV name is %s, saving it now\n", + # $egv->STASH->NAME . "::" . $egv->NAME)); # debug + $egvsym = $egv->save; + } } $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);], sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS), - sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS), - sprintf("GvLINE($sym) = %u;", $gv->LINE)); + sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS)); + $init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty; + # Shouldn't need to do save_magic since gv_fetchpv handles that #$gv->save_magic; my $refcnt = $gv->REFCNT + 1; $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1; + + return $sym if $is_empty; + my $gvrefcnt = $gv->GvREFCNT; if ($gvrefcnt > 1) { $init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1)); @@ -1041,6 +1090,7 @@ sub output_boilerplate { print <<'EOT'; #include "EXTERN.h" #include "perl.h" +#include "XSUB.h" /* Workaround for mapstart: the only op which needs a different ppaddr */ #undef Perl_pp_mapstart @@ -1461,6 +1511,8 @@ sub compile { # Optimisations for -O1 $pv_copy_on_grow = 1; } + } elsif ($opt eq "l") { + $max_string_len = $arg; } } init_sections(); @@ -1576,6 +1628,13 @@ No copy-on-grow. Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>. Currently, B<-O1> and higher set B<-fcog>. +=item B<-llimit> + +Some C compilers impose an arbitrary limit on the length of string +constants (e.g. 2048 characters for Microsoft Visual C++). The +B<-llimit> options tells the C backend not to generate string literals +exceeding that limit. + =back =head1 EXAMPLES @@ -1587,7 +1646,7 @@ Note that C<cc_harness> lives in the C<B> subdirectory of your perl library directory. The utility called C<perlcc> may also be used to help make use of this compiler. - perl -MO=C,-v,-DcA bar.pl > /dev/null + perl -MO=C,-v,-DcA,-l2048 bar.pl > /dev/null =head1 BUGS diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index cf0e81f92e..c5ca2a3df5 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -6,6 +6,7 @@ # License or the Artistic License, as specified in the README file. # package B::CC; +use Config; use strict; use B qw(main_start main_root class comppadlist peekop svref_2object timing_info init_av sv_undef amagic_generation @@ -223,7 +224,8 @@ sub save_or_restore_lexical_state { next unless ref($lex); ${$lexstate{$bblock}}{$lex->{iv}} = $lex->{flags} ; } - }else{ + } + else { foreach my $lex (@pad) { next unless ref($lex); my $old_flags=${$lexstate{$bblock}}{$lex->{iv}} ; @@ -586,9 +588,16 @@ sub pp_padsv { sub pp_const { my $op = shift; my $sv = $op->sv; - my $obj = $constobj{$$sv}; - if (!defined($obj)) { - $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv); + my $obj; + # constant could be in the pad (under useithreads) + if ($$sv) { + $obj = $constobj{$$sv}; + if (!defined($obj)) { + $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv); + } + } + else { + $obj = $pad[$op->targ]; } push(@stack, $obj); return $op->next; @@ -656,10 +665,17 @@ sub pp_sort { write_back_stack(); doop($op); return $op->next; -} +} + sub pp_gv { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } write_back_stack(); runtime("XPUSHs((SV*)$gvsym);"); return $op->next; @@ -667,7 +683,13 @@ sub pp_gv { sub pp_gvsv { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } write_back_stack(); if ($op->private & OPpLVAL_INTRO) { runtime("XPUSHs(save_scalar($gvsym));"); @@ -679,7 +701,13 @@ sub pp_gvsv { sub pp_aelemfast { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } my $ix = $op->private; my $flag = $op->flags & OPf_MOD; write_back_stack(); diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index f8bcc7c8df..cd53c112d8 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -8,6 +8,7 @@ package B::Deparse; use Carp 'cluck', 'croak'; +use Config; use B qw(class main_root main_start main_cv svref_2object opnumber OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL @@ -251,18 +252,19 @@ sub walk_sub { walk_tree($op, sub { my $op = shift; if ($op->name eq "gv") { + my $gv = $self->maybe_padgv($op); if ($op->next->name eq "entersub") { - next if $self->{'subs_done'}{$ {$op->gv}}++; - next if class($op->gv->CV) eq "SPECIAL"; - $self->todo($op->gv, $op->gv->CV, 0); - $self->walk_sub($op->gv->CV); + next if $self->{'subs_done'}{$$gv}++; + next if class($gv->CV) eq "SPECIAL"; + $self->todo($gv, $gv->CV, 0); + $self->walk_sub($gv->CV); } elsif ($op->next->name eq "enterwrite" or ($op->next->name eq "rv2gv" and $op->next->next->name eq "enterwrite")) { - next if $self->{'forms_done'}{$ {$op->gv}}++; - next if class($op->gv->FORM) eq "SPECIAL"; - $self->todo($op->gv, $op->gv->FORM, 1); - $self->walk_sub($op->gv->FORM); + next if $self->{'forms_done'}{$$gv}++; + next if class($gv->FORM) eq "SPECIAL"; + $self->todo($gv, $gv->FORM, 1); + $self->walk_sub($gv->FORM); } } }); @@ -455,7 +457,7 @@ sub deparse_format { $op = $op->sibling; # skip nextstate my @exprs; $kid = $op->first->sibling; # skip pushmark - push @text, $kid->sv->PV; + push @text, $self->const_sv($kid)->PV; $kid = $kid->sibling; for (; not null $kid; $kid = $kid->sibling) { push @exprs, $self->deparse($kid, 0); @@ -984,7 +986,7 @@ sub pp_require { if (class($op) eq "UNOP" and $op->first->name eq "const" and $op->first->private & OPpCONST_BARE) { - my $name = $op->first->sv->PV; + my $name = $self->const_sv($op->first)->PV; $name =~ s[/][::]g; $name =~ s/\.pm//g; return "require($name)"; @@ -1008,6 +1010,7 @@ sub pp_scalar { sub padval { my $self = shift; my $targ = shift; + #cluck "curcv was undef" unless $self->{curcv}; return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ]; } @@ -1537,7 +1540,7 @@ sub pp_truncate { my $fh; if ($op->flags & OPf_SPECIAL) { # $kid is an OP_CONST - $fh = $kid->sv->PV; + $fh = $self->const_sv($kid)->PV; } else { $fh = $self->deparse($kid, 6); $fh = "+$fh" if not $parens and substr($fh, 0, 1) eq "("; @@ -1876,22 +1879,37 @@ sub pp_threadsv { return $self->maybe_local($op, $cx, "\$" . $threadsv_names[$op->targ]); } +sub maybe_padgv { + my $self = shift; + my $op = shift; + my $gv; + if ($Config{useithreads}) { + $gv = $self->padval($op->padix); + } + else { + $gv = $op->gv; + } + return $gv; +} + sub pp_gvsv { my $self = shift; my($op, $cx) = @_; - return $self->maybe_local($op, $cx, "\$" . $self->gv_name($op->gv)); + my $gv = $self->maybe_padgv($op); + return $self->maybe_local($op, $cx, "\$" . $self->gv_name($gv)); } sub pp_gv { my $self = shift; my($op, $cx) = @_; - return $self->gv_name($op->gv); + my $gv = $self->maybe_padgv($op); + return $self->gv_name($gv); } sub pp_aelemfast { my $self = shift; my($op, $cx) = @_; - my $gv = $op->gv; + my $gv = $self->maybe_padgv($op); return "\$" . $self->gv_name($gv) . "[" . $op->private . "]"; } @@ -1927,7 +1945,7 @@ sub pp_rv2av { my($op, $cx) = @_; my $kid = $op->first; if ($kid->name eq "const") { # constant list - my $av = $kid->sv; + my $av = $self->const_sv($kid); return "(" . join(", ", map(const($_), $av->ARRAY)) . ")"; } else { return $self->maybe_local($op, $cx, $self->rv2x($op, $cx, "\@")); @@ -2083,13 +2101,13 @@ sub method { } $obj = $self->deparse($obj, 24); if ($meth->name eq "method_named") { - $meth = $meth->sv->PV; + $meth = $self->const_sv($meth)->PV; } else { $meth = $meth->first; if ($meth->name eq "const") { # As of 5.005_58, this case is probably obsoleted by the # method_named case above - $meth = $meth->sv->PV; # needs to be bare + $meth = $self->const_sv($meth)->PV; # needs to be bare } else { $meth = $self->deparse($meth, 1); } @@ -2202,7 +2220,7 @@ sub pp_entersub { $amper = "&"; $kid = "{" . $self->deparse($kid, 0) . "}"; } elsif ($kid->first->name eq "gv") { - my $gv = $kid->first->gv; + my $gv = $self->maybe_padgv($kid->first); if (class($gv->CV) ne "SPECIAL") { $proto = $gv->CV->PV if $gv->CV->FLAGS & SVf_POK; } @@ -2347,13 +2365,23 @@ sub const { } } +sub const_sv { + my $self = shift; + my $op = shift; + my $sv = $op->sv; + # the constant could be in the pad (under useithreads) + $sv = $self->padval($op->targ) unless $$sv; + return $sv; +} + sub pp_const { my $self = shift; my($op, $cx) = @_; # if ($op->private & OPpCONST_BARE) { # trouble with `=>' autoquoting -# return $op->sv->PV; +# return $self->const_sv($op)->PV; # } - return const($op->sv); + my $sv = $self->const_sv($op); + return const($sv); } sub dq { @@ -2361,7 +2389,7 @@ sub dq { my $op = shift; my $type = $op->name; if ($type eq "const") { - return uninterp(escape_str(unback($op->sv->PV))); + return uninterp(escape_str(unback($self->const_sv($op)->PV))); } elsif ($type eq "concat") { return $self->dq($op->first) . $self->dq($op->last); } elsif ($type eq "uc") { @@ -2650,7 +2678,7 @@ sub re_dq { my $op = shift; my $type = $op->name; if ($type eq "const") { - return uninterp($op->sv->PV); + return uninterp($self->const_sv($op)->PV); } elsif ($type eq "concat") { return $self->re_dq($op->first) . $self->re_dq($op->last); } elsif ($type eq "uc") { diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index 53b655c82e..0a5ceabda1 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -85,6 +85,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk. =cut use strict; +use Config; use B qw(peekop class comppadlist main_start svref_2object walksymtable OPpLVAL_INTRO SVf_POK ); @@ -133,10 +134,10 @@ sub process { sub load_pad { my $padlist = shift; - my ($namelistav, @namelist, $ix); + my ($namelistav, $vallistav, @namelist, $ix); @pad = (); return if class($padlist) eq "SPECIAL"; - ($namelistav) = $padlist->ARRAY; + ($namelistav,$vallistav) = $padlist->ARRAY; @namelist = $namelistav->ARRAY; for ($ix = 1; $ix < @namelist; $ix++) { my $namesv = $namelist[$ix]; @@ -144,6 +145,17 @@ sub load_pad { my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/; $pad[$ix] = ["(lexical)", $type, $name]; } + if ($Config{useithreads}) { + my (@vallist); + @vallist = $vallistav->ARRAY; + for ($ix = 1; $ix < @vallist; $ix++) { + my $valsv = $vallist[$ix]; + next unless class($valsv) eq "GV"; + # these pad GVs don't have corresponding names, so same @pad + # array can be used without collisions + $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME]; + } + } } sub xref { @@ -229,23 +241,45 @@ sub pp_rv2gv { deref($top, "*"); } sub pp_gvsv { my $op = shift; - my $gv = $op->gv; - $top = [$gv->STASH->NAME, '$', $gv->NAME]; + my $gv; + if ($Config{useithreads}) { + $top = $pad[$op->padix]; + $top = UNKNOWN unless $top; + $top->[1] = '$'; + } + else { + $gv = $op->gv; + $top = [$gv->STASH->NAME, '$', $gv->NAME]; + } process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used"); } sub pp_gv { my $op = shift; - my $gv = $op->gv; - $top = [$gv->STASH->NAME, "*", $gv->NAME]; + my $gv; + if ($Config{useithreads}) { + $top = $pad[$op->padix]; + $top = UNKNOWN unless $top; + $top->[1] = '*'; + } + else { + $gv = $op->gv; + $top = [$gv->STASH->NAME, "*", $gv->NAME]; + } process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used"); } sub pp_const { my $op = shift; my $sv = $op->sv; - $top = ["?", "", - (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"]; + # constant could be in the pad (under useithreads) + if ($$sv) { + $top = ["?", "", + (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"]; + } + else { + $top = $pad[$op->targ]; + } } sub pp_method { diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 7bc2491cb4..2b76bab722 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -1586,7 +1586,7 @@ db_DESTROY(db) if (db->filter_store_value) SvREFCNT_dec(db->filter_store_value) ; #endif /* DBM_FILTERING */ - Safefree(db) ; + safefree(db) ; #ifdef DB_VERSION_MAJOR if (RETVAL > 0) RETVAL = -1 ; diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs index 8af8847820..e7f5746803 100644 --- a/ext/Devel/Peek/Peek.xs +++ b/ext/Devel/Peek/Peek.xs @@ -3,12 +3,12 @@ #include "perl.h" #include "XSUB.h" -#ifdef PURIFY -#define DeadCode() NULL -#else SV * DeadCode(pTHX) { +#ifdef PURIFY + return Nullsv; +#else SV* sva; SV* sv, *dbg; SV* ret = newRV_noinc((SV*)newAV()); @@ -114,8 +114,8 @@ DeadCode(pTHX) PerlIO_printf(Perl_debug_log, "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas); return ret; -} #endif /* !PURIFY */ +} #if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ || (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index e4493b4332..bcd45ae757 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -12,7 +12,8 @@ WriteMakefile( 'XSLoader_pm.PL'=>'XSLoader.pm'}, PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm', 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'}, - clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, + clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' . + 'XSLoader.pm'}, ); sub MY::postamble { diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_dyld.xs index 768e99ed2f..688e4745f8 100644 --- a/ext/DynaLoader/dl_rhapsody.xs +++ b/ext/DynaLoader/dl_dyld.xs @@ -1,6 +1,7 @@ -/* dl_rhapsody.xs +/* dl_dyld.xs * - * Platform: Apple Rhapsody 5.0 + * Platform: Darwin (Mac OS) + * Author: Wilfredo Sanchez <wsanchez@apple.com> * Based on: dl_next.xs by Paul Marquess * Based on: dl_dlopen.xs by Anno Siegel * Created: Aug 15th, 1994 @@ -16,18 +17,23 @@ /* Porting notes: -dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It +dl_dyld.xs is based on dl_next.xs by Anno Siegel. + +dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It should not be used as a base for further ports though it may be used as an example for how dl_dlopen.xs can be ported to other platforms. The method used here is just to supply the sun style dlopen etc. -functions in terms of NeXTs rld_*. The xs code proper is unchanged -from Paul's original. +functions in terms of NeXT's/Apple's dyld. The xs code proper is +unchanged from Paul's original. The port could use some streamlining. For one, error handling could be simplified. -Anno Siegel +This should be useable as a replacement for dl_next.xs, but it has not +been tested on NeXT platforms. + + Wilfredo Sanchez */ @@ -40,6 +46,7 @@ Anno Siegel #include "dlutils.c" /* SaveError() etc */ #undef environ +#undef bool #import <mach-o/dyld.h> static char * dl_last_error = (char *) 0; @@ -216,4 +223,4 @@ dl_error() OUTPUT: RETVAL -+# end. +# end. diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 75dacfc0bd..e81afb24ce 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -231,13 +231,14 @@ sub TIEHASH { bless [] } 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; } - require Carp; - Carp::confess("No errno $errname"); -} + return $errno; +} sub STORE { require Carp; @@ -252,13 +253,12 @@ sub NEXTKEY { while(($k,$v) = each %Errno::) { my $proto = prototype("Errno::$k"); last if (defined($proto) && $proto eq ""); - } $k } sub FIRSTKEY { - my $s = scalar keys %Errno::; + my $s = scalar keys %Errno::; # initialize iterator goto &NEXTKEY; } @@ -287,8 +287,8 @@ C<Errno> defines and conditionally exports all the error constants defined in your system C<errno.h> include file. It has a single export 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 +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. For example: use Errno; @@ -300,6 +300,20 @@ value only if C<$!> is set to that value, eg } } +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> diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 43bec9903e..8ce761c50b 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -37,8 +37,21 @@ applications the newer versions of these constants are suggested (O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK, O_SYNC, O_TRUNC). -Please refer to your native fcntl() and open() documentation to see -what constants are implemented in your system. +For ease of use also the SEEK_* constants (for seek() and sysseek(), +e.g. SEEK_END) and the S_I* constants (for chmod() and stat()) are +available for import. They can be imported either separately or using +the tags C<:seek> and C<:mode>. + +Please refer to your native fcntl(2), open(2), fseek(3), lseek(2) +(equal to Perl's seek() and sysseek(), respectively), and chmod(2) +documentation to see what constants are implemented in your system. + +See L<perlopentut> to learn about the uses of the O_* constants +with sysopen(). + +See L<perlfunc/seek> and L<perlfunc/sysseek> about the SEEK_* constants. + +See L<perlfunc/stat> about the S_I* constants. =cut @@ -90,31 +103,32 @@ $VERSION = "1.03"; F_WRDNY F_WRLCK O_ACCMODE + O_ALIAS O_APPEND O_ASYNC O_BINARY O_CREAT O_DEFER + O_DIRECT + O_DIRECTORY O_DSYNC O_EXCL O_EXLOCK O_LARGEFILE O_NDELAY O_NOCTTY + O_NOFOLLOW O_NONBLOCK O_RDONLY O_RDWR + O_RSRC O_RSYNC O_SHLOCK O_SYNC + O_TEMPORARY O_TEXT O_TRUNC O_WRONLY - O_ALIAS - O_RSRC - SEEK_SET - SEEK_CUR - SEEK_END ); # Other items we are prepared to export if requested @@ -135,14 +149,52 @@ $VERSION = "1.03"; LOCK_NB LOCK_SH LOCK_UN + S_ISUID S_ISGID S_ISVTX S_ISTXT + _S_IFMT S_IFREG S_IFDIR S_IFLNK + S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT + S_IRUSR S_IWUSR S_IXUSR S_IRWXU + S_IRGRP S_IWGRP S_IXGRP S_IRWXG + S_IROTH S_IWOTH S_IXOTH S_IRWXO + S_IREAD S_IWRITE S_IEXEC + &S_ISREG &S_ISDIR &S_ISLNK &S_ISSOCK &S_ISBLK &S_ISCHR &S_ISFIFO + &S_ISWHT &S_ISENFMT &S_IFMT &S_IMODE + SEEK_SET + SEEK_CUR + SEEK_END ); # Named groups of exports %EXPORT_TAGS = ( 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FDSYNC FEXCL FLARGEFILE - FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)], + FNDELAY FNONBLOCK FRSYNC FSYNC FTRUNC)], + 'seek' => [qw(SEEK_SET SEEK_CUR SEEK_END)], + 'mode' => [qw(S_ISUID S_ISGID S_ISVTX S_ISTXT + _S_IFMT S_IFREG S_IFDIR S_IFLNK + S_IFSOCK S_IFBLK S_IFCHR S_IFIFO S_IFWHT S_ENFMT + S_IRUSR S_IWUSR S_IXUSR S_IRWXU + S_IRGRP S_IWGRP S_IXGRP S_IRWXG + S_IROTH S_IWOTH S_IXOTH S_IRWXO + S_IREAD S_IWRITE S_IEXEC + S_ISREG S_ISDIR S_ISLNK S_ISSOCK + S_ISBLK S_ISCHR S_ISFIFO + S_ISWHT S_ISENFMT + S_IFMT S_IMODE + )], ); +sub S_IFMT { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT() } +sub S_IMODE { $_[0] & 07777 } + +sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() } +sub S_ISDIR { ( $_[0] & _S_IFMT() ) == S_IFDIR() } +sub S_ISLNK { ( $_[0] & _S_IFMT() ) == S_IFLNK() } +sub S_ISSOCK { ( $_[0] & _S_IFMT() ) == S_IFSOCK() } +sub S_ISBLK { ( $_[0] & _S_IFMT() ) == S_IFBLK() } +sub S_ISCHR { ( $_[0] & _S_IFMT() ) == S_IFCHR() } +sub S_ISFIFO { ( $_[0] & _S_IFMT() ) == S_IFIFO() } +sub S_ISWHT { ( $_[0] & _S_IFMT() ) == S_ISWHT() } +sub S_ISENFMT { ( $_[0] & _S_IFMT() ) == S_ISENFMT() } + sub AUTOLOAD { (my $constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname, 0); diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index 08252b6538..8d4a073658 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -45,6 +45,14 @@ constant(char *name, int arg) { errno = 0; switch (*name) { + case '_': + if (strEQ(name, "_S_IFMT")) /* Yes, _S_IFMT. */ +#ifdef S_IFMT + return S_IFMT; +#else + goto not_there; +#endif + break; case 'F': if (strnEQ(name, "F_", 2)) { if (strEQ(name, "F_ALLOCSP")) @@ -414,6 +422,18 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "O_DIRECT")) +#ifdef O_DIRECT + return O_DIRECT; +#else + goto not_there; +#endif + if (strEQ(name, "O_DIRECTORY")) +#ifdef O_DIRECTORY + return O_DIRECTORY; +#else + goto not_there; +#endif if (strEQ(name, "O_DSYNC")) #ifdef O_DSYNC return O_DSYNC; @@ -450,6 +470,12 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "O_NOFOLLOW")) +#ifdef O_NOFOLLOW + return O_NOFOLLOW; +#else + goto not_there; +#endif if (strEQ(name, "O_NONBLOCK")) #ifdef O_NONBLOCK return O_NONBLOCK; @@ -486,6 +512,12 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "O_TEMPORARY")) +#ifdef O_TEMPORARY + return O_TEMPORARY; +#else + goto not_there; +#endif if (strEQ(name, "O_TEXT")) #ifdef O_TEXT return O_TEXT; @@ -520,25 +552,198 @@ constant(char *name, int arg) goto not_there; break; case 'S': - if (strEQ(name, "SEEK_CUR")) + switch (name[1]) { + case '_': + if (strEQ(name, "S_ISUID")) +#ifdef S_ISUID + return S_ISUID; +#else + goto not_there; +#endif + if (strEQ(name, "S_ISGID")) +#ifdef S_ISGID + return S_ISGID; +#else + goto not_there; +#endif + if (strEQ(name, "S_ISVTX")) +#ifdef S_ISVTX + return S_ISVTX; +#else + goto not_there; +#endif + if (strEQ(name, "S_ISTXT")) +#ifdef S_ISTXT + return S_ISTXT; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFREG")) +#ifdef S_IFREG + return S_IFREG; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFDIR")) +#ifdef S_IFDIR + return S_IFDIR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFLNK")) +#ifdef S_IFLNK + return S_IFLNK; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFSOCK")) +#ifdef S_IFSOCK + return S_IFSOCK; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFBLK")) +#ifdef S_IFBLK + return S_IFBLK; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFCHR")) +#ifdef S_IFCHR + return S_IFCHR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFIFO")) +#ifdef S_IFIFO + return S_IFIFO; +#else + goto not_there; +#endif + if (strEQ(name, "S_IFWHT")) +#ifdef S_IFWHT + return S_IFWHT; +#else + goto not_there; +#endif + if (strEQ(name, "S_ENFMT")) +#ifdef S_ENFMT + return S_ENFMT; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRUSR")) +#ifdef S_IRUSR + return S_IRUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWUSR")) +#ifdef S_IWUSR + return S_IWUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXUSR")) +#ifdef S_IXUSR + return S_IXUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXU")) +#ifdef S_IRWXU + return S_IRWXU; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRGRP")) +#ifdef S_IRGRP + return S_IRGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWGRP")) +#ifdef S_IWGRP + return S_IWGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXGRP")) +#ifdef S_IXGRP + return S_IXGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXG")) +#ifdef S_IRWXG + return S_IRWXG; +#else + goto not_there; +#endif + if (strEQ(name, "S_IROTH")) +#ifdef S_IROTH + return S_IROTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWOTH")) +#ifdef S_IWOTH + return S_IWOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXOTH")) +#ifdef S_IXOTH + return S_IXOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXO")) +#ifdef S_IRWXO + return S_IRWXO; +#else + goto not_there; +#endif + if (strEQ(name, "S_IREAD")) +#ifdef S_IREAD + return S_IREAD; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWRITE")) +#ifdef S_IWRITE + return S_IWRITE; +#else + goto not_there; +#endif + if (strEQ(name, "S_IEXEC")) +#ifdef S_IEXEC + return S_IEXEC; +#else + goto not_there; +#endif + break; + case 'E': + if (strEQ(name, "SEEK_CUR")) #ifdef SEEK_CUR - return SEEK_CUR; + return SEEK_CUR; #else - goto not_there; + return 1; #endif - if (strEQ(name, "SEEK_END")) + if (strEQ(name, "SEEK_END")) #ifdef SEEK_END - return SEEK_END; + return SEEK_END; #else - goto not_there; + return 2; #endif - if (strEQ(name, "SEEK_SET")) + if (strEQ(name, "SEEK_SET")) #ifdef SEEK_SET - return SEEK_SET; + return SEEK_SET; #else - goto not_there; + return 0; #endif - break; + break; + } } errno = EINVAL; return 0; diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index be1817bba2..870f056c9b 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -236,6 +236,7 @@ gdbm_DESTROY(db) GDBM_File db CODE: gdbm_close(db); + safefree(db); #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) datum_value diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index be84f73268..1b79cfd4c0 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -458,11 +458,4 @@ BOOT: #ifdef SEEK_END newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END)); #endif - /* - * constant subs for IO - */ - stash = gv_stashpvn("IO", 2, TRUE); -#ifdef EINPROGRESS - newCONSTSUB(stash,"EINPROGRESS", newSViv(EINPROGRESS)); -#endif } diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index 0e81c4b35e..2b51dee41e 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -14,6 +14,7 @@ use Carp; use strict; our(@ISA, $VERSION); use Exporter; +use Errno; # legacy @@ -22,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc'); @ISA = qw(IO::Handle); -$VERSION = "1.252"; +$VERSION = "1.26"; sub import { my $pkg = shift; @@ -100,35 +101,38 @@ sub connect { 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 && $!{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) && not $!{EISCONN}) { + # Some systems refuse to re-connect() to + # an already open socket and set errno to EISCONN. + $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 { @@ -158,23 +162,23 @@ sub accept { 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 { diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm index 30a923034a..696e988802 100644 --- a/ext/IO/lib/IO/Socket/INET.pm +++ b/ext/IO/lib/IO/Socket/INET.pm @@ -12,9 +12,12 @@ use IO::Socket; use Socket; use Carp; use Exporter; +use Errno; @ISA = qw(IO::Socket); -$VERSION = "1.24"; +$VERSION = "1.25"; + +my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; IO::Socket::INET->register_domain( AF_INET ); @@ -38,10 +41,16 @@ sub _sock_info { 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) { @@ -50,8 +59,12 @@ sub _sock_info { 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; @@ -67,10 +80,14 @@ sub _sock_info { 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; } @@ -96,12 +113,13 @@ sub configure { ($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} @@ -110,7 +128,8 @@ sub configure { unless(exists $arg->{Listen}) { ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, $arg->{PeerPort}, - $proto); + $proto) + or return _error($sock, $!, $@); } $proto ||= (getprotobyname('tcp'))[2]; @@ -122,28 +141,28 @@ sub configure { 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; } @@ -152,13 +171,13 @@ sub configure { $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'}; @@ -169,12 +188,14 @@ sub configure { 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; # } diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs index 29cc288769..49a1db5e56 100644 --- a/ext/NDBM_File/NDBM_File.xs +++ b/ext/NDBM_File/NDBM_File.xs @@ -63,6 +63,7 @@ ndbm_DESTROY(db) NDBM_File db CODE: dbm_close(db->dbp); + safefree(db); #define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) datum_value diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs index 7601c3433b..150f2ef894 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -2,9 +2,6 @@ #include "perl.h" #include "XSUB.h" -#ifdef NULL -#undef NULL /* XXX Why? */ -#endif #ifdef I_DBM # include <dbm.h> #else @@ -76,10 +73,6 @@ static int dbmrefcnt; MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ -#ifndef NULL -# define NULL 0 -#endif - ODBM_File odbm_TIEHASH(dbtype, filename, flags, mode) char * dbtype @@ -120,6 +113,7 @@ DESTROY(db) CODE: dbmrefcnt--; dbmclose(); + safefree(db); datum_value odbm_FETCH(db, key) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index af43c40714..3a523d1d07 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -510,8 +510,14 @@ mini_mktime(struct tm *ptm) } } ptm->tm_year = year - 1900; - ptm->tm_mon = month; - ptm->tm_mday = yearday; + if (yearday) { + ptm->tm_mday = yearday; + ptm->tm_mon = month; + } + else { + ptm->tm_mday = 31; + ptm->tm_mon = month - 1; + } /* re-build yearday based on Jan 1 to get tm_yday */ year--; yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400; diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs index ee672ca915..a4b90451a9 100644 --- a/ext/SDBM_File/SDBM_File.xs +++ b/ext/SDBM_File/SDBM_File.xs @@ -80,7 +80,7 @@ sdbm_DESTROY(db) SvREFCNT_dec(db->filter_fetch_value) ; if (db->filter_store_value) SvREFCNT_dec(db->filter_store_value) ; - Safefree(db) ; + safefree(db) ; datum_value sdbm_FETCH(db, key) diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c index f58f4487c8..64c75cbb20 100644 --- a/ext/SDBM_File/sdbm/sdbm.c +++ b/ext/SDBM_File/sdbm/sdbm.c @@ -39,7 +39,7 @@ extern int errno; extern Malloc_t malloc proto((MEM_SIZE)); extern Free_t free proto((Malloc_t)); -extern Off_t lseek(int, Off_t, int); + #endif /* diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index cec13ac47f..f83cb18399 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -244,6 +244,9 @@ use XSLoader (); SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP + SHUT_RD + SHUT_RDWR + SHUT_WR SOCK_DGRAM SOCK_RAW SOCK_RDM @@ -320,6 +323,115 @@ sub sockaddr_un { } } +sub INADDR_ANY (); +sub INADDR_BROADCAST (); +sub INADDR_LOOPBACK (); +sub INADDR_LOOPBACK (); + +sub AF_802 (); +sub AF_APPLETALK (); +sub AF_CCITT (); +sub AF_CHAOS (); +sub AF_DATAKIT (); +sub AF_DECnet (); +sub AF_DLI (); +sub AF_ECMA (); +sub AF_GOSIP (); +sub AF_HYLINK (); +sub AF_IMPLINK (); +sub AF_INET (); +sub AF_LAT (); +sub AF_MAX (); +sub AF_NBS (); +sub AF_NIT (); +sub AF_NS (); +sub AF_OSI (); +sub AF_OSINET (); +sub AF_PUP (); +sub AF_SNA (); +sub AF_UNIX (); +sub AF_UNSPEC (); +sub AF_X25 (); +sub IOV_MAX (); +sub MSG_BCAST (); +sub MSG_CTLFLAGS (); +sub MSG_CTLIGNORE (); +sub MSG_CTRUNC (); +sub MSG_DONTROUTE (); +sub MSG_DONTWAIT (); +sub MSG_EOF (); +sub MSG_EOR (); +sub MSG_ERRQUEUE (); +sub MSG_FIN (); +sub MSG_MAXIOVLEN (); +sub MSG_MCAST (); +sub MSG_NOSIGNAL (); +sub MSG_OOB (); +sub MSG_PEEK (); +sub MSG_PROXY (); +sub MSG_RST (); +sub MSG_SYN (); +sub MSG_TRUNC (); +sub MSG_URG (); +sub MSG_WAITALL (); +sub PF_802 (); +sub PF_APPLETALK (); +sub PF_CCITT (); +sub PF_CHAOS (); +sub PF_DATAKIT (); +sub PF_DECnet (); +sub PF_DLI (); +sub PF_ECMA (); +sub PF_GOSIP (); +sub PF_HYLINK (); +sub PF_IMPLINK (); +sub PF_INET (); +sub PF_LAT (); +sub PF_MAX (); +sub PF_NBS (); +sub PF_NIT (); +sub PF_NS (); +sub PF_OSI (); +sub PF_OSINET (); +sub PF_PUP (); +sub PF_SNA (); +sub PF_UNIX (); +sub PF_UNSPEC (); +sub PF_X25 (); +sub SCM_CONNECT (); +sub SCM_CREDENTIALS (); +sub SCM_CREDS (); +sub SCM_RIGHTS (); +sub SCM_TIMESTAMP (); +sub SHUT_RD (); +sub SHUT_RDWR (); +sub SHUT_WR (); +sub SOCK_DGRAM (); +sub SOCK_RAW (); +sub SOCK_RDM (); +sub SOCK_SEQPACKET (); +sub SOCK_STREAM (); +sub SOL_SOCKET (); +sub SOMAXCONN (); +sub SO_ACCEPTCONN (); +sub SO_BROADCAST (); +sub SO_DEBUG (); +sub SO_DONTLINGER (); +sub SO_DONTROUTE (); +sub SO_ERROR (); +sub SO_KEEPALIVE (); +sub SO_LINGER (); +sub SO_OOBINLINE (); +sub SO_RCVBUF (); +sub SO_RCVLOWAT (); +sub SO_RCVTIMEO (); +sub SO_REUSEADDR (); +sub SO_SNDBUF (); +sub SO_SNDLOWAT (); +sub SO_SNDTIMEO (); +sub SO_TYPE (); +sub SO_USELOOPBACK (); +sub UIO_MAXIOV (); sub AUTOLOAD { my($constname); @@ -329,7 +441,7 @@ sub AUTOLOAD { my ($pack,$file,$line) = caller; croak "Your vendor has not defined Socket macro $constname, used"; } - eval "sub $AUTOLOAD { $val }"; + eval "sub $AUTOLOAD () { $val }"; goto &$AUTOLOAD; } diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 6abc647c2f..752c3ddb10 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -662,6 +662,24 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "SHUT_RD")) +#ifdef SHUT_RD + return SHUT_RD; +#else + return 0; +#endif + if (strEQ(name, "SHUT_RDWR")) +#ifdef SHUT_RDWR + return SHUT_RDWR; +#else + return 2; +#endif + if (strEQ(name, "SHUT_WR")) +#ifdef SHUT_WR + return SHUT_WR; +#else + return 1; +#endif if (strEQ(name, "SOCK_DGRAM")) #ifdef SOCK_DGRAM return SOCK_DGRAM; diff --git a/lib/Sys/Hostname.pm b/ext/Sys/Hostname/Hostname.pm index 63415a6bfe..1efc897c3b 100644 --- a/lib/Sys/Hostname.pm +++ b/ext/Sys/Hostname/Hostname.pm @@ -1,41 +1,31 @@ package Sys::Hostname; -use Carp; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(hostname); - -=head1 NAME - -Sys::Hostname - Try every conceivable way to get hostname - -=head1 SYNOPSIS - - use Sys::Hostname; - $host = hostname; - -=head1 DESCRIPTION +use strict; -Attempts several methods of getting the system hostname and -then caches the result. It tries C<syscall(SYS_gethostname)>, -C<`hostname`>, C<`uname -n`>, and the file F</com/host>. -If all that fails it C<croak>s. +use Carp; -All nulls, returns, and newlines are removed from the result. +require Exporter; +use XSLoader (); +require AutoLoader; -=head1 AUTHOR +our @ISA = qw/ Exporter AutoLoader /; +our @EXPORT = qw/ hostname /; -David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt> +our $VERSION = '1.1'; -Texas Instruments +our $host; -=cut +XSLoader::load 'Sys::Hostname', $VERSION; sub hostname { # method 1 - we already know it return $host if defined $host; + # method 1' - try to ask the system + $host = ghname(); + return $host if defined $host; + if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name @@ -70,8 +60,10 @@ sub hostname { return $host; } else { # Unix + # is anyone going to make it here? # method 2 - syscall is preferred since it avoids tainting problems + # XXX: is it such a good idea to return hostname untainted? eval { local $SIG{__DIE__}; require "syscall.ph"; @@ -113,6 +105,7 @@ sub hostname { # method 6 - Apollo pre-SR10 || eval { local $SIG{__DIE__}; + my($a,$b,$c,$d); ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); } @@ -126,3 +119,35 @@ sub hostname { } 1; + +__END__ + +=head1 NAME + +Sys::Hostname - Try every conceivable way to get hostname + +=head1 SYNOPSIS + + use Sys::Hostname; + $host = hostname; + +=head1 DESCRIPTION + +Attempts several methods of getting the system hostname and +then caches the result. It tries the first available of the C +library's gethostname(), C<`$Config{aphostname}`>, uname(2), +C<syscall(SYS_gethostname)>, C<`hostname`>, C<`uname -n`>, +and the file F</com/host>. If all that fails it C<croak>s. + +All NULs, returns, and newlines are removed from the result. + +=head1 AUTHOR + +David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt> + +Texas Instruments + +XS code added by Greg Bacon E<lt>F<gbacon@cs.uah.edu>E<gt> + +=cut + diff --git a/ext/Sys/Hostname/Hostname.xs b/ext/Sys/Hostname/Hostname.xs new file mode 100644 index 0000000000..f1043837e9 --- /dev/null +++ b/ext/Sys/Hostname/Hostname.xs @@ -0,0 +1,76 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#if defined(I_UNISTD) && defined(HAS_GETHOSTNAME) +# include <unistd.h> +#endif + +/* a reasonable default */ +#ifndef MAXHOSTNAMELEN +# define MAXHOSTNAMELEN 256 +#endif + +/* swiped from POSIX.xs */ +#if defined(__VMS) && !defined(__POSIX_SOURCE) +# if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +# include <utsname.h> +# endif +#endif + +#ifdef I_SYSUTSNAME +# include <sys/utsname.h> +#endif + +MODULE = Sys::Hostname PACKAGE = Sys::Hostname + +void +ghname() + PREINIT: + IV retval = -1; + SV *sv; + PPCODE: + EXTEND(SP, 1); +#ifdef HAS_GETHOSTNAME + { + char tmps[MAXHOSTNAMELEN]; + retval = PerlSock_gethostname(tmps, sizeof(tmps)); + sv = newSVpvn(tmps, strlen(tmps)); + } +#else +# ifdef HAS_PHOSTNAME + { + PerlIO *io; + char tmps[MAXHOSTNAMELEN]; + char *p = tmps; + char c; + io = PerlProc_popen(PHOSTNAME, "r"); + if (!io) + goto check_out; + while (PerlIO_read(io, &c, sizeof(c)) == 1) { + if (isSPACE(c) || p - tmps >= sizeof(tmps)) + break; + *p++ = c; + } + PerlProc_pclose(io); + *p = '\0'; + retval = 0; + sv = newSVpvn(tmps, strlen(tmps)); + } +# else +# ifdef HAS_UNAME + { + struct utsname u; + if (PerlEnv_uname(&u) == -1) + goto check_out; + sv = newSVpvn(u.nodename, strlen(u.nodename)); + retval = 0; + } +# endif +# endif +#endif + check_out: + if (retval == -1) + XSRETURN_UNDEF; + else + PUSHs(sv_2mortal(sv)); diff --git a/ext/Sys/Hostname/Makefile.PL b/ext/Sys/Hostname/Makefile.PL new file mode 100644 index 0000000000..a0892f643e --- /dev/null +++ b/ext/Sys/Hostname/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Sys::Hostname', + VERSION_FROM => 'Hostname.pm', + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', +); diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index 253130a506..e5edf3e1ba 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -3,5 +3,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Sys::Syslog', VERSION_FROM => 'Syslog.pm', + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', ); diff --git a/ext/Sys/Syslog/Syslog.xs b/ext/Sys/Syslog/Syslog.xs index d227343a1a..511df9f85f 100644 --- a/ext/Sys/Syslog/Syslog.xs +++ b/ext/Sys/Syslog/Syslog.xs @@ -551,6 +551,7 @@ _PATH_LOG() RETVAL = _PATH_LOG; #else croak("Your vendor has not defined the Sys::Syslog macro _PATH_LOG"); + RETVAL = NULL; #endif OUTPUT: RETVAL @@ -564,6 +565,7 @@ LOG_FAC(p) RETVAL = LOG_FAC(p); #else croak("Your vendor has not defined the Sys::Syslog macro LOG_FAC"); + RETVAL = -1; #endif OUTPUT: RETVAL @@ -577,6 +579,7 @@ LOG_PRI(p) RETVAL = LOG_PRI(p); #else croak("Your vendor has not defined the Sys::Syslog macro LOG_PRI"); + RETVAL = -1; #endif OUTPUT: RETVAL @@ -591,6 +594,7 @@ LOG_MAKEPRI(fac,pri) RETVAL = LOG_MAKEPRI(fac,pri); #else croak("Your vendor has not defined the Sys::Syslog macro LOG_MAKEPRI"); + RETVAL = -1; #endif OUTPUT: RETVAL @@ -604,6 +608,7 @@ LOG_MASK(pri) RETVAL = LOG_MASK(pri); #else croak("Your vendor has not defined the Sys::Syslog macro LOG_MASK"); + RETVAL = -1; #endif OUTPUT: RETVAL @@ -617,6 +622,7 @@ LOG_UPTO(pri) RETVAL = LOG_UPTO(pri); #else croak("Your vendor has not defined the Sys::Syslog macro LOG_UPTO"); + RETVAL = -1; #endif OUTPUT: RETVAL diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm index f744e36c66..2070632558 100644 --- a/ext/attrs/attrs.pm +++ b/ext/attrs/attrs.pm @@ -20,7 +20,7 @@ attrs - set/get attributes of a subroutine (deprecated) NOTE: Use of this pragma is deprecated. Use the syntax - sub foo : locked, method { } + sub foo : locked method { } to declare attributes instead. See also L<attributes>. diff --git a/global.sym b/global.sym index 2f750fa170..b38fc6f519 100644 --- a/global.sym +++ b/global.sym @@ -431,6 +431,7 @@ Perl_sv_upgrade Perl_sv_usepvn Perl_sv_vcatpvfn Perl_sv_vsetpvfn +Perl_str_to_version Perl_swash_init Perl_swash_fetch Perl_taint_env @@ -452,6 +453,7 @@ Perl_vwarn Perl_warner Perl_vwarner Perl_dump_mstats +Perl_get_mstats Perl_safesysmalloc Perl_safesyscalloc Perl_safesysrealloc @@ -498,6 +500,10 @@ Perl_sv_2pvbyte_nolen Perl_sv_pv Perl_sv_pvutf8 Perl_sv_pvbyte +Perl_sv_utf8_upgrade +Perl_sv_utf8_downgrade +Perl_sv_utf8_encode +Perl_sv_utf8_decode Perl_sv_force_normal Perl_tmps_grow Perl_sv_rvweaken @@ -48,18 +48,18 @@ Null SV pointer. just figure out all the headers such a test needs. Andy Dougherty August 1996 */ -/* bool is built-in for g++-2.6.3, which might be used for an extension. - If the extension includes <_G_config.h> before this file then - _G_HAVE_BOOL will be properly set. If, however, the extension includes - this file first, then you will have to manually set -DHAS_BOOL in - your command line to avoid a conflict. +/* bool is built-in for g++-2.6.3 and later, which might be used + for extensions. <_G_config.h> defines _G_HAVE_BOOL, but we can't + be sure _G_config.h will be included before this file. _G_config.h + also defines _G_HAVE_BOOL for both gcc and g++, but only g++ + actually has bool. Hence, _G_HAVE_BOOL is pretty useless for us. + g++ can be identified by __GNUG__. + Andy Dougherty February 2000 */ -#ifdef _G_HAVE_BOOL -# if _G_HAVE_BOOL +#ifdef __GNUG__ /* GNU g++ has bool built-in */ # ifndef HAS_BOOL -# define HAS_BOOL 1 +# define HAS_BOOL 1 # endif -# endif #endif /* The NeXT dynamic loader headers will not build with the bool macro @@ -81,6 +81,7 @@ Null SV pointer. # else # define bool char # endif +# define HAS_BOOL 1 #endif /* XXX A note on the perl source internal type system. The @@ -466,10 +467,10 @@ typedef U16 line_t; #endif -/* This looks obsolete (IZ): - +/* XXX LEAKTEST doesn't really work in perl5. There are direct calls to safemalloc() in the source, so LEAKTEST won't pick them up. + (The main "offenders" are extensions.) Further, if you try LEAKTEST, you'll also end up calling Safefree, which might call safexfree() on some things that weren't malloced with safexmalloc. The correct "fix" to this, if anyone diff --git a/hints/aix.sh b/hints/aix.sh index fec963b8f8..1029a36aea 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -139,13 +139,6 @@ $define|true|[yY]*) # (e.g. pragma/overload core dumps) Let's suspect xlC_r, too. # --jhi@iki.fi cc=cc_r - if test ! -e /bin/cc_r; then - cat >&4 <<EOM -For pthreads you should use the AIX C compiler cc_r. -But I cannot find it as /bin/cc_r. -Cannot continue, aborting. -EOM - fi ;; '') cc=cc_r @@ -186,7 +179,7 @@ EOCBU # after it has prompted the user for whether to use large files. cat > UU/uselfs.cbu <<'EOCBU' case "$uselargefiles" in -$define|true|[yY]*) +''|$define|true|[yY]*) lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" lfldflags="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to @@ -215,10 +208,10 @@ $define|true|[yY]*) esac EOCBU -# This script UU/use64bits.cbu will get 'called-back' by Configure +# This script UU/use64bitint.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. -cat > UU/use64bits.cbu <<'EOCBU' -case "$use64bits" in +cat > UU/use64bitint.cbu <<'EOCBU' +case "$use64bitint" in $define|true|[yY]*) case "`oslevel`" in 3.*|4.[012].*) @@ -229,10 +222,6 @@ EOM exit 1 ;; esac - case "$ccflags" in - *-DUSE_LONG_LONG*) ;; - *) ccflags="$ccflags -DUSE_LONG_LONG" ;; - esac # When a 64-bit cc becomes available $archname64 # may need setting so that $archname gets it attached. ;; diff --git a/hints/cygwin.sh b/hints/cygwin.sh index 4843200f85..42114c249f 100644 --- a/hints/cygwin.sh +++ b/hints/cygwin.sh @@ -8,6 +8,7 @@ firstmakefile='GNUmakefile' case "$ldlibpthname" in '') ldlibpthname=PATH ;; esac +archobjs='cygwin.o' # mandatory (overrides incorrect defaults) test -z "$cc" && cc='gcc' @@ -25,9 +26,9 @@ libswanted="$libswanted cygipc cygwin kernel32" archname='cygwin' # dynamic loading -ld='ld2' # - otherwise -fpic cccdlflags=' ' +ld='ld2' # optional(ish) # - perl malloc needs to be unpolluted @@ -38,6 +39,9 @@ d_chroot='undef' d_seteuid='undef' d_setegid='undef' +# Win9x problem with non-blocking read from a closed pipe +d_eofnblk='define' + # strip exe's and dll's #ldflags="$ldflags -s" #ccdlflags="$ccdlflags -s" diff --git a/hints/darwin.sh b/hints/darwin.sh new file mode 100644 index 0000000000..fd61e424b0 --- /dev/null +++ b/hints/darwin.sh @@ -0,0 +1,63 @@ +## +# Darwin (Mac OS) hints +# Wilfredo Sanchez <wsanchez@apple.com> +## + +## +# Paths +## + +# BSD paths +prefix='/usr'; +siteprefix='/usr/local'; +vendorprefix='/usr/local'; usevendorprefix='define'; + +# 4BSD uses /usr/share/man, not /usr/man. +# Don't put man pages in /usr/lib; that's goofy. +man1dir='/usr/share/man/man1'; +man3dir='/usr/share/man/man3'; + +# Where to put modules. +privlib='/System/Library/Perl'; +sitelib='/Local/Library/Perl'; +vendorlib='/Network/Library/Perl'; + +## +# Tool chain settings +## + +# Since we can build fat, the archname doesn't need the processor type +archname='darwin'; + +# nm works. +usenm='true'; + +# Libc is in libsystem. +libc='/System/Library/Frameworks/System.framework/System'; + +# Optimize. +optimize='-O3'; + +# We have a prototype for telldir. +ccflags="${ccflags} -pipe -fno-common -DHAS_TELLDIR_PROTOTYPE"; + +# Shared library extension is .dylib. +# Bundle extension is .bundle. +ld='cc'; +so='dylib'; +dlext='bundle'; +dlsrc='dl_dyld.xs'; usedl='define'; +cccdlflags=''; +lddlflags="${ldflags} -bundle -undefined suppress"; +ldlibpthname='DYLD_LIBRARY_PATH'; +useshrplib='true'; + +## +# System libraries +## + +# vfork works +usevfork='true'; + +# malloc works +usemymalloc='n'; diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh index 5eb7e80968..e5970ff2ec 100644 --- a/hints/dec_osf.sh +++ b/hints/dec_osf.sh @@ -151,7 +151,7 @@ case "`uname -r`" in *) if $test "X$optimize" = "X$undef"; then lddlflags="$lddlflags -msym" else - case "`sizer -v`" in + case "`/usr/sbin/sizer -v`" in *4.0D*) # QAR 56761: -O4 + .so may produce broken code, # fixed in 4.0E or better. @@ -162,7 +162,7 @@ case "`uname -r`" in esac # -msym: If using a sufficiently recent /sbin/loader, # keep the module symbols with the modules. - lddlflags="$lddlflags -msym" + lddlflags="$lddlflags -msym -std" fi ;; esac @@ -202,7 +202,16 @@ esac # please adjust this appropriately. See also pp_sys.c just before the # emulate_eaccess(). +# Fixed in V5.0A. +case "`/usr/sbin/sizer -v`" in +*5.0[A-Z]*|*[6-9].[0-9]*) + : ok + ;; +*) +# V5.0 or previous pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"' + ;; +esac # The off_t is already 8 bytes, so we do have largefileness. @@ -225,7 +234,11 @@ $define|true|[yY]*) *) libswanted="$libswanted pthread exc" ;; esac - usemymalloc='n' + case "$usemymalloc" in + '') + usemymalloc='n' + ;; + esac ;; esac EOCBU diff --git a/hints/hpux.sh b/hints/hpux.sh index 168c4bedcd..ba6efa0341 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -101,12 +101,6 @@ EOM ;; esac -# Even if you use gcc, prefer the HP math library over the GNU one. - -case "`$cc -v 2>&1`" in -"*gcc*" ) test -d /lib/pa1.1 && ccflags="$ccflags -L/lib/pa1.1" ;; -esac - # Determine the architecture type of this system. # Keep leading tab below -- Configure Black Magic -- RAM, 03/02/97 xxOsRevMajor=`uname -r | sed -e 's/^[^0-9]*//' | cut -d. -f1`; @@ -139,6 +133,68 @@ else selecttype='int *' fi +case "$use64bitint" in +$define|true|[yY]*) + if [ "$xxOsRevMajor" -lt 11 ]; then + cat <<EOM >&4 + +64-bit compilation is not supported on HP-UX $xxOsRevMajor. +You need at least HP-UX 11.0. +Cannot continue, aborting. + +EOM + exit 1 + fi + + # Without the 64-bit libc we cannot do much. + if [ ! -f /lib/pa20_64/libc.sl ]; then + cat <<EOM >&4 + +You do not seem to have the 64-bit libraries in /lib/pa20_64. +Most importantly, I cannot find /lib/pa20_64/libc.sl. +Cannot continue, aborting. + +EOM + exit 1 + fi + + ccflags="$ccflags +DD64" + ldflags="$ldflags +DD64" + loclibpth="$loclibpth /lib/pa20_64" + libscheck='case "`file $xxx`" in +*LP64*|*PA-RISC2.0*) ;; +*) xxx=/no/64-bit$xxx ;; +esac' + ld=/usr/bin/ld + ar=/usr/bin/ar + full_ar=$ar + + # The strict ANSI mode (-Aa) doesn't like the LL suffixes. + case "$ccflags" in + *-Aa*) + echo "(Changing from strict ANSI compilation to extended because of 64-bitness)" + ccflags=`echo $ccflags|sed 's@ -Aa @ -Ae @'` + ;; + esac + + set `echo " $libswanted " | sed -e 's@ dl @ @'` + libswanted="$*" + + case "`$cc -v 2>&1`" in + *gcc*) ccflags="$ccflags -L/lib/pa20_64" ;; + esac + ;; +*) loclibpth="$loclibpth /lib/pa1.1" + case "`$cc -v 2>&1`" in + *gcc*) ccflags="$ccflags -L/lib/pa20_64" ;; + esac + ;; +esac + +case "`getconf KERNEL_BITS 2>/dev/null`" in +*64*) ldflags="$ldflags -Wl,+vnocompatwarnings" ;; +esac + # Remove bad libraries that will cause problems # (This doesn't remove libraries that don't actually exist) # -lld is unneeded (and I can't figure out what it's used for anyway) @@ -289,62 +345,24 @@ EOM esac EOCBU -# This script UU/use64bits.cbu will get 'called-back' by Configure -# after it has prompted the user for whether to use 64 bits. -cat > UU/use64bits.cbu <<'EOCBU' -case "$use64bits" in -$define|true|[yY]*) - if [ "$xxOsRevMajor" -lt 11 ]; then - cat <<EOM >&4 -64-bit compilation is not supported on HP-UX $xxOsRevMajor. -You need at least HP-UX 11.0. -Cannot continue, aborting. -EOM - exit 1 - fi - if [ ! -f /lib/pa20_64/libc.sl ]; then - cat <<EOM >&4 -You do not seem to have the 64-bit libraries in /lib/pa20_64. -Most importantly, I cannot find /lib/pa20_64/libc.sl. -Cannot continue, aborting. -EOM - exit 1 - fi - - ccflags="$ccflags +DD64" - ld=/usr/bin/ld - ar=/usr/bin/ar - loclibpth="/lib/pa20_64 $loclibpth" - - # The strict ANSI mode (-Aa) doesn't like the LL suffixes. - ccflags=`echo $ccflags|sed 's@ -Aa @ -Ae @'` - - set `echo " $libswanted " | sed -e 's@ dl @ @'` - libswanted="$*" - - libscheck=' -case "`/usr/bin/file $xxx`" in -*LP64*) ;; -*) xxx=/non/64/bit$xxx ;; -esac -' - ;; -esac -EOCBU - # This script UU/uselfs.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. cat > UU/uselfs.cbu <<'EOCBU' case "$uselargefiles" in -$define|true|[yY]*) - ccflags="$ccflags `getconf _CS_XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" - ldflags="$ldflags `getconf _CS_XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" - - libswanted="$libswanted `getconf _CS_XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" +''|$define|true|[yY]*) + # there are largefile flags available via getconf(1) + # but we cheat for now. + ccflags="$ccflags -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" # The strict ANSI mode (-Aa) doesn't like large files. - ccflags=`echo $ccflags|sed 's@ -Aa @ -Ae @'` + case "$ccflags" in + *-Aa*) + echo "(Changing from strict ANSI compilation to extended because of large files)" + ccflags=`echo $ccflags|sed 's@ -Aa @ -Ae @'` + ;; + esac ;; esac EOCBU + diff --git a/hints/irix_4.sh b/hints/irix_4.sh index 1e90f989bd..5c5bdb2f0d 100644 --- a/hints/irix_4.sh +++ b/hints/irix_4.sh @@ -33,8 +33,8 @@ EOM ;; esac -case "$use64bits" in -$define|true|[yY]*) +case " $use64bits $use64bitint $use64bitall " in +*" $define "*|*" true "*|*" [yY] "*) cat >&4 <<EOM IRIX `uname -r` does not support 64-bit types. You should upgrade to at least IRIX 6.2. diff --git a/hints/irix_5.sh b/hints/irix_5.sh index 30f11d7676..f895bcc5f6 100644 --- a/hints/irix_5.sh +++ b/hints/irix_5.sh @@ -43,8 +43,8 @@ EOM ;; esac -case "$use64bits" in -$define|true|[yY]*) +case " $use64bits $use64bitint $use64bitall " in +*" $define "*|*" true "*|*" [yY] "*) cat >&4 <<EOM IRIX `uname -r` does not support 64-bit types. You should upgrade to at least IRIX 6.2. diff --git a/hints/irix_6.sh b/hints/irix_6.sh index f4bbf32d01..461ad664ac 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -47,6 +47,11 @@ esac case "$cc" in *"cc -n32"*) + libscheck='case "`file $xxx`" in +*N32*) ;; +*) xxx=/no/n32$xxx ;; +esac' + # Perl 5.004_57 introduced new qsort code into pp_ctl.c that # makes IRIX cc prior to 7.2.1 to emit bad code. # so some serious hackery follows to set pp_ctl flags correctly. @@ -54,11 +59,11 @@ case "$cc" in # Check for which version of the compiler we're running case "`$cc -version 2>&1`" in *7.0*) # Mongoose 7.0 - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1174,1184,1552 -OPT:Olimit=0" optimize='none' ;; *7.1*|*7.2|*7.20) # Mongoose 7.1+ - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1174,1184,1552 -OPT:Olimit=0" optimize='-O3' # This is a temporary fix for 5.005. # Leave pp_ctl_cflags line at left margin for Configure. See @@ -67,15 +72,15 @@ case "$cc" in pp_ctl_cflags='optimize=-O' ;; *7.*) # Mongoose 7.2.1+ - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=ON" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1174,1184,1552 -OPT:Olimit=0:space=ON" optimize='-O3' ;; *6.2*) # Ragnarok 6.2 - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1174,1184,1552" optimize='none' ;; *) # Be safe and not optimize - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1174,1184,1552 -OPT:Olimit=0" optimize='none' ;; esac @@ -152,6 +157,11 @@ set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /' shift libswanted="$*" +# Irix 6.5.6 seems to have a broken header <sys/mode.h> +# don't include that (it doesn't contain S_IFMT, S_IFREG, et al) + +i_sysmode="$undef" + # I have conflicting reports about the sun, crypt, bsd, and PW # libraries on Irix 6.2. # @@ -228,10 +238,10 @@ EOCBU # The -n32 makes off_t to be 8 bytes, so we should have largefileness. -# This script UU/use64bits.cbu will get 'called-back' by Configure +# This script UU/use64bitint.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. -cat > UU/use64bits.cbu <<'EOCBU' -case "$use64bits" in +cat > UU/use64bitint.cbu <<'EOCBU' +case "$use64bitint" in $define|true|[yY]*) case "`uname -r`" in [1-5]*|6.[01]) @@ -243,15 +253,25 @@ EOM exit 1 ;; esac - case "$cc $ccflags" in - *-n32*) - case "$ccflags" in - *-DUSE_LONG_LONG) ;; - *) ccflags="$ccflags -DUSE_LONG_LONG" ;; - esac - archname64="-n32" - ;; - esac ;; esac EOCBU + +# This script UU/use64bitall.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use 64 bits. +cat > UU/use64bitall.cbu <<'EOCBU' +case "$use64bitall" in +$define|true|[yY]*) + ccflags="`echo $ccflags|sed -e 's%-n32%%'` -64" + ldflags="`echo $ldflags|sed -e 's%-n32%%'` -64" + lddlflags="`echo $ldfdllags|sed -e 's%-n32%%'` -64" + loclibpth="$loclibpth /usr/lib64" + libscheck='case "`file $xxx`" in +*64-bit*) ;; +*) xxx=/no/64-bit$xxx ;; +esac' + ;; +esac +EOCBU + + diff --git a/hints/irix_6_0.sh b/hints/irix_6_0.sh index b34b3ecaff..50498af718 100644 --- a/hints/irix_6_0.sh +++ b/hints/irix_6_0.sh @@ -52,8 +52,8 @@ EOM ;; esac -case "$use64bits" in -$define|true|[yY]*) +case " $use64bits $use64bitint $use64bitall " in +*" $define "*|*" true "*|*" [yY] "*) cat >&4 <<EOM IRIX `uname -r` does not support 64-bit types. You should upgrade to at least IRIX 6.2. diff --git a/hints/irix_6_1.sh b/hints/irix_6_1.sh index 3359639818..50498af718 100644 --- a/hints/irix_6_1.sh +++ b/hints/irix_6_1.sh @@ -52,8 +52,8 @@ EOM ;; esac -case "$use64bits" in -$define|true|[yY]*) +case " $use64bits $use64bitint $use64bitall " in +*" $define "*|*" true "*|*" [yY] "*) cat >&4 <<EOM IRIX `uname -r` does not support 64-bit types. You should upgrade to at least IRIX 6.2. @@ -61,3 +61,4 @@ Cannot continue, aborting. EOM exit 1 esac + diff --git a/hints/linux.sh b/hints/linux.sh index e9af509ab5..82b8703232 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -68,9 +68,6 @@ ignore_versioned_solibs='y' # 9 April 1999 Andy Dougherty <doughera@lafayette.edu> # -# gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool. -ccflags="-Dbool=char -DHAS_BOOL $ccflags" - # BSD compatability library no longer needed # 'kaffe' has a /usr/lib/libnet.so which is not at all relevent for perl. set `echo X "$libswanted "| sed -e 's/ bsd / /' -e 's/ net / /'` diff --git a/hints/rhapsody.sh b/hints/rhapsody.sh index c564c8827e..933081ba09 100644 --- a/hints/rhapsody.sh +++ b/hints/rhapsody.sh @@ -3,57 +3,65 @@ # Wilfredo Sanchez <wsanchez@apple.com> ## -# Since we can build fat, the archname doesn't need the processor type -archname='rhapsody'; +## +# Paths +## -# Perl5.003 precedes this platform -d_bincompat3='undef'; +# BSD paths +prefix='/usr'; +siteprefix='/usr/local'; +vendorprefix='/usr/local'; usevendorprefix='define'; -# Libc is in libsystem. -libc='/System/Library/Frameworks/System.framework/System'; +# 4BSD uses /usr/share/man, not /usr/man. +# Don't put man pages in /usr/lib; that's goofy. +man1dir='/usr/share/man/man1'; +man3dir='/usr/share/man/man3'; + +# Where to put modules. +privlib='/System/Library/Perl'; +sitelib='/Local/Library/Perl'; +vendorlib='/Network/Library/Perl'; + +## +# Tool chain settings +## + +# Since we can build fat, the archname doesn't need the processor type +archname='rhapsody'; # nm works. usenm='true'; + +# Libc is in libsystem. +libc='/System/Library/Frameworks/System.framework/System'; # Optimize. optimize='-O3'; # We have a prototype for telldir. -# We are not NeXTStep. -ccflags="${ccflags} -pipe -fno-common -DHAS_TELLDIR_PROTOTYPE -UNeXT -U__NeXT__"; +ccflags="${ccflags} -pipe -fno-common -DHAS_TELLDIR_PROTOTYPE"; -# Don't use /usr/local/lib; we may have junk there. -libpth='/lib /usr/lib'; - -# Shared library extension in .dylib. -# Bundle extension in .bundle. +# Shared library extension is .dylib. +# Bundle extension is .bundle. ld='cc'; so='dylib'; dlext='bundle'; -dlsrc='dl_rhapsody.xs'; +dlsrc='dl_dyld.xs'; +usedl='define'; cccdlflags=''; lddlflags="${ldflags} -bundle -undefined suppress"; +ldlibpthname='DYLD_LIBRARY_PATH'; useshrplib='true'; -libperl='Perl'; -framework_path='/System/Library/Frameworks/Perl.framework'; base_address='0x4be00000'; -# 4BSD uses /usr/share/man, not /usr/man. -# Don't put man pages in /usr/lib; that's goofy. -man1dir='/usr/share/man/man1'; -man3dir='/usr/share/man/man3'; - -# Where to put modules. -privlib='/System/Library/Perl'; -sitelib='/Local/Library/Perl'; - +## +# System libraries +## + # vfork works usevfork='true'; # malloc works usemymalloc='n'; -case "$ldlibpthname" in -'') ldlibpthname=DYLD_LIBRARY_PATH ;; -esac diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 8c280e3fb7..96bd2d603a 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -333,54 +333,47 @@ EOM esac EOCBU -# This script UU/uselfs.cbu will get 'called-back' by Configure -# after it has prompted the user for whether to use large files. -cat > UU/uselfs.cbu <<'EOCBU' case "$uselargefiles" in -$define|true|[yY]*) - lfcflags="`getconf LFS_CFLAGS 2>/dev/null`" - lfldflags="`getconf LFS_LDFLAGS 2>/dev/null`" - lflibs="`getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" - case "$lfcflags$lfldflags$lflibs" in - '');; - *) uselonglong="$define" - echo "(Large files in Solaris require also long longs, using long longs...)" - ccflags="$ccflags -DUSE_LONG_LONG $lfcflags" - ldflags="$ldflags $ldldflags" - libswanted="$libswanted $lflibs" - ;; - esac - lfcflags='' - lfldflags='' - lflibs='' - ;; +''|$define|true|[yY]*) + ccflags="$ccflags `getconf LFS_CFLAGS 2>/dev/null`" + ldflags="$ldflags `getconf LFS_LDFLAGS 2>/dev/null`" + libswanted="$libswanted `getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + ;; esac -EOCBU -# This script UU/use64bits.cbu will get 'called-back' by Configure +# This script UU/use64bitint.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. -cat > UU/use64bits.cbu <<'EOCBU' -case "$use64bits" in +cat > UU/use64bitint.cbu <<'EOCBU' +case "$use64bitint" in $define|true|[yY]*) case "`uname -r`" in - 2.[1-5]) + 2.[1-6]) cat >&4 <<EOM -Solaris `uname -r` does not support 64-bit interfaces. -You should upgrade to at least Solaris 2.6. +Solaris `uname -r` does not support 64-bit integers. +You should upgrade to at least Solaris 2.7. EOM exit 1 ;; esac - case "$ccflags" in - *-DUSE_LONG_LONG*) ;; - *) ccflags="$ccflags -DUSE_LONG_LONG" ;; - esac # When a 64-bit cc becomes available $archname64 # may need setting so that $archname gets it attached. ;; esac EOCBU +case "$use64bitall" in +$define|true|[yY]*) + ccflags="$ccflags `getconf XBS5_LP64_OFF64_CFLAGS`" + ldflags="$ccflags `getconf XBS5_LP64_OFF64_LDFLAGS`" + lddlflags="$lddlflags -G `getconf XBS5_LP64_OFF64_LDFLAGS`" + loclibpth="$loclibpth /usr/lib/sparcv9" + libscheck='case "`file $xxx`" in +*64-bit*|*SPARCV9*) ;; +*) xxx=/no/64-bit$xxx ;; +esac' + ;; +esac + # This is just a trick to include some useful notes. cat > /dev/null <<'End_of_Solaris_Notes' @@ -512,5 +505,51 @@ Date: 25 Jul 1995 12:20:18 GMT Perl 5 compiled out of the box. +7.0) 64-bitness, from Alan Burlison (added by jhi 2000-02-21) + + You need a machine running Solaris 2.7 or above. + + Here's some rules: + + 1. Solaris 2.7 and above will run in either 32 bit or 64 bit mode, + via a reboot. + 2. You can build 64 bit apps whilst running 32 bit mode and vice-versa. + 3. 32 bit apps will run under Solaris running in either 32 or 64 bit mode. + 4. 64 bit apps require Solaris to be running 64 bit mode + 5. It is possible to select the appropriate 32 or 64 bit version of an + app at run-time using isaexec(3). + 6. You can detect the OS mode using "isainfo -v", e.g. + fubar$ isainfo -v # Ultra 30 in 64 bit mode + 64-bit sparcv9 applications + 32-bit sparc applications + 7. To compile 64 bit you need to use the flag "-xarch=v9". + getconf(1) will tell you this, e.g. + fubar$ getconf -a | grep v9 + XBS5_LP64_OFF64_CFLAGS: -xarch=v9 + XBS5_LP64_OFF64_LDFLAGS: -xarch=v9 + XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9 + XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9 + XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9 + XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9 + _XBS5_LP64_OFF64_CFLAGS: -xarch=v9 + _XBS5_LP64_OFF64_LDFLAGS: -xarch=v9 + _XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9 + _XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9 + _XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9 + _XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9 + + > > Now, what should we do, then? Should -Duse64bits in a v9 box cause + > > Perl to compiled in v9 mode? Or should we for compatibility stick + > > with 32 bit builds and let the people in the know to add the -xarch=v9 + > > to ccflags (and ldflags?)? + + > I think the second (explicit) mechanism should be the default. Unless + > you want to allocate more than ~ 4Gb of memory inside Perl, you don't + > need Perl to be a 64-bit app. Put it this way, on a machine running + > Solaris 8, there are 463 executables under /usr/bin, but only 15 of + > those require 64 bit versions - mainly because they invade the kernel + > address space, e.g. adb, kgmon etc. Certainly we don't recommend users + > to build 64 bit apps unless they need the address space. + End_of_Solaris_Notes @@ -52,6 +52,18 @@ S_more_he(pTHX) HeNEXT(he) = 0; } +#ifdef PURIFY + +#define new_HE() (HE*)safemalloc(sizeof(HE)) +#define del_HE(p) safefree((char*)p) + +#else + +#define new_HE() new_he() +#define del_HE(p) del_he(p) + +#endif + STATIC HEK * S_save_hek(pTHX_ const char *str, I32 len, U32 hash) { @@ -87,7 +99,7 @@ Perl_he_dup(pTHX_ HE *e, bool shared) return ret; /* create anew and remember what it is */ - ret = new_he(); + ret = new_HE(); ptr_table_store(PL_ptr_table, e, ret); HeNEXT(ret) = he_dup(HeNEXT(e),shared); @@ -393,7 +405,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has return &HeVAL(entry); } - entry = new_he(); + entry = new_HE(); if (HvSHAREKEYS(hv)) HeKEY_hek(entry) = share_hek(key, klen, hash); else /* gotta do the real thing */ @@ -494,7 +506,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) return entry; } - entry = new_he(); + entry = new_HE(); if (HvSHAREKEYS(hv)) HeKEY_hek(entry) = share_hek(key, klen, hash); else /* gotta do the real thing */ @@ -1062,7 +1074,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) unshare_hek(HeKEY_hek(entry)); else Safefree(HeKEY_hek(entry)); - del_he(entry); + del_HE(entry); } void @@ -1081,7 +1093,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) unshare_hek(HeKEY_hek(entry)); else Safefree(HeKEY_hek(entry)); - del_he(entry); + del_HE(entry); } /* @@ -1236,7 +1248,7 @@ Perl_hv_iternext(pTHX_ HV *hv) char *k; HEK *hek; - xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */ + xhv->xhv_eiter = entry = new_HE(); /* one HE per MAGICAL hash */ Zero(entry, 1, HE); Newz(54, k, HEK_BASESIZE + sizeof(SV*), char); hek = (HEK*)k; @@ -1252,7 +1264,7 @@ Perl_hv_iternext(pTHX_ HV *hv) if (HeVAL(entry)) SvREFCNT_dec(HeVAL(entry)); Safefree(HeKEY_hek(entry)); - del_he(entry); + del_HE(entry); xhv->xhv_eiter = Null(HE*); return Null(HE*); } @@ -1426,7 +1438,7 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) if (i && !*oentry) xhv->xhv_fill--; Safefree(HeKEY_hek(entry)); - del_he(entry); + del_HE(entry); --xhv->xhv_keys; } break; @@ -1473,7 +1485,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) break; } if (!found) { - entry = new_he(); + entry = new_HE(); HeKEY_hek(entry) = save_hek(str, len, hash); HeVAL(entry) = Nullsv; HeNEXT(entry) = *oentry; diff --git a/installperl b/installperl index 00f3df1bbe..387f4b3560 100755 --- a/installperl +++ b/installperl @@ -8,7 +8,7 @@ BEGIN { } use strict; -use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $nonono $versiononly $depth); +use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $nonono $dostrip $versiononly $depth); BEGIN { $Is_VMS = $^O eq 'VMS'; @@ -50,6 +50,7 @@ my $perl_verbase = defined($ENV{PERLNAME_VERBASE}) while (@ARGV) { $nonono = 1 if $ARGV[0] eq '-n'; + $dostrip = 1 if $ARGV[0] eq '-s'; $versiononly = 1 if $ARGV[0] eq '-v'; shift; } @@ -196,7 +197,7 @@ elsif ($^O eq 'mpeix') { elsif ($^O ne 'dos') { safe_unlink("$installbin/$perl_verbase$ver$exe_ext"); copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext"); - strip("$installbin/$perl_verbase$ver$exe_ext") if $^O =~ /^(rhapsody)$/; + strip("$installbin/$perl_verbase$ver$exe_ext"); chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); } else { @@ -259,9 +260,9 @@ foreach my $file (@corefiles) { # HP-UX (at least) needs to maintain execute permissions # on dynamically-loadable libraries. So we do it for all. if (copy_if_diff($file,"$installarchlib/CORE/$file")) { - if ($file =~ /\.(so|\Q$dlext\E)$/) { + if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) { chmod(0555, "$installarchlib/CORE/$file"); - strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody)$/; + strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/; } else { chmod(0444, "$installarchlib/CORE/$file"); } @@ -651,6 +652,8 @@ sub strip { my(@args) = @_; + return unless $dostrip; + my @opts; while (@args && $args[0] =~ /^(-\w+)$/) { push @opts, shift @args; diff --git a/intrpvar.h b/intrpvar.h index e578b1ab19..14037873b9 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -8,10 +8,7 @@ * 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) diff --git a/iperlsys.h b/iperlsys.h index 7b20d5dd5b..d07d525edc 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -597,6 +597,7 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*, 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 @@ -618,6 +619,7 @@ struct IPerlEnv LPEnvOsID pEnvOsID; LPEnvLibPath pLibPath; LPEnvSiteLibPath pSiteLibPath; + LPEnvGetChildIO pGetChildIO; #endif }; @@ -663,6 +665,8 @@ struct IPerlEnvInfo (*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 */ @@ -686,6 +690,7 @@ struct IPerlEnvInfo #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 */ diff --git a/lib/Carp.pm b/lib/Carp.pm index eaa4d53d8a..43524ddbe5 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -94,7 +94,7 @@ sub export_fail { # each function call on the stack. sub longmess { - require Carp::Heavy; + { local $@; require Carp::Heavy; } # XXX fix require to not clear $@? goto &longmess_heavy; } @@ -106,7 +106,7 @@ sub longmess { # you always get a stack trace sub shortmess { # Short-circuit &longmess if called via multiple packages - require Carp::Heavy; + { local $@; require Carp::Heavy; } # XXX fix require to not clear $@? goto &shortmess_heavy; } diff --git a/lib/English.pm b/lib/English.pm index 4e3210b12c..f6e3ec0021 100644 --- a/lib/English.pm +++ b/lib/English.pm @@ -87,7 +87,6 @@ sub import { *EGID *PROGRAM_NAME *PERL_VERSION - *PERL_VERSION_TUPLE *ACCUMULATOR *DEBUGGING *SYSTEM_FD_MAX @@ -97,6 +96,8 @@ sub import { *WARNING *EXECUTABLE_NAME *OSNAME + *LAST_REGEXP_CODE_RESULT + *EXCEPTIONS_BEING_CAUGHT ); # The ground of all being. @ARG is deprecated (5.005 makes @_ lexical) @@ -165,14 +166,15 @@ sub import { # Internals. - *PERL_VERSION = *] ; - *PERL_VERSION_TUPLE = *^V ; + *PERL_VERSION = *^V ; *ACCUMULATOR = *^A ; *COMPILING = *^C ; *DEBUGGING = *^D ; *SYSTEM_FD_MAX = *^F ; *INPLACE_EDIT = *^I ; *PERLDB = *^P ; + *LAST_REGEXP_CODE_RESULT = *^R ; + *EXCEPTIONS_BEING_CAUGHT = *^S ; *BASETIME = *^T ; *WARNING = *^W ; *EXECUTABLE_NAME = *^X ; @@ -183,5 +185,6 @@ sub import { # *ARRAY_BASE = *[ ; # *OFMT = *# ; # *MULTILINE_MATCHING = ** ; +# *OLD_PERL_VERSION = *] ; 1; diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index c5cf7066bf..428a3f7c67 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -455,10 +455,11 @@ EOT my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all - perlmain.c mon.out core so_locations pm_to_blib + perlmain.c mon.out core core.*perl.*.? + *perl.core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def - $(BASEEXT).exp + $(BASEEXT).exp .nfs* .*.c ]); push @m, "\t-$self->{RM_RF} @otherfiles\n"; # See realclean and ext/utils/make_ext for usage of Makefile.old @@ -555,7 +556,7 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC - PERL_INC PERL FULLPERL + PERL_INC PERL FULLPERL FULL_AR / ) { next unless defined $self->{$tmp}; @@ -3179,9 +3180,18 @@ END # then copy that to $(INST_STATIC) and add $(OBJECT) into it. push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; + my $ar; + if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) { + # Prefer the absolute pathed ar if available so that PATH + # doesn't confuse us. Perl itself is built with the full_ar. + $ar = 'FULL_AR'; + } else { + $ar = 'AR'; + } push @m, -q{ $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ - $(CHMOD) $(PERM_RWX) $@ + "\t\$($ar) ".'$(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@'."\n"; + push @m, +q{ $(CHMOD) $(PERM_RWX) $@ }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld }; # Old mechanism - still available: diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index c4b75539bf..cdd8e4b0ad 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -259,7 +259,8 @@ sub full_setup { @Get_from_Config = qw( ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc - lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so exe_ext + lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so + exe_ext full_ar ); my $item; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 4fedd3bb41..49d167dc0b 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -273,7 +273,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline) $BLOCK_re= '\s*(' . join('|', qw( REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE - SCOPE INTERFACE INTERFACE_MACRO C_ARGS + SCOPE INTERFACE INTERFACE_MACRO C_ARGS POST_CALL )) . "|$END)\\s*:"; # Input: ($_, @line) == unparsed input. @@ -284,6 +284,19 @@ sub check_keyword { s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2; } +my ($C_group_rex, $C_arg); +# Group in C (no support for comments or literals) +$C_group_rex = qr/ [({\[] + (?: (?> [^()\[\]{}]+ ) | (?p{ $C_group_rex }) )* + [)}\]] /x ; +# Chunk in C without comma at toplevel (no comments): +$C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) + | (?p{ $C_group_rex }) + | " (?: (?> [^\\"]+ ) + | \\. + )* " # String literal + | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal + )* /xs; if ($WantLineNumbers) { { @@ -372,6 +385,9 @@ sub CASE_handler { $_ = '' ; } +my $process_inout = 1; +my $process_argtypes = 1; + sub INPUT_handler { for (; !/^$BLOCK_re/o; $_ = shift(@line)) { last if /^\s*NOT_IMPLEMENTED_YET/; @@ -394,7 +410,8 @@ sub INPUT_handler { # Check for duplicate definitions blurt ("Error: duplicate definition of argument '$var_name' ignored"), next - if $arg_list{$var_name} ++ ; + if $arg_list{$var_name}++ + or defined $arg_types{$var_name} and not $processing_arg_with_types; $thisdone |= $var_name eq "THIS"; $retvaldone |= $var_name eq "RETVAL"; @@ -418,7 +435,9 @@ sub INPUT_handler { $var_addr{$var_name} = 1; $func_args =~ s/\b($var_name)\b/&$1/; } - if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/) { + if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/ + or $in_out{$var_name} and $in_out{$var_name} eq 'outlist' + and $var_init !~ /\S/) { if ($name_printed) { print ";\n"; } else { @@ -503,6 +522,7 @@ EOF sub CLEANUP_handler() { print_section() } sub PREINIT_handler() { print_section() } +sub POST_CALL_handler() { print_section() } sub INIT_handler() { print_section() } sub GetAliases @@ -872,7 +892,7 @@ sub fetch_para { my $tmp_line; $lastline .= $tmp_line while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>)); - + chomp $lastline; $lastline =~ s/^\s+$//; } @@ -939,15 +959,23 @@ while (fetch_para()) { undef($static); undef($elipsis); undef($wantRETVAL) ; + undef($RETVAL_no_return) ; undef(%arg_list) ; undef(@proto_arg) ; + undef(@arg_with_types) ; + undef($processing_arg_with_types) ; + undef(%arg_types) ; + undef(@in_out) ; + undef(%in_out) ; undef($proto_in_this_xsub) ; undef($scope_in_this_xsub) ; undef($interface); + undef($prepush_done); $interface_macro = 'XSINTERFACE_FUNC' ; $interface_macro_set = 'XSINTERFACE_FUNC_SET' ; $ProtoThisXSUB = $WantPrototypes ; $ScopeThisXSUB = 0; + $xsreturn = 0; $_ = shift(@line); while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) { @@ -967,6 +995,7 @@ while (fetch_para()) { # extract return type, function name and arguments ($ret_type) = TidyType($_); + $RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//; # a function definition needs at least 2 lines blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH @@ -976,7 +1005,7 @@ while (fetch_para()) { $func_header = shift(@line); blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH - unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*$/s; + unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s; ($class, $func_name, $orig_args) = ($1, $2, $3) ; $class = "$4 $class" if $4; @@ -995,40 +1024,98 @@ while (fetch_para()) { %XsubAliases = %XsubAliasValues = %Interfaces = (); $DoSetMagic = 1; - my $temp_args = $orig_args; - $temp_args =~ s/\\\s*//g; - @args = split(/\s*,\s*/, $temp_args); + $orig_args =~ s/\\\s*/ /g; # process line continuations + + my %out_vars; + if ($process_argtypes and $orig_args =~ /\S/) { + my $args = "$orig_args ,"; + if ($args =~ /^( (?p{ $C_arg }) , )* $ /x) { + @args = ($args =~ /\G ( (?p{ $C_arg }) ) , /xg); + for ( @args ) { + s/^\s+//; + s/\s+$//; + my $arg = $_; + my $default; + ($arg, $default) = / ( [^=]* ) ( (?: = .* )? ) /x; + my ($pre, $name) = ($arg =~ /(.*?) \s* \b(\w+) \s* $ /x); + next unless length $pre; + my $out_type; + my $inout_var; + if ($process_inout and s/^(in|in_outlist|outlist)\s+//) { + my $type = $1; + $out_type = $type if $type ne 'in'; + $arg =~ s/^(in|in_outlist|outlist)\s+//; + } + if (/\W/) { # Has a type + push @arg_with_types, $arg; + # warn "pushing '$arg'\n"; + $arg_types{$name} = $arg; + $_ = "$name$default"; + } + $out_vars{$_} = 1 if $out_type eq 'outlist'; + push @in_out, $name if $out_type; + $in_out{$name} = $out_type if $out_type; + } + } else { + @args = split(/\s*,\s*/, $orig_args); + Warn("Warning: cannot parse argument list '$orig_args', fallback to split"); + } + } else { + @args = split(/\s*,\s*/, $orig_args); + for (@args) { + if ($process_inout and s/^(in|in_outlist|outlist)\s+//) { + my $out_type = $1; + next if $out_type eq 'in'; + $out_vars{$_} = 1 if $out_type eq 'outlist'; + push @in_out, $name; + $in_out{$_} = $out_type; + } + } + } if (defined($class)) { my $arg0 = ((defined($static) or $func_name eq 'new') ? "CLASS" : "THIS"); unshift(@args, $arg0); - ($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/; + ($report_args = "$arg0, $report_args") =~ s/^\w+, $/$arg0/; } - $orig_args =~ s/"/\\"/g; - $min_args = $num_args = @args; - foreach $i (0..$num_args-1) { + my $extra_args = 0; + @args_num = (); + $num_args = 0; + my $report_args = ''; + foreach $i (0 .. $#args) { if ($args[$i] =~ s/\.\.\.//) { $elipsis = 1; - $min_args--; - if ($args[$i] eq '' && $i == $num_args - 1) { + if ($args[$i] eq '' && $i == $#args) { + $report_args .= ", ..."; pop(@args); last; } } + if ($out_vars{$args[$i]}) { + push @args_num, undef; + } else { + push @args_num, ++$num_args; + $report_args .= ", $args[$i]"; + } if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) { - $min_args--; + $extra_args++; $args[$i] = $1; $defaults{$args[$i]} = $2; $defaults{$args[$i]} =~ s/"/\\"/g; } $proto_arg[$i+1] = "\$" ; } - if (defined($class)) { - $func_args = join(", ", @args[1..$#args]); - } else { - $func_args = join(", ", @args); + $min_args = $num_args - $extra_args; + $report_args =~ s/"/\\"/g; + $report_args =~ s/^,\s+//; + my @func_args = @args; + shift @func_args if defined($class); + + for (@func_args) { + s/^/&/ if $in_out{$_}; } - @args_match{@args} = 1..@args; + $func_args = join(", ", @func_args); + @args_match{@args} = @args_num; $PPCODE = grep(/^\s*PPCODE\s*:/, @line); $CODE = grep(/^\s*CODE\s*:/, @line); @@ -1039,6 +1126,8 @@ while (fetch_para()) { $ALIAS = grep(/^\s*ALIAS\s*:/, @line); $INTERFACE = grep(/^\s*INTERFACE\s*:/, @line); + $xsreturn = 1 if $EXPLICIT_RETURN; + # print function header print Q<<"EOF"; #XS(XS_${Full_func_name}) @@ -1069,12 +1158,12 @@ EOF if ($ALIAS) { print Q<<"EOF" if $cond } # if ($cond) -# Perl_croak(aTHX_ "Usage: %s($orig_args)", GvNAME(CvGV(cv))); +# Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv))); EOF else { print Q<<"EOF" if $cond } # if ($cond) -# Perl_croak(aTHX_ "Usage: $pname($orig_args)"); +# Perl_croak(aTHX_ "Usage: $pname($report_args)"); EOF print Q<<"EOF" if $PPCODE; @@ -1137,6 +1226,12 @@ EOF if $WantOptimize and $targetable{$type_kind{$ret_type}}; } + if (@arg_with_types) { + unshift @line, @arg_with_types, $_; + $_ = ""; + $processing_arg_with_types = 1; + INPUT_handler() ; + } print $deferred; process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; @@ -1178,10 +1273,12 @@ EOF } # do output variables - $gotRETVAL = 0; - undef $RETVAL_code ; + $gotRETVAL = 0; # 1 if RETVAL seen in OUTPUT section; + undef $RETVAL_code ; # code to set RETVAL (from OUTPUT section); + # $wantRETVAL set if 'RETVAL =' autogenerated + ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return; undef %outargs ; - process_keyword("OUTPUT|ALIAS|PROTOTYPE"); + process_keyword("POST_CALL|OUTPUT|ALIAS|PROTOTYPE"); # all OUTPUT done, so now push the return value on the stack if ($gotRETVAL && $RETVAL_code) { @@ -1198,6 +1295,7 @@ EOF warn $@ if $@; print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n"; + $prepush_done = 1; } elsif ($t) { my $what = eval qq("$t->[2]"); @@ -1208,6 +1306,7 @@ EOF $size = eval qq("$size"); warn $@ if $@; print "\tXSprePUSH; PUSH$t->[0]($what$size);\n"; + $prepush_done = 1; } else { # RETVAL almost never needs SvSETMAGIC() @@ -1215,6 +1314,14 @@ EOF } } + $xsreturn = 1 if $ret_type ne "void"; + my $num = $xsreturn; + my $c = @in_out; + print "\tXSprePUSH;" if $c and not $prepush_done; + print "\tEXTEND(SP,$c);\n" if $c; + $xsreturn += $c; + generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out; + # do cleanup process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; @@ -1250,9 +1357,9 @@ EOF # Perl_croak(aTHX_ errbuf); EOF - if ($ret_type ne "void" or $EXPLICIT_RETURN) { + if ($xsreturn) { print Q<<EOF unless $PPCODE; -# XSRETURN(1); +# XSRETURN($xsreturn); EOF } else { print Q<<EOF unless $PPCODE; @@ -1469,7 +1576,11 @@ sub generate_init { eval qq/print "\\t$var;\\n"/; warn $@ if $@; } - $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; + if ($defaults{$var} eq 'NO_INIT') { + $deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/; + } else { + $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; + } warn $@ if $@; } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) { if ($name_printed) { @@ -1489,7 +1600,7 @@ sub generate_init { } sub generate_output { - local($type, $num, $var, $do_setmagic) = @_; + local($type, $num, $var, $do_setmagic, $do_push) = @_; local($arg) = "ST(" . ($num - ($num != 0)) . ")"; local($argoff) = $num - 1; local($ntype); @@ -1528,8 +1639,8 @@ sub generate_output { # mortalize it. eval "print qq\a$expr\a"; warn $@ if $@; - print "\tsv_2mortal(ST(0));\n"; - print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; + print "\tsv_2mortal(ST($num));\n"; + print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic; } elsif ($expr =~ /^\s*\$arg\s*=/) { # We expect that $arg has refcnt >=1, so we need @@ -1550,6 +1661,13 @@ sub generate_output { # new mortals don't have set magic } } + elsif ($do_push) { + print "\tPUSHs(sv_newmortal());\n"; + $arg = "ST($num)"; + eval "print qq\a$expr\a"; + warn $@ if $@; + print "\tSvSETMAGIC($arg);\n" if $do_setmagic; + } elsif ($arg =~ /^ST\(\d+\)$/) { eval "print qq\a$expr\a"; warn $@ if $@; diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index e1f3c175ab..14da25a773 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -218,6 +218,174 @@ sub path { return split(/,/, $ENV{Commands}); } +=item splitpath + +=cut + +sub splitpath { + my ($self,$path, $nofile) = @_; + + my ($volume,$directory,$file) = ('','',''); + + if ( $nofile ) { + ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|$))?)(.*)@; + } + else { + $path =~ + m@^( (?: [^:]+: )? ) + ( (?: .*: )? ) + ( .* ) + @x; + $volume = $1; + $directory = $2; + $file = $3; + } + + # Make sure non-empty volumes and directories end in ':' + $volume .= ':' if $volume =~ m@[^:]$@ ; + $directory .= ':' if $directory =~ m@[^:]$@ ; + return ($volume,$directory,$file); +} + + +=item splitdir + +=cut + +sub splitdir { + my ($self,$directories) = @_ ; + # + # split() likes to forget about trailing null fields, so here we + # check to be sure that there will not be any before handling the + # simple case. + # + if ( $directories !~ m@:$@ ) { + return split( m@:@, $directories ); + } + else { + # + # since there was a trailing separator, add a file name to the end, + # then do the split, then replace it with ''. + # + my( @directories )= split( m@:@, "${directories}dummy" ) ; + $directories[ $#directories ]= '' ; + return @directories ; + } +} + + +=item catpath + +=cut + +sub catpath { + my $self = shift ; + + my $result = shift ; + $result =~ s@^([^/])@/$1@ ; + + my $segment ; + for $segment ( @_ ) { + if ( $result =~ m@[^/]$@ && $segment =~ m@^[^/]@ ) { + $result .= "/$segment" ; + } + elsif ( $result =~ m@/$@ && $segment =~ m@^/@ ) { + $result =~ s@/+$@/@; + $segment =~ s@^/+@@; + $result .= "$segment" ; + } + else { + $result .= $segment ; + } + } + + return $result ; +} + +=item abs2rel + +=cut + +sub abs2rel { + my($self,$path,$base) = @_; + + # Clean up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + $path = $self->rel2abs( $path ) ; + } + + # Figure out the effective $base and clean it up. + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + + # Now, remove all leading components that are the same + my @pathchunks = $self->splitdir( $path ); + my @basechunks = $self->splitdir( $base ); + + while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) { + shift @pathchunks ; + shift @basechunks ; + } + + $path = join( ':', @pathchunks ); + + # @basechunks now contains the number of directories to climb out of. + $base = ':' x @basechunks ; + + return "$base:$path" ; +} + +=item rel2abs + +Converts a relative path to an absolute path. + + $abs_path = $File::Spec->rel2abs( $destination ) ; + $abs_path = $File::Spec->rel2abs( $destination, $base ) ; + +If $base is not present or '', then L<cwd()> is used. If $base is relative, +then it is converted to absolute form using L</rel2abs()>. This means that it +is taken to be relative to L<cwd()>. + +On systems with the concept of a volume, this assumes that both paths +are on the $base volume, and ignores the $destination volume. + +On systems that have a grammar that indicates filenames, this ignores the +$base filename as well. Otherwise all path components are assumed to be +directories. + +If $path is absolute, it is cleaned up and returned using L</canonpath()>. + +Based on code written by Shigio Yamaguchi. + +No checks against the filesystem are made. + +=cut + +sub rel2abs($;$;) { + my ($self,$path,$base ) = @_; + + if ( ! $self->file_name_is_absolute( $path ) ) { + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + else { + $base = $self->canonpath( $base ) ; + } + + $path = $self->canonpath("$base$path") ; + } + + return $path ; +} + + =back =head1 SEE ALSO diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 85df2c2d3b..d47a60e9cc 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -26,28 +26,15 @@ No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminated successive slashes and successive "/.". $cpath = File::Spec->canonpath( $path ) ; - $cpath = File::Spec->canonpath( $path, $reduce_ricochet ) ; - -If $reduce_ricochet is present and true, then "dirname/.." -constructs are eliminated from the path. Without $reduce_ricochet, -if dirname is a symbolic link, then "a/dirname/../b" will often -take you to someplace other than "a/b". This is sometimes desirable. -If it's not, setting $reduce_ricochet causes the "dirname/.." to -be removed from this path, resulting in "a/b". This may make -your perl more portable and robust, unless you want to -ricochet (some scripts depend on it). =cut sub canonpath { - my ($self,$path,$reduce_ricochet) = @_; + my ($self,$path) = @_; $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx - if ( $reduce_ricochet ) { - while ( $path =~ s@[^/]+/\.\.(?:/|$)@@ ) {}# xx/.. -> xx - } $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx return $path; } @@ -281,8 +268,8 @@ sub splitdir { =item catpath Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and this is just like catfile(). On other OSs, -the $volume become significant. +Unix, $volume is ignored, and directory and file are catenated. A '/' is +inserted if need be. On other OSs, $volume is significant. =cut diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 79491463cd..71c38f222f 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -263,6 +263,220 @@ sub file_name_is_absolute { $file =~ /:[^<\[]/); } +=item splitpath + + ($volume,$directories,$file) = File::Spec->splitpath( $path ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + +Splits a VMS path in to volume, directory, and filename portions. +Ignores $no_file, if present, since VMS paths indicate the 'fileness' of a +file. + +The results can be passed to L</catpath()> to get back a path equivalent to +(usually identical to) the original path. + +=cut + +sub splitpath { + my $self = shift ; + my ($path, $nofile) = @_; + + my ($volume,$directory,$file) ; + + if ( $path =~ m{/} ) { + $path =~ + m{^ ( (?: /[^/]* )? ) + ( (?: .*/(?:[^/]+.dir)? )? ) + (.*) + }x; + $volume = $1; + $directory = $2; + $file = $3; + } + else { + $path =~ + m{^ ( (?: (?: (?: [\w\$-]+ (?: "[^"]*")?:: )? [\w\$-]+: )? ) ) + ( (?:\[.*\])? ) + (.*) + }x; + $volume = $1; + $directory = $2; + $file = $3; + } + + $directory = $1 + if $directory =~ /^\[(.*)\]$/ ; + + return ($volume,$directory,$file); +} + + +=item splitdir + +The opposite of L</catdir()>. + + @dirs = File::Spec->splitdir( $directories ); + +$directories must be only the directory portion of the path. + +'[' and ']' delimiters are optional. An empty string argument is +equivalent to '[]': both return an array with no elements. + +=cut + +sub splitdir { + my $self = shift ; + my $directories = $_[0] ; + + return File::Spec::Unix::splitdir( $self, @_ ) + if ( $directories =~ m{/} ) ; + + $directories =~ s/^\[(.*)\]$/$1/ ; + + # + # split() likes to forget about trailing null fields, so here we + # check to be sure that there will not be any before handling the + # simple case. + # + if ( $directories !~ m{\.$} ) { + return split( m{\.}, $directories ); + } + else { + # + # since there was a trailing separator, add a file name to the end, + # then do the split, then replace it with ''. + # + my( @directories )= split( m{\.}, "${directories}dummy" ) ; + $directories[ $#directories ]= '' ; + return @directories ; + } +} + + +sub catpath { + my $self = shift; + + return File::Spec::Unix::catpath( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my ($volume,$directory,$file) = @_; + + $volume .= ':' + if $volume =~ /[^:]$/ ; + + $directory = "[$directory" + if $directory =~ /^[^\[]/ ; + + $directory .= ']' + if $directory =~ /[^\]]$/ ; + + return "$volume$directory$file" ; +} + + +sub abs2rel { + my $self = shift; + + return File::Spec::Unix::abs2rel( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my($path,$base) = @_; + + # Note: we use '/' to glue things together here, then let canonpath() + # clean them up at the end. + + # Clean up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + $path = $self->rel2abs( $path ) ; + } + else { + $path = $self->canonpath( $path ) ; + } + + # Figure out the effective $base and clean it up. + if ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + elsif ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + else { + $base = $self->canonpath( $base ) ; + } + + # Split up paths + my ( undef, $path_directories, $path_file ) = + $self->splitpath( $path, 1 ) ; + + $path_directories = $1 + if $path_directories =~ /^\[(.*)\]$/ ; + + my ( undef, $base_directories, undef ) = + $self->splitpath( $base, 1 ) ; + + $base_directories = $1 + if $base_directories =~ /^\[(.*)\]$/ ; + + # Now, remove all leading components that are the same + my @pathchunks = $self->splitdir( $path_directories ); + my @basechunks = $self->splitdir( $base_directories ); + + while ( @pathchunks && + @basechunks && + lc( $pathchunks[0] ) eq lc( $basechunks[0] ) + ) { + shift @pathchunks ; + shift @basechunks ; + } + + # @basechunks now contains the directories to climb out of, + # @pathchunks now has the directories to descend in to. + $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; + $path_directories =~ s{\.$}{} ; + return $self->catpath( '', $path_directories, $path_file ) ; +} + + +sub rel2abs($;$;) { + my $self = shift ; + return File::Spec::Unix::rel2abs( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my ($path,$base ) = @_; + # Clean up and split up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + # Figure out the effective $base and clean it up. + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + else { + $base = $self->canonpath( $base ) ; + } + + # Split up paths + my ( undef, $path_directories, $path_file ) = + $self->splitpath( $path ) ; + + my ( $base_volume, $base_directories, undef ) = + $self->splitpath( $base ) ; + + my $sep = '' ; + $sep = '.' + if ( $base_directories =~ m{[^.]$} && + $path_directories =~ m{^[^.]} + ) ; + $base_directories = "$base_directories$sep$path_directories" ; + + $path = $self->catpath( $base_volume, $base_directories, $path_file ); + } + + return $self->canonpath( $path ) ; +} + + =back =head1 SEE ALSO diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 120b799cd2..f1c6ccf8c7 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -95,7 +95,7 @@ path. On UNIX eliminated successive slashes and successive "/.". =cut sub canonpath { - my ($self,$path,$reduce_ricochet) = @_; + my ($self,$path) = @_; $path =~ s/^([a-z]:)/\u$1/; $path =~ s|/|\\|g; $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx @@ -120,7 +120,7 @@ Separators accepted are \ and /. Volumes can be drive letters or UNC sharenames (\\server\share). -The results can be passed to L</catpath()> to get back a path equivalent to +The results can be passed to L</catpath> to get back a path equivalent to (usually identical to) the original path. =cut @@ -130,21 +130,21 @@ sub splitpath { my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $path =~ - m@^( (?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+)? ) + m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) (.*) - @x; + }x; $volume = $1; $directory = $2; } else { $path =~ - m@^ ( (?: [a-zA-Z]: | - (?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+ + m{^ ( (?: [a-zA-Z]: | + (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? ) ( (?:.*[\\\\/](?:\.\.?$)?)? ) (.*) - @x; + }x; $volume = $1; $directory = $2; $file = $3; @@ -221,8 +221,8 @@ sub catpath { # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:$@ && - $volume !~ m@[\\/]$@ && - $file !~ m@^[\\/]@ + $volume =~ m@[^\\/]$@ && + $file =~ m@[^\\/]@ ) { $volume =~ m@([\\/])@ ; my $sep = $1 ? $1 : '\\' ; @@ -248,7 +248,7 @@ then it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()>. On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. +are on the $destination volume, and ignores the $base volume. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be @@ -325,8 +325,11 @@ sub abs2rel { $path_directories = "$base_directories$path_directories" ; } + # It makes no sense to add a relative path to a UNC volume + $path_volume = '' unless $path_volume =~ m{^[A-Z]:}i ; + return $self->canonpath( - $self->catpath( $path_volume, $path_directories, $path_file ) + $self->catpath($path_volume, $path_directories, $path_file ) ) ; } @@ -359,10 +362,8 @@ No checks against the filesystem are made. sub rel2abs($;$;) { my ($self,$path,$base ) = @_; - # Clean up and split up $path if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. if ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } @@ -373,7 +374,6 @@ sub rel2abs($;$;) { $base = $self->canonpath( $base ) ; } - # Split up paths my ( undef, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index c661c7527e..b5f980bba7 100644 --- a/lib/Pod/Checker.pm +++ b/lib/Pod/Checker.pm @@ -10,7 +10,7 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.096; ## Current version of this package +$VERSION = 1.097; ## Current version of this package require 5.004; ## requires this Perl version or later use Pod::ParseUtils; ## for hyperlinks and lists @@ -111,6 +111,11 @@ very robust conversions. =over 4 +=item * empty =headn + +A heading (C<=head1> or C<=head2>) without any text? That ain't no +heading! + =item * =over on line I<N> without closing =back The C<=over> command does not have a corresponding C<=back> before the @@ -134,7 +139,7 @@ A standalone C<=end> command was found. =item * Nested =begin's -There were at least two concecutive C<=begin> commands without +There were at least two consecutive C<=begin> commands without the corresponding C<=end>. Only one C<=begin> may be active at a time. @@ -168,13 +173,29 @@ does not make sense. =item * garbled entity I<STRING> -The I<STRING> found cannot be interpreted as an character entity. +The I<STRING> found cannot be interpreted as a character entity. + +=item * Entity number out of range + +An entity specified by number (dec, hex, oct) is out of range (1-255). =item * malformed link LE<lt>E<gt> The link found cannot be parsed because it does not conform to the syntax described in L<perlpod>. +=item * nonempty ZE<lt>E<gt> + +The C<ZE<lt>E<gt>> sequence is supposed to be empty. + +=item * Spurious text after =pod / =cut + +The commands C<=pod> and C<=cut> do not take any arguments. + +=item * Spurious character(s) after =back + +The C<=back> command does not take any arguments. + =back =head2 Warnings @@ -183,14 +204,43 @@ These may not necessarily cause trouble, but indicate mediocre style. =over 4 +=item * multiple occurence of link target I<name> + +The POD file has some C<=item> and/or C<=head> commands that have +the same text. Potential hyperlinks to such a text cannot be unique then. + +=item * line containing nothing but whitespace in paragraph + +There is some whitespace on a seemingly empty line. POD is very sensitive +to such things, so this is flagged. B<vi> users switch on the B<list> +option to avoid this problem. + +=item * file does not start with =head + +The file starts with a different POD directive than head. +This is most probably something you do not want. + =item * No numeric argument for =over The C<=over> command is supposed to have a numeric argument (the indentation). -=item * Spurious character(s) after =back +=item * previous =item has no contents -The C<=back> command does not take any arguments. +There is a list C<=item> right above the flagged line that has no +text contents. You probably want to delete empty items. + +=item * preceding non-item paragraph(s) + +A list introduced by C<=over> starts with a text or verbatim paragraph, +but continues with C<=item>s. Move the non-item paragraph out of the +C<=over>/C<=back> block. + +=item * =item type mismatch (I<one> vs. I<two>) + +A list started with e.g. a bulletted C<=item> and continued with a +numbered one. This is obviously inconsistent. For most translators the +type of the I<first> C<=item> determines the type of the list. =item * I<N> unescaped C<E<lt>E<gt>> in paragraph @@ -198,14 +248,14 @@ Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> can potentially cause errors as they could be misinterpreted as markup commands. -=item * Non-standard entity +=item * Unknown entity A character entity was found that does not belong to the standard -ISO set. +ISO set or the POD specials C<verbar> and C<sol>. =item * No items in =over -The list does not contain any items. +The list opened with C<=over> does not contain any items. =item * No argument for =item @@ -214,6 +264,12 @@ by C<*> to indicate an unordered list, by a number (optionally followed by a dot) to indicate an ordered (numbered) list or simple text for a definition list. +=item * empty section in previous paragraph + +The previous section (introduced by a C<=head> command) does not contain +any text. This usually indicates that something is missing. Note: A +C<=head1> followed immediately by C<=head2> does not trigger this warning. + =item * Verbatim paragraph in NAME section The NAME section (C<=head1 NAME>) should consist of a single paragraph @@ -395,6 +451,10 @@ my %ENTITIES = ( iquest => '¿', 'times' => '×', # times is a keyword in perl divide => '÷', + +# some POD special entities + verbar => '|', + sol => '/' ); ##--------------------------------------------------------------------------- @@ -413,6 +473,7 @@ sub podchecker( $ ; $ % ) { ## Now create a pod checker my $checker = new Pod::Checker(%options); + $checker->parseopts(-process_cut_cmd => 1); ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); @@ -427,15 +488,15 @@ sub podchecker( $ ; $ % ) { ## Method definitions begin here ##------------------------------- -sub new { - my $this = shift; - my $class = ref($this) || $this; - my %params = @_; - my $self = {%params}; - bless $self, $class; - $self->initialize(); - return $self; -} +## sub new { +## my $this = shift; +## my $class = ref($this) || $this; +## my %params = @_; +## my $self = {%params}; +## bless $self, $class; +## $self->initialize(); +## return $self; +## } sub initialize { my $self = shift; @@ -462,6 +523,10 @@ sub poderror { chomp( my $msg = ($opts{-msg} || "")."@_" ); my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ""; my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ""; + unless (exists $opts{-severity}) { + ## See if can find severity in message prefix + $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); + } my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ""; ## Increment error count and print message " @@ -487,9 +552,12 @@ sub name { sub node { my ($self,$text) = @_; if(defined $text) { - $text =~ s/[\s\n]+$//; # strip trailing whitespace - # add node + $text =~ s/\s+$//s; # strip trailing whitespace + $text =~ s/\s+/ /gs; # collapse whitespace + # add node, order important! push(@{$self->{_nodes}}, $text); + # keep also a uniqueness counter + $self->{_unique_nodes}->{$text}++; return $text; } @{$self->{_nodes}}; @@ -508,56 +576,63 @@ sub hyperlink { ## overrides for Pod::Parser sub end_pod { - ## Do some final checks and - ## print the number of errors found - my $self = shift; - my $infile = $self->input_file(); - my $out_fh = $self->output_handle(); - - if(@{$self->{_list_stack}}) { - # _TODO_ display, but don't count them for now - my $list; - while($list = shift(@{$self->{_list_stack}})) { - $self->poderror({ -line => 'EOF', -file => $infile, - -severity => 'ERROR', -msg => "=over on line " . - $list->start() . " without closing =back" }); #" - } - } - - # check validity of document internal hyperlinks - # first build the node names from the paragraph text - my %nodes; - foreach($self->node()) { - $nodes{$_} = 1; - if(/^(\S+)\s+/) { - # we have more than one word. Use the first as a node, too. - # This is used heavily in perlfunc.pod - $nodes{$1} ||= 2; # derived node - } - } - foreach($self->hyperlink()) { - my $line = ''; - s/^(\d+):// && ($line = $1); - if($_ && !$nodes{$_}) { - $self->poderror({ -line => $line, -file => $infile, - -severity => 'ERROR', - -msg => "unresolved internal link `$_'"}); - } - } - - ## Print the number of errors found - my $num_errors = $self->num_errors(); - if ($num_errors > 0) { - printf $out_fh ("$infile has $num_errors pod syntax %s.\n", + ## Do some final checks and + ## print the number of errors found + my $self = shift; + my $infile = $self->input_file(); + my $out_fh = $self->output_handle(); + + if(@{$self->{_list_stack}}) { + # _TODO_ display, but don't count them for now + my $list; + while(($list = $self->_close_list('EOF',$infile)) && + $list->indent() ne 'auto') { + $self->poderror({ -line => 'EOF', -file => $infile, + -severity => 'ERROR', -msg => "=over on line " . + $list->start() . " without closing =back" }); #" + } + } + + # check validity of document internal hyperlinks + # first build the node names from the paragraph text + my %nodes; + foreach($self->node()) { + $nodes{$_} = 1; + if(/^(\S+)\s+/) { + # we have more than one word. Use the first as a node, too. + # This is used heavily in perlfunc.pod + $nodes{$1} ||= 2; # derived node + } + } + foreach($self->hyperlink()) { + my $line = ''; + s/^(\d+):// && ($line = $1); + if($_ && !$nodes{$_}) { + $self->poderror({ -line => $line, -file => $infile, + -severity => 'ERROR', + -msg => "unresolved internal link '$_'"}); + } + } + foreach(grep($self->{_unique_nodes}->{$_} > 1, + keys %{$self->{_unique_nodes}})) { + $self->poderror({ -line => '-', -file => $infile, + -severity => 'WARNING', + -msg => "multiple occurence of link target '$_'"}); + } + + ## Print the number of errors found + my $num_errors = $self->num_errors(); + if ($num_errors > 0) { + printf $out_fh ("$infile has $num_errors pod syntax %s.\n", ($num_errors == 1) ? "error" : "errors"); - } - elsif($self->{_commands} == 0) { - print $out_fh "$infile does not contain any pod commands.\n"; - $self->num_errors(-1); - } - else { - print $out_fh "$infile pod syntax OK.\n"; - } + } + elsif($self->{_commands} == 0) { + print $out_fh "$infile does not contain any pod commands.\n"; + $self->num_errors(-1); + } + else { + print $out_fh "$infile pod syntax OK.\n"; + } } # check a POD command directive @@ -568,10 +643,15 @@ sub command { my $arg; # this will hold the command argument if (! $VALID_COMMANDS{$cmd}) { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => "Unknown command \"$cmd\"" }); + -msg => "Unknown command '$cmd'" }); } else { - $self->{_commands}++; # found a valid command + # found a valid command + if(!$self->{_commands}++ && $cmd !~ /^head/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "file does not start with =head" }); + } ## check syntax of particular command if($cmd eq 'over') { # check for argument @@ -585,10 +665,7 @@ sub command { -msg => "No numeric argument for =over"}); } # start a new list - unshift(@{$self->{_list_stack}}, Pod::List->new( - -indent => $indent, - -start => $line, - -file => $file)); + $self->_open_list($indent,$line,$file); } elsif($cmd eq 'item') { # are we in a list? @@ -597,22 +674,60 @@ sub command { -severity => 'ERROR', -msg => "=item without previous =over" }); # auto-open in case we encounter many more - unshift(@{$self->{_list_stack}}, - Pod::List->new( - -indent => 'auto', - -start => $line, - -file => $file)); + $self->_open_list('auto',$line,$file); + } + my $list = $self->{_list_stack}->[0]; + # check whether the previous item had some contents + if(defined $self->{_list_item_contents} && + $self->{_list_item_contents} == 0) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "previous =item has no contents" }); + } + if($list->{_has_par}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "preceding non-item paragraph(s)" }); + delete $list->{_has_par}; } # check for argument $arg = $self->interpolate_and_check($paragraph, $line, $file); - unless($arg && $arg =~ /(\S+)/) { + if($arg && $arg =~ /(\S+)/) { + $arg =~ s/[\s\n]+$//; + my $type; + if($arg =~ /^[*]\s*(\S*.*)/) { + $type = 'bullet'; + $self->{_list_item_contents} = $1 ? 1 : 0; + $arg = $1; + } + elsif($arg =~ /^\d+\.?\s*(\S*)/) { + $type = 'number'; + $self->{_list_item_contents} = $1 ? 1 : 0; + $arg = $1; + } + else { + $type = 'definition'; + $self->{_list_item_contents} = 1; + } + my $first = $list->type(); + if($first && $first ne $type) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "=item type mismatch ('$first' vs. '$type')"}); + } + else { # first item + $list->type($type); + } + } + else { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', -msg => "No argument for =item" }); $arg = ' '; # empty + $self->{_list_item_contents} = 0; } # add this item - $self->{_list_stack}[0]->item($arg); + $list->item($arg); # remember this node $self->node($arg); } @@ -628,11 +743,11 @@ sub command { $arg = $self->interpolate_and_check($paragraph, $line,$file); if($arg && $arg =~ /\S/) { $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', + -severity => 'ERROR', -msg => "Spurious character(s) after =back" }); } # close list - my $list = shift @{$self->{_list_stack}}; + my $list = $self->_close_list($line,$file); # check for empty lists if(!$list->item() && $self->{-warnings}) { $self->poderror({ -line => $line, -file => $file, @@ -642,11 +757,22 @@ sub command { } } } - elsif($cmd =~ /^head/) { + elsif($cmd =~ /^head(\d+)/) { + if(defined $self->{_commands_in_head} && + $self->{_commands_in_head} == 0 && + defined $self->{_last_head} && + $self->{_last_head} >= $1) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "empty section in previous paragraph"}); + } + $self->{_commands_in_head} = -1; + $self->{_last_head} = $1; # check if there is an open list if(@{$self->{_list_stack}}) { my $list; - while($list = shift(@{$self->{_list_stack}})) { + while(($list = $self->_close_list($line,$file)) && + $list->indent() ne 'auto') { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', -msg => "=over on line ". $list->start() . @@ -655,9 +781,14 @@ sub command { } # remember this node $arg = $self->interpolate_and_check($paragraph, $line,$file); - $self->node($arg) if($arg); + $arg =~ s/[\s\n]+$//s; + $self->node($arg); + unless(length($arg)) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "empty =$cmd"}); + } if($cmd eq 'head1') { - $arg =~ s/[\s\n]+$//; $self->{_current_head1} = $arg; } else { $self->{_current_head1} = ''; @@ -711,12 +842,48 @@ sub command { } $arg = ''; # do not expand paragraph below } + elsif($cmd =~ /^(pod|cut)$/) { + # check for argument + $arg = $self->interpolate_and_check($paragraph, $line,$file); + if($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "Spurious text after =$cmd"}); + } + } + $self->{_commands_in_head}++; ## Check the interior sequences in the command-text $self->interpolate_and_check($paragraph, $line,$file) unless(defined $arg); } } +sub _open_list +{ + my ($self,$indent,$line,$file) = @_; + my $list = Pod::List->new( + -indent => $indent, + -start => $line, + -file => $file); + unshift(@{$self->{_list_stack}}, $list); + undef $self->{_list_item_contents}; + $list; +} + +sub _close_list +{ + my ($self,$line,$file) = @_; + my $list = shift(@{$self->{_list_stack}}); + if(defined $self->{_list_item_contents} && + $self->{_list_item_contents} == 0) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "previous =item has no contents" }); + } + undef $self->{_list_item_contents}; + $list; +} + # process a block of some text sub interpolate_and_check { my ($self, $paragraph, $line, $file) = @_; @@ -754,7 +921,7 @@ sub _check_ptree { if (! $VALID_SEQUENCES{$cmd}) { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => qq(Unknown interior-sequence "$cmd")}); + -msg => qq(Unknown interior-sequence '$cmd')}); # expand it anyway $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); next; @@ -775,9 +942,28 @@ sub _check_ptree { next; } my $ent = $$contents[0]; - if($ent =~ /^\d+$/) { + my $val; + if($ent =~ /^0x[0-9a-f]+$/i) { + # hexadec entity + $val = hex($ent); + } + elsif($ent =~ /^0\d+$/) { + # octal + $val = oct($ent); + } + elsif($ent =~ /^\d+$/) { # numeric entity - $text .= chr($ent); + $val = $ent; + } + if(defined $val) { + if($val>0 && $val<256) { + $text .= chr($val); + } + else { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "Entity number out of range " . $_->raw_text()}); + } } elsif($ENTITIES{$ent}) { # known ISO entity @@ -786,7 +972,7 @@ sub _check_ptree { else { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', - -msg => "Non-standard entity " . $_->raw_text()}); + -msg => "Unknown entity " . $_->raw_text()}); $text .= "E<$ent>"; } } @@ -824,8 +1010,15 @@ sub _check_ptree { # add the guts $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); } - else { - # check, but add nothing to $text (X<>, Z<>) + elsif($cmd eq 'Z') { + if(length($contents->raw_text())) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "Nonempty Z<>"}); + } + } + else { # X<> + # check, but add nothing to $text $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); } } @@ -836,8 +1029,11 @@ sub _check_ptree { # process a block of verbatim text sub verbatim { - ## Nothing to check + ## Nothing particular to check my ($self, $paragraph, $line_num, $pod_para) = @_; + + $self->_preproc_par($paragraph); + if($self->{_current_head1} eq 'NAME') { my ($file, $line) = $pod_para->file_line; $self->poderror({ -line => $line, -file => $file, @@ -851,6 +1047,8 @@ sub textblock { my ($self, $paragraph, $line_num, $pod_para) = @_; my ($file, $line) = $pod_para->file_line; + $self->_preproc_par($paragraph); + # skip this paragraph if in a =begin block unless($self->{_have_begin}) { my $block = $self->interpolate_and_check($paragraph, $line,$file); @@ -863,4 +1061,18 @@ sub textblock { } } +sub _preproc_par +{ + my $self = shift; + $_[0] =~ s/[\s\n]+$//; + if($_[0]) { + $self->{_commands_in_head}++; + $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); + if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { + $self->{_list_stack}->[0]->{_has_par} = 1; + } + } +} + 1; + diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm index 399bbba252..038b090b42 100644 --- a/lib/Pod/Find.pm +++ b/lib/Pod/Find.pm @@ -3,7 +3,8 @@ # # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de> # -# borrowing code from Nick Ing-Simmon's PodToHtml +# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code +# from Nick Ing-Simmon's PodToHtml). All rights reserved. # This file is part of "PodParser". Pod::Find is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -12,8 +13,8 @@ package Pod::Find; use vars qw($VERSION); -$VERSION = 0.10; ## Current version of this package -require 5.005; ## requires this Perl version or later +$VERSION = 0.11; ## Current version of this package +require 5.004; ## requires this Perl version or later ############################################################################# @@ -113,7 +114,9 @@ use vars qw(@ISA @EXPORT_OK $VERSION); # package global variables my $SIMPLIFY_RX; -# return a hash of the +# return a hash of the POD files found +# first argument may be a hashref (options), +# rest is a list of directories to search recursively sub pod_find { my %opts; @@ -145,7 +148,8 @@ sub pod_find # * remove e.g. 5.00503 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) $SIMPLIFY_RX = - qr!^(?i:site_perl/|$Config::Config{archname}/|\d+\.\d+([_.]?\d+)?/|pod/(?=.*?\.pod$))*!o; + qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\$))*!; + } my %dirs_visited; @@ -166,7 +170,7 @@ sub pod_find } next; } - my $root_rx = qr!^\Q$try\E/!; + my $root_rx = qq!^\Q$try\E/!; File::Find::find( sub { my $item = $File::Find::name; if(-d) { diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 4d77bc0a11..e48e9b2825 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -245,6 +245,8 @@ $itemcache = "pod2htmi$cache_ext"; @libpods = (); # files to search for links from C<> directives $htmlroot = "/"; # http-server base directory from which all # relative paths in $podpath stem. +$htmldir = ""; # The directory to which the html pages + # will (eventually) be written. $htmlfile = ""; # write to stdout by default $podfile = ""; # read from stdin by default @podpath = (); # list of directories containing library pods. @@ -616,7 +618,7 @@ sub parse_command_line { $podfile = $opt_infile if defined $opt_infile; $htmlfile = $opt_outfile if defined $opt_outfile; - $htmldir = $opt_htmldir if defined $opt_outfile; + $htmldir = $opt_htmldir if defined $opt_htmldir; @podpath = split(":", $opt_podpath) if defined $opt_podpath; @libpods = split(":", $opt_libpods) if defined $opt_libpods; @@ -1334,7 +1336,7 @@ sub process_puretext { # skip space runs next if $word =~ /^\s*$/; # see if we can infer a link - if( $notinIS && $word =~ s/^(\w+)\((.*)\)\W*$/$1/ ) { + if( $notinIS && $word =~ /^(\w+)\((.*)\)\W*$/ ) { # has parenthesis so should have been a C<> ref ## try for a pagename (perlXXX(1))? if( $2 =~ /^\d+$/ ){ @@ -1786,7 +1788,6 @@ sub coderef($$){ my( $url ); my $fid = fragment_id( $item ); - return( $url, $fid ); if( defined( $page ) ){ # we have been given a $page... $page =~ s{::}{/}g; @@ -1801,10 +1802,12 @@ sub coderef($$){ } else { # no page - local items precede cached items - if( exists $local_items{$fid} ){ - $page = $local_items{$fid}; - } else { - $page = $items{$fid}; + if( defined( $fid ) ){ + if( exists $local_items{$fid} ){ + $page = $local_items{$fid}; + } else { + $page = $items{$fid}; + } } } @@ -1880,10 +1883,11 @@ sub htmlify { # Note: can be called with copy or modify semantics # my %E2c; -$E2c{lt} = '<'; -$E2c{gt} = '>'; -$E2c{sol} = '/'; +$E2c{lt} = '<'; +$E2c{gt} = '>'; +$E2c{sol} = '/'; $E2c{verbar} = '|'; +$E2c{amp} = '&'; # in Tk's pods sub depod1($;$); diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm index 1432895e91..7544fb76c5 100644 --- a/lib/Pod/InputObjects.pm +++ b/lib/Pod/InputObjects.pm @@ -2,7 +2,7 @@ # Pod/InputObjects.pm -- package which defines objects for input streams # and paragraphs and commands when parsing POD docs. # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -11,7 +11,7 @@ package Pod::InputObjects; use vars qw($VERSION); -$VERSION = 1.090; ## Current version of this package +$VERSION = 1.10; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm index a66e8f5e8b..2b3734fef9 100644 --- a/lib/Pod/ParseUtils.pm +++ b/lib/Pod/ParseUtils.pm @@ -1,7 +1,7 @@ ############################################################################# # Pod/ParseUtils.pm -- helpers for POD parsing and conversion # -# Copyright (C) 1999 by Marek Rouchal. All rights reserved. +# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -305,32 +305,38 @@ sub parse { #warn "DEBUG: link=$_\n"; # only page - if(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) { - $page = $1 . $2; + # problem: a lot of people use (), or (1) or the like to indicate + # man page sections. But this collides with L<func()> that is supposed + # to point to an internal funtion... + # I would like the following better, here and below: + #if(m!^(\w+(?:::\w+)*)$!) { + my $page_rx = '[\w.]+(?:::[\w.]+)*'; + if(m!^($page_rx)$!o) { + $page = $1; $type = 'page'; } - # alttext, page and section - elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) { - ($alttext, $page, $node) = ($1, $2 . $3, $4); + # alttext, page and "section" + elsif(m!^(.+?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) { + ($alttext, $page, $node) = ($1, $2, $3); $type = 'section'; } - # page and section - elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) { - ($page, $node) = ($1 . $2, $3); + # page and "section" + elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) { + ($page, $node) = ($1, $2); $type = 'section'; } # page and item - elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) { - ($page, $node) = ($1 . $2, $3); + elsif(m!^($page_rx)\s*/\s*(.+)$!o) { + ($page, $node) = ($1, $2); $type = 'item'; } - # only section - elsif(m!^(?:/\s*|)"(.+)"$!) { + # only "section" + elsif(m!^/?"(.+)"$!) { $node = $1; $type = 'section'; } # only item - elsif(m!^/(.+)$!) { + elsif(m!^\s*/(.+)$!) { $node = $1; $type = 'item'; } @@ -340,16 +346,16 @@ sub parse { $type = 'hyperlink'; } # alttext, page and item - elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) { - ($alttext, $page, $node) = ($1, $2 . $3, $4); + elsif(m!^(.+?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) { + ($alttext, $page, $node) = ($1, $2, $3); $type = 'item'; } # alttext and page - elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) { - ($alttext, $page) = ($1, $2 . $3); + elsif(m!^(.+?)\s*[|]\s*($page_rx)$!o) { + ($alttext, $page) = ($1, $2); $type = 'page'; } - # alttext and section + # alttext and "section" elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) { ($alttext, $node) = ($1,$2); $type = 'section'; @@ -368,9 +374,17 @@ sub parse { $node = $_; $type = 'item'; } + # collapse whitespace in nodes + $node =~ s/\s+/ /gs; - if($page =~ /[(]\w*[)]$/) { - $self->warning("section in `$page' deprecated"); + #if($page =~ /[(]\w*[)]$/) { + # $self->warning("section in '$page' deprecated"); + #} + if($node =~ m:[|/]:) { + $self->warning("node '$node' contains non-escaped | or /"); + } + if($alttext =~ m:[|/]:) { + $self->warning("alternative text '$node' contains non-escaped | or /"); } $self->{-page} = $page; $self->{-node} = $node; @@ -559,18 +573,24 @@ sub link { my $self = shift; my $link = $self->page() || ''; if($self->node()) { + my $node = $self->node(); + $text =~ s/\|/E<verbar>/g; + $text =~ s:/:E<sol>:g; if($self->type() eq 'section') { - $link .= ($link ? '/' : '') . '"' . $self->node() . '"'; + $link .= ($link ? '/' : '') . '"' . $node . '"'; } elsif($self->type() eq 'hyperlink') { $link = $self->node(); } else { # item - $link .= '/' . $self->node(); + $link .= '/' . $node; } } if($self->alttext()) { - $link = $self->alttext() . '|' . $link; + my $text = $self->alttext(); + $text =~ s/\|/E<verbar>/g; + $text =~ s:/:E<sol>:g; + $link = "$text|$link"; } $link; } diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm index c727142506..22b3e49c61 100644 --- a/lib/Pod/Parser.pm +++ b/lib/Pod/Parser.pm @@ -1,7 +1,7 @@ ############################################################################# # Pod/Parser.pm -- package which defines a base class for parsing POD docs. # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -10,7 +10,7 @@ package Pod::Parser; use vars qw($VERSION); -$VERSION = 1.091; ## Current version of this package +$VERSION = 1.10; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# @@ -55,9 +55,9 @@ Pod::Parser - base class for creating POD filters and translators sub interior_sequence { my ($parser, $seq_command, $seq_argument) = @_; ## Expand an interior sequence; sample actions might be: - return "*$seq_argument*" if ($seq_command = 'B'); - return "`$seq_argument'" if ($seq_command = 'C'); - return "_${seq_argument}_'" if ($seq_command = 'I'); + return "*$seq_argument*" if ($seq_command eq 'B'); + return "`$seq_argument'" if ($seq_command eq 'C'); + return "_${seq_argument}_'" if ($seq_command eq 'I'); ## ... other sequence commands and their resulting text } @@ -142,8 +142,8 @@ For the most part, the B<Pod::Parser> base class should be able to do most of the input parsing for you and leave you free to worry about how to intepret the commands and translate the result. -Note that all we have described here in this quick overview is -the simplest most straightforward use of B<Pod::Parser> to do stream-based +Note that all we have described here in this quick overview is the +simplest most straightforward use of B<Pod::Parser> to do stream-based parsing. It is also possible to use the B<Pod::Parser::parse_text> function to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">. @@ -599,7 +599,7 @@ Please note that the B<preprocess_line()> method is invoked I<before> the B<preprocess_paragraph()> method. After all (possibly preprocessed) lines in a paragraph have been assembled together and either it has been determined that the paragraph is part of the POD documentation from one -of the selected sections or the C<-want_nonPODs> option is true, +of the selected sections or the C<-want_nonPODs> option is true, then B<preprocess_paragraph()> is invoked. The base class implementation of this method returns the given text. @@ -718,13 +718,6 @@ is a reference to the parse-tree object. =cut -## This global regex is used to see if the text before a '>' inside -## an interior sequence looks like '-' or '=', but not '--', '==', -## '!=', '$-', '$=' or <<op>>= -use vars qw( $ARROW_RE ); -$ARROW_RE = join('', qw{ (?: [^-+*/=!&|%^x.<>$]= | [^-$]- )$ }); -#$ARROW_RE = qr/(?:[^-+*/=!&|%^x.<>$]+=|[^-$]+-)$/; ## 5.005+ only! - sub parse_text { my $self = shift; local $_ = ''; @@ -738,7 +731,7 @@ sub parse_text { my $text = shift; my $line = shift; my $file = $self->input_file(); - my ($cmd, $prev) = ('', ''); + my $cmd = ""; ## Convert method calls into closures, for our convenience my $xseq_sub = $expand_seq; @@ -757,7 +750,7 @@ sub parse_text { ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) }; ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) }; ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) }; - + ## Keep track of the "current" interior sequence, and maintain a stack ## of "in progress" sequences. ## @@ -769,52 +762,82 @@ sub parse_text { ## my $seq = Pod::ParseTree->new(); my @seq_stack = ($seq); + my ($ldelim, $rdelim) = ('', ''); - ## Iterate over all sequence starts/stops, newlines, & text - ## (NOTE: split with capturing parens keeps the delimiters) + ## Iterate over all sequence starts text (NOTE: split with + ## capturing parens keeps the delimiters) $_ = $text; - for ( split /([A-Z]<|>|\n)/ ) { - ## Keep track of line count - ++$line if ($_ eq "\n"); + my @tokens = split /([A-Z]<(?:<+\s+)?)/; + while ( @tokens ) { + $_ = shift @tokens; ## Look for the beginning of a sequence - if ( /^([A-Z])(<)$/ ) { + if ( /^([A-Z])(<(?:<+\s+)?)$/ ) { ## Push a new sequence onto the stack of those "in-progress" + ($cmd, $ldelim) = ($1, $2); $seq = Pod::InteriorSequence->new( - -name => ($cmd = $1), - -ldelim => $2, -rdelim => '', - -file => $file, -line => $line + -name => $cmd, + -ldelim => $ldelim, -rdelim => '', + -file => $file, -line => $line ); + $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/; (@seq_stack > 1) and $seq->nested($seq_stack[-1]); push @seq_stack, $seq; } - ## Look for sequence ending (preclude '->' and '=>' inside C<...>) - elsif ( (@seq_stack > 1) and - /^>$/ and ($cmd ne 'C' or $prev !~ /$ARROW_RE/o) ) - { - ## End of current sequence, record terminating delimiter - $seq->rdelim($_); - ## Pop it off the stack of "in progress" sequences - pop @seq_stack; - ## Append result to its parent in current parse tree - $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq); - ## Remember the current cmd-name - $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : ''; + ## Look for sequence ending + elsif ( @seq_stack > 1 ) { + ## Make sure we match the right kind of closing delimiter + my ($seq_end, $post_seq) = ("", ""); + if ( ($ldelim eq '<' and /\A(.*?)(>)/s) + or /\A(.*?)(\s+$rdelim)/s ) + { + ## Found end-of-sequence, capture the interior and the + ## closing the delimiter, and put the rest back on the + ## token-list + $post_seq = substr($_, length($1) + length($2)); + ($_, $seq_end) = ($1, $2); + (length $post_seq) and unshift @tokens, $post_seq; + } + if (length) { + ## In the middle of a sequence, append this text to it, and + ## dont forget to "expand" it if that's what the caller wanted + $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); + $_ .= $seq_end; + } + if (length $seq_end) { + ## End of current sequence, record terminating delimiter + $seq->rdelim($seq_end); + ## Pop it off the stack of "in progress" sequences + pop @seq_stack; + ## Append result to its parent in current parse tree + $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) + : $seq); + ## Remember the current cmd-name and left-delimiter + $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : ''; + $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : ''; + $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/; + } } elsif (length) { ## In the middle of a sequence, append this text to it, and ## dont forget to "expand" it if that's what the caller wanted $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); } - ## Remember the "current" sequence and the previously seen token - ($seq, $prev) = ( $seq_stack[-1], $_ ); + ## Keep track of line count + $line += tr/\n//; + ## Remember the "current" sequence + $seq = $seq_stack[-1]; } ## Handle unterminated sequences my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef; while (@seq_stack > 1) { ($cmd, $file, $line) = ($seq->name, $seq->file_line); + $ldelim = $seq->ldelim; + ($rdelim = $ldelim) =~ tr/</>/; + $rdelim =~ s/^(\S+)(\s*)$/$2$1/; pop @seq_stack; - my $errmsg = "** Unterminated $cmd<...> at $file line $line\n"; + my $errmsg = "*** WARNING: unterminated ${cmd}${ldelim}...${rdelim}". + " at line $line in file $file\n"; (ref $errorsub) and &{$errorsub}($errmsg) or (defined $errorsub) and $self->$errorsub($errmsg) or warn($errmsg); @@ -1034,9 +1057,20 @@ sub parse_from_filehandle { ++$plines; } - ## See of this line is blank and ends the current paragraph. + ## See if this line is blank and ends the current paragraph. ## If it isnt, then keep iterating until it is. - next unless (($textline =~ /^\s*$/) && (length $paragraph)); + next unless (($textline =~ /^(\s*)$/) && (length $paragraph)); + + ## Issue a warning about any non-empty blank lines + if ( length($1) > 1 ) { + my $errorsub = $self->errorsub(); + my $file = $self->input_file(); + my $errmsg = "*** WARNING: line containing nothing but whitespace". + " in paragraph at line $nlines in file $file\n"; + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $self->$errorsub($errmsg) + or warn($errmsg); + } ## Now process the paragraph parse_paragraph($self, $paragraph, ($nlines - $plines) + 1); diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm index 94ded8697a..230dc8f03b 100644 --- a/lib/Pod/Select.pm +++ b/lib/Pod/Select.pm @@ -1,7 +1,7 @@ ############################################################################# # Pod/Select.pm -- function to select portions of POD docs # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -10,7 +10,7 @@ package Pod::Select; use vars qw($VERSION); -$VERSION = 1.090; ## Current version of this package +$VERSION = 1.10; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index aa3a009dcf..84a936e396 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -1,7 +1,7 @@ ############################################################################# # Pod/Usage.pm -- print usage messages for the running script. # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -10,7 +10,7 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.090; ## Current version of this package +$VERSION = 1.10; ## Current version of this package require 5.004; ## requires this Perl version or later =head1 NAME diff --git a/lib/attributes.pm b/lib/attributes.pm index bbbb8b78ee..f111645ae1 100644 --- a/lib/attributes.pm +++ b/lib/attributes.pm @@ -169,6 +169,12 @@ This has a meaning when taken together with the B<locked> attribute, as described there. It also means that a subroutine so marked will not trigger the "Ambiguous call resolved as CORE::%s" warning. +=item lvalue + +Indicates that the referenced subroutine is a valid lvalue and can +be assigned to. The subroutine must return a modifiable value such +as a scalar variable, as described in L<perlsub>. + =back There are no built-in attributes for anything other than subroutines. diff --git a/lib/byte.pm b/lib/bytes.pm index 0424e1778d..e8ab16f1bd 100644 --- a/lib/byte.pm +++ b/lib/bytes.pm @@ -1,4 +1,4 @@ -package byte; +package bytes; sub import { $^H |= 0x00000008; @@ -9,7 +9,7 @@ sub unimport { } sub AUTOLOAD { - require "byte_heavy.pl"; + require "bytes_heavy.pl"; goto &$AUTOLOAD; } @@ -20,21 +20,21 @@ __END__ =head1 NAME -byte - Perl pragma to force byte semantics rather than character semantics +bytes - Perl pragma to force byte semantics rather than character semantics =head1 SYNOPSIS - use byte; - no byte; + use bytes; + no bytes; =head1 DESCRIPTION WARNING: The implementation of Unicode support in Perl is incomplete. Expect sudden and unannounced changes! -The C<use byte> pragma disables character semantics for the rest of the -lexical scope in which it appears. C<no byte> can be used to reverse -the effect of C<use byte> within the current lexical scope. +The C<use bytes> pragma disables character semantics for the rest of the +lexical scope in which it appears. C<no bytes> can be used to reverse +the effect of C<use bytes> within the current lexical scope. Perl normally assumes character semantics in the presence of character data (i.e. data that has come from a source that has diff --git a/lib/byte_heavy.pl b/lib/bytes_heavy.pl index ec0558561d..47bdbf91b0 100644 --- a/lib/byte_heavy.pl +++ b/lib/bytes_heavy.pl @@ -1,7 +1,7 @@ -package byte; +package bytes; sub length ($) { - BEGIN { byte::import() } + BEGIN { bytes::import() } return CORE::length($_[0]); } diff --git a/lib/charnames.pm b/lib/charnames.pm index 817b4c559e..ff9d5ea891 100644 --- a/lib/charnames.pm +++ b/lib/charnames.pm @@ -30,8 +30,8 @@ sub charnames { die "Unknown charname '$name'" unless @off; my $ord = hex substr $txt, $off[0] - 4, 4; - if ($^H & 0x8) { # "use byte" in effect? - use byte; + if ($^H & 0x8) { # "use bytes" in effect? + use bytes; return chr $ord if $ord <= 255; my $hex = sprintf '%X=0%o', $ord, $ord; my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2; diff --git a/lib/unicode/ArabLink.pl b/lib/unicode/ArabLink.pl index 399fa6cf3d..fd5ed8a6b1 100644 --- a/lib/unicode/ArabLink.pl +++ b/lib/unicode/ArabLink.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0622 0625 R 0626 D diff --git a/lib/unicode/ArabLnkGrp.pl b/lib/unicode/ArabLnkGrp.pl index e06c3744de..61f30d4348 100644 --- a/lib/unicode/ArabLnkGrp.pl +++ b/lib/unicode/ArabLnkGrp.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0622 0623 ALEF 0624 WAW diff --git a/lib/unicode/Bidirectional.pl b/lib/unicode/Bidirectional.pl index f2ff4e67bb..73898b8399 100644 --- a/lib/unicode/Bidirectional.pl +++ b/lib/unicode/Bidirectional.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0000 0008 BN 0009 S diff --git a/lib/unicode/Block.pl b/lib/unicode/Block.pl index 7d6990bd7f..ee680b724d 100644 --- a/lib/unicode/Block.pl +++ b/lib/unicode/Block.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0000 007F Basic Latin 0080 00FF Latin-1 Supplement diff --git a/lib/unicode/Category.pl b/lib/unicode/Category.pl index 4e3e87397f..bffd1169be 100644 --- a/lib/unicode/Category.pl +++ b/lib/unicode/Category.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0000 001f Cc 0020 Zs diff --git a/lib/unicode/CombiningClass.pl b/lib/unicode/CombiningClass.pl index 5b506ade02..a40949830c 100644 --- a/lib/unicode/CombiningClass.pl +++ b/lib/unicode/CombiningClass.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0300 0314 230 0315 232 diff --git a/lib/unicode/Decomposition.pl b/lib/unicode/Decomposition.pl index ae4cbaf6ab..ecc30b205e 100644 --- a/lib/unicode/Decomposition.pl +++ b/lib/unicode/Decomposition.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 00a0 <noBreak> 0020 00a8 <compat> 0020 0308 diff --git a/lib/unicode/Eq/Latin1.pl b/lib/unicode/Eq/Latin1.pl deleted file mode 100644 index e033d2cb8b..0000000000 --- a/lib/unicode/Eq/Latin1.pl +++ /dev/null @@ -1,21 +0,0 @@ -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! -# This file is built by mktables.PL from e.g. Unicode.300. -# Any changes made here will be lost! -return <<'END'; -0041 00C0 00C1 00C2 00C3 00C4 00C5 -0043 00C7 -0045 00C8 00C9 00CA 00CB -0049 00CC 00CD 00CE 00CF -004E 00D1 -004F 00D2 00D3 00D4 00D5 00D6 00D8 -0055 00D9 00DA 00DB 00DC -0059 00DD -0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5 -0063 00E7 -0065 00E8 00E9 00EA 00EB -0069 00EC 00ED 00EE 00EF -006E 00F1 -006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 -0075 00F9 00FA 00FB 00FC -0079 00FD 00FF -END diff --git a/lib/unicode/Eq/Unicode.pl b/lib/unicode/Eq/Unicode.pl deleted file mode 100644 index 35edd61d2e..0000000000 --- a/lib/unicode/Eq/Unicode.pl +++ /dev/null @@ -1,666 +0,0 @@ -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! -# This file is built by mktables.PL from e.g. Unicode.300. -# Any changes made here will be lost! -return <<'END'; -0041 00C0 00C1 00C2 00C3 00C4 00C5 0100 0102 0104 01CD 0200 0202 0226 1E00 1EA0 1EA2 FF21 -0042 0181 0182 1E02 1E04 1E06 212C FF22 -0043 00C7 0106 0108 010A 010C 0187 2102 212D FF23 -0044 010E 0110 018A 018B 01C4 01C5 01F1 01F2 1E0A 1E0C 1E0E 1E10 1E12 FF24 -0045 00C8 00C9 00CA 00CB 0112 0114 0116 0118 011A 0204 0206 0228 1E18 1E1A 1EB8 1EBA 1EBC 2130 FF25 -0046 0191 1E1E 2131 FF26 -0047 011C 011E 0120 0122 0193 01E4 01E6 01F4 1E20 FF27 -0048 0124 0126 021E 1E22 1E24 1E26 1E28 1E2A 210B 210C 210D FF28 -0049 00CC 00CD 00CE 00CF 0128 012A 012C 012E 0130 0132 0197 01CF 0208 020A 1E2C 1EC8 1ECA 2110 2111 FF29 -004A 0134 FF2A -004B 0136 0198 01E8 1E30 1E32 1E34 212A FF2B -004C 0139 013B 013D 013F 0141 01C7 01C8 1E36 1E3A 1E3C 2112 FF2C -004D 1E3E 1E40 1E42 2133 FF2D -004E 00D1 0143 0145 0147 019D 01CA 01CB 01F8 1E44 1E46 1E48 1E4A 2115 FF2E -004F 00D2 00D3 00D4 00D5 00D6 00D8 014C 014E 0150 019F 01A0 01D1 01EA 020C 020E 022E 1ECC 1ECE FF2F -0050 01A4 1E54 1E56 2119 FF30 -0051 211A FF31 -0052 0154 0156 0158 0210 0212 1E58 1E5A 1E5E 211B 211C 211D FF32 -0053 015A 015C 015E 0160 0218 1E60 1E62 FF33 -0054 0162 0164 0166 01AC 01AE 021A 1E6A 1E6C 1E6E 1E70 FF34 -0055 00D9 00DA 00DB 00DC 0168 016A 016C 016E 0170 0172 01AF 01D3 0214 0216 1E72 1E74 1E76 1EE4 1EE6 FF35 -0056 01B2 1E7C 1E7E FF36 -0057 0174 1E80 1E82 1E84 1E86 1E88 FF37 -0058 1E8A 1E8C FF38 -0059 00DD 0176 0178 01B3 0232 1E8E 1EF2 1EF4 1EF6 1EF8 FF39 -005A 0179 017B 017D 01B5 0224 1E90 1E92 1E94 2124 2128 FF3A -0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5 0101 0103 0105 01CE 0201 0203 0227 1E01 1E9A 1EA1 1EA3 FF41 -0062 0180 0183 0253 1E03 1E05 1E07 FF42 -0063 00E7 0107 0109 010B 010D 0188 0255 FF43 -0064 010F 0111 018C 01C6 01F3 0256 0257 1E0B 1E0D 1E0F 1E11 1E13 FF44 -0065 00E8 00E9 00EA 00EB 0113 0115 0117 0119 011B 0205 0207 0229 1E19 1E1B 1EB9 1EBB 1EBD 212F FF45 -0066 0192 1E1F FB00 FB01 FB02 FB03 FB04 FF46 -0067 011D 011F 0121 0123 01E5 01E7 01F5 0260 1E21 210A FF47 -0068 0125 0127 021F 0266 02B0 1E23 1E25 1E27 1E29 1E2B 1E96 210E FF48 -0069 00EC 00ED 00EE 00EF 0129 012B 012D 012F 0133 01D0 0209 020B 0268 1E2D 1EC9 1ECB 2139 FF49 -006A 0135 01F0 029D 02B2 FF4A -006B 0137 0199 01E9 1E31 1E33 1E35 FF4B -006C 013A 013C 013E 0140 0142 019A 01C9 026B 026C 026D 02E1 1E37 1E3B 1E3D 2113 FF4C -006D 0271 1E3F 1E41 1E43 FF4D -006E 00F1 0144 0146 0148 019E 01CC 01F9 0272 0273 1E45 1E47 1E49 1E4B 207F FF4E -006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 014D 014F 0151 01A1 01D2 01EB 020D 020F 022F 1ECD 1ECF 2134 FF4F -0070 01A5 1E55 1E57 FF50 -0071 02A0 FF51 -0072 0155 0157 0159 0211 0213 027C 027D 027E 02B3 1E59 1E5B 1E5F FF52 -0073 015B 015D 015F 0161 017F 0219 0282 02E2 1E61 1E63 FB06 FF53 -0074 0163 0165 0167 01AB 01AD 021B 0288 1E6B 1E6D 1E6F 1E71 1E97 FF54 -0075 00F9 00FA 00FB 00FC 0169 016B 016D 016F 0171 0173 01B0 01D4 0215 0217 1E73 1E75 1E77 1EE5 1EE7 FF55 -0076 028B 1E7D 1E7F FF56 -0077 0175 02B7 1E81 1E83 1E85 1E87 1E89 1E98 FF57 -0078 02E3 1E8B 1E8D FF58 -0079 00FD 00FF 0177 01B4 0233 02B8 1E8F 1E99 1EF3 1EF5 1EF7 1EF9 FF59 -007A 017A 017C 017E 01B6 0225 0290 0291 1E91 1E93 1E95 FF5A -00C2 1EA4 1EA6 1EA8 1EAA -00C4 01DE -00C5 01FA 212B -00C6 01E2 01FC -00C7 1E08 -00CA 1EBE 1EC0 1EC2 1EC4 -00CF 1E2E -00D4 1ED0 1ED2 1ED4 1ED6 -00D5 022C 1E4C 1E4E -00D6 022A -00D8 01FE -00DC 01D5 01D7 01D9 01DB -00E2 1EA5 1EA7 1EA9 1EAB -00E4 01DF -00E5 01FB -00E6 01E3 01FD -00E7 1E09 -00EA 1EBF 1EC1 1EC3 1EC5 -00EF 1E2F -00F4 1ED1 1ED3 1ED5 1ED7 -00F5 022D 1E4D 1E4F -00F6 022B -00F8 01FF -00FC 01D6 01D8 01DA 01DC -0102 1EAE 1EB0 1EB2 1EB4 -0103 1EAF 1EB1 1EB3 1EB5 -0112 1E14 1E16 -0113 1E15 1E17 -0127 210F -014C 1E50 1E52 -014D 1E51 1E53 -015A 1E64 -015B 1E65 -0160 1E66 -0161 1E67 -0168 1E78 -0169 1E79 -016A 1E7A -016B 1E7B -017F 1E9B FB05 -0190 2107 -01A0 1EDA 1EDC 1EDE 1EE0 1EE2 -01A1 1EDB 1EDD 1EDF 1EE1 1EE3 -01AF 1EE8 1EEA 1EEC 1EEE 1EF0 -01B0 1EE9 1EEB 1EED 1EEF 1EF1 -01B7 01EE -01EA 01EC -01EB 01ED -0226 01E0 -0227 01E1 -0228 1E1C -0229 1E1D -022E 0230 -022F 0231 -0259 025A -025C 025D -0262 029B -0263 02E0 -0266 02B1 -026F 0270 -0279 027A 027B 02B4 -027B 02B5 -0281 02B6 -0283 0286 -0292 01BA 01EF 0293 -0294 02A1 -0295 02E4 -0296 01BE -02A3 02A5 -02BC 0149 -0386 1FBB -0388 1FC9 -0389 1FCB -038A 1FDB -038C 1FF9 -038E 1FEB -038F 1FFB -0390 1FD3 -0391 0386 1F08 1F09 1FB8 1FB9 1FBA 1FBC -0395 0388 1F18 1F19 1FC8 -0397 0389 1F28 1F29 1FCA 1FCC -0399 038A 03AA 1F38 1F39 1FD8 1FD9 1FDA -039F 038C 1F48 1F49 1FF8 -03A1 1FEC -03A5 038E 03AB 03D2 1F59 1FE8 1FE9 1FEA -03A9 038F 1F68 1F69 1FFA 1FFC 2126 -03AC 1F71 1FB4 -03AD 1F73 -03AE 1F75 1FC4 -03AF 1F77 -03B0 1FE3 -03B1 03AC 1F00 1F01 1F70 1FB0 1FB1 1FB3 1FB6 -03B2 03D0 -03B5 03AD 1F10 1F11 1F72 -03B7 03AE 1F20 1F21 1F74 1FC3 1FC6 -03B8 03D1 -03B9 03AF 03CA 1F30 1F31 1F76 1FBE 1FD0 1FD1 1FD6 -03BA 03F0 -03BC 00B5 -03BF 03CC 1F40 1F41 1F78 -03C0 03D6 -03C1 03F1 1FE4 1FE5 -03C2 03F2 -03C5 03CB 03CD 1F50 1F51 1F7A 1FE0 1FE1 1FE6 -03C6 03D5 -03C9 03CE 1F60 1F61 1F7C 1FF3 1FF6 -03CA 0390 1FD2 1FD7 -03CB 03B0 1FE2 1FE7 -03CC 1F79 -03CD 1F7B -03CE 1F7D 1FF4 -03D2 03D3 03D4 -0406 0407 -0410 04D0 04D2 -0413 0403 0490 0492 0494 -0415 0400 0401 04D6 -0416 0496 04C1 04DC -0417 0498 04DE -0418 040D 0419 04E2 04E4 -041A 040C 049A 049C 049E 04C3 -041D 04A2 04C7 -041E 04E6 -041F 04A6 -0420 048E -0421 04AA -0422 04AC -0423 040E 04EE 04F0 04F2 -0425 04B2 -0427 04B6 04B8 04F4 -042B 04F8 -042D 04EC -0430 04D1 04D3 -0433 0453 0491 0493 0495 -0435 0450 0451 04D7 -0436 0497 04C2 04DD -0437 0499 04DF -0438 0439 045D 04E3 04E5 -043A 045C 049B 049D 049F 04C4 -043D 04A3 04C8 -043E 04E7 -043F 04A7 -0440 048F -0441 04AB -0442 04AD -0443 045E 04EF 04F1 04F3 -0445 04B3 -0447 04B7 04B9 04F5 -044B 04F9 -044D 04ED -0456 0457 -0460 047C -0461 047D -0474 0476 -0475 0477 -04AE 04B0 -04AF 04B1 -04BC 04BE -04BD 04BF -04D8 04DA -04D9 04DB -04E8 04EA -04E9 04EB -0565 0587 -0574 FB13 FB14 FB15 FB17 -057E FB16 -05D0 2135 FB21 FB2E FB2F FB30 FB4F -05D1 2136 FB31 FB4C -05D2 2137 FB32 -05D3 2138 FB22 FB33 -05D4 FB23 FB34 -05D5 FB35 FB4B -05D6 FB36 -05D8 FB38 -05D9 FB1D FB39 -05DA FB3A -05DB FB24 FB3B FB4D -05DC FB25 FB3C -05DD FB26 -05DE FB3E -05E0 FB40 -05E1 FB41 -05E2 FB20 -05E3 FB43 -05E4 FB44 FB4E -05E6 FB46 -05E7 FB47 -05E8 FB27 FB48 -05E9 FB2A FB2B FB49 -05EA FB28 FB4A -05F2 FB1F -0621 FE80 -0622 FE81 FE82 -0623 FE83 FE84 -0624 FE85 FE86 -0625 FE87 FE88 -0626 FBEA FBEB FBEC FBED FBEE FBEF FBF0 FBF1 FBF2 FBF3 FBF4 FBF5 FBF6 FBF7 FBF8 FBF9 FBFA FBFB FC00 FC01 FC02 FC03 FC04 FC64 FC65 FC66 FC67 FC68 FC69 FC97 FC98 FC99 FC9A FC9B FCDF FCE0 FE89 FE8A FE8B FE8C -0627 0622 0623 0625 0672 0673 0675 FD3C FD3D FDF2 FDF3 FE8D FE8E -0628 FC05 FC06 FC07 FC08 FC09 FC0A FC6A FC6B FC6C FC6D FC6E FC6F FC9C FC9D FC9E FC9F FCA0 FCE1 FCE2 FD9E FDC2 FE8F FE90 FE91 FE92 -0629 FE93 FE94 -062A 067C 067D FC0B FC0C FC0D FC0E FC0F FC10 FC70 FC71 FC72 FC73 FC74 FC75 FCA1 FCA2 FCA3 FCA4 FCA5 FCE3 FCE4 FD50 FD51 FD52 FD53 FD54 FD55 FD56 FD57 FD9F FDA0 FDA1 FDA2 FDA3 FDA4 FE95 FE96 FE97 FE98 -062B FC11 FC12 FC13 FC14 FC76 FC77 FC78 FC79 FC7A FC7B FCA6 FCE5 FCE6 FE99 FE9A FE9B FE9C -062C FC15 FC16 FCA7 FCA8 FD01 FD02 FD1D FD1E FD58 FD59 FDA5 FDA6 FDA7 FDBE FDFB FE9D FE9E FE9F FEA0 -062D 0681 0682 0685 FC17 FC18 FCA9 FCAA FCFF FD00 FD1B FD1C FD5A FD5B FDBF FEA1 FEA2 FEA3 FEA4 -062E FC19 FC1A FC1B FCAB FCAC FD03 FD04 FD1F FD20 FEA5 FEA6 FEA7 FEA8 -062F 0689 068A 068B 068F 0690 FEA9 FEAA -0630 FC5B FEAB FEAC -0631 0692 0693 0694 0695 0696 0697 0699 FC5C FDF6 FEAD FEAE -0632 FEAF FEB0 -0633 069A 069B 069C FC1C FC1D FC1E FC1F FCAD FCAE FCAF FCB0 FCE7 FCE8 FCFB FCFC FD0E FD17 FD18 FD2A FD31 FD34 FD35 FD36 FD5C FD5D FD5E FD5F FD60 FD61 FD62 FD63 FDA8 FDC6 FEB1 FEB2 FEB3 FEB4 -0634 06FA FCE9 FCEA FCFD FCFE FD09 FD0A FD0B FD0C FD0D FD19 FD1A FD25 FD26 FD27 FD28 FD29 FD2D FD2E FD2F FD30 FD32 FD37 FD38 FD39 FD67 FD68 FD69 FD6A FD6B FD6C FD6D FDAA FEB5 FEB6 FEB7 FEB8 -0635 069D 069E FC20 FC21 FCB1 FCB2 FCB3 FD05 FD06 FD0F FD21 FD22 FD2B FD64 FD65 FD66 FDA9 FDC5 FDF0 FDF5 FDF9 FDFA FEB9 FEBA FEBB FEBC -0636 06FB FC22 FC23 FC24 FC25 FCB4 FCB5 FCB6 FCB7 FD07 FD08 FD10 FD23 FD24 FD2C FD6E FD6F FD70 FDAB FEBD FEBE FEBF FEC0 -0637 069F FC26 FC27 FCB8 FCF5 FCF6 FD11 FD12 FD33 FD3A FD71 FD72 FD73 FD74 FEC1 FEC2 FEC3 FEC4 -0638 FC28 FCB9 FD3B FEC5 FEC6 FEC7 FEC8 -0639 06A0 FC29 FC2A FCBA FCBB FCF7 FCF8 FD13 FD14 FD75 FD76 FD77 FD78 FDB6 FDC4 FDF7 FEC9 FECA FECB FECC -063A 06FC FC2B FC2C FCBC FCBD FCF9 FCFA FD15 FD16 FD79 FD7A FD7B FECD FECE FECF FED0 -0640 FCF2 FCF3 FCF4 FE71 FE77 FE79 FE7B FE7D FE7F -0641 06A2 06A3 06A5 FC2D FC2E FC2F FC30 FC31 FC32 FC7C FC7D FCBE FCBF FCC0 FCC1 FD7C FD7D FDC1 FED1 FED2 FED3 FED4 -0642 06A7 06A8 FC33 FC34 FC35 FC36 FC7E FC7F FCC2 FCC3 FD7E FD7F FDB2 FDB4 FDF1 FED5 FED6 FED7 FED8 -0643 06AB 06AC 06AE FC37 FC38 FC39 FC3A FC3B FC3C FC3D FC3E FC80 FC81 FC82 FC83 FC84 FCC4 FCC5 FCC6 FCC7 FCC8 FCEB FCEC FDB7 FDBB FDC3 FED9 FEDA FEDB FEDC -0644 06B5 06B6 06B7 06B8 FC3F FC40 FC41 FC42 FC43 FC44 FC85 FC86 FC87 FCC9 FCCA FCCB FCCC FCCD FCED FD80 FD81 FD82 FD83 FD84 FD85 FD86 FD87 FD88 FDAC FDAD FDB5 FDBA FDBC FEDD FEDE FEDF FEE0 FEF5 FEF6 FEF7 FEF8 FEF9 FEFA FEFB FEFC -0645 FC45 FC46 FC47 FC48 FC49 FC4A FC88 FC89 FCCE FCCF FCD0 FCD1 FD89 FD8A FD8B FD8C FD8D FD8E FD8F FD92 FDB1 FDB9 FDC0 FDF4 FEE1 FEE2 FEE3 FEE4 -0646 06B9 06BC 06BD FC4B FC4C FC4D FC4E FC4F FC50 FC8A FC8B FC8C FC8D FC8E FC8F FCD2 FCD3 FCD4 FCD5 FCD6 FCEE FCEF FD95 FD96 FD97 FD98 FD99 FD9A FD9B FDB3 FDB8 FDBD FDC7 FEE5 FEE6 FEE7 FEE8 -0647 FC51 FC52 FC53 FC54 FCD7 FCD8 FCD9 FD93 FD94 FEE9 FEEA FEEB FEEC -0648 0624 0676 06C4 06CA 06CF FDF8 FEED FEEE -0649 FBE8 FBE9 FC5D FC90 FEEF FEF0 -064A 0626 0678 06CD 06CE 06D1 FC55 FC56 FC57 FC58 FC59 FC5A FC91 FC92 FC93 FC94 FC95 FC96 FCDA FCDB FCDC FCDD FCDE FCF0 FCF1 FD9C FD9D FDAE FDAF FDB0 FEF1 FEF2 FEF3 FEF4 -0671 FB50 FB51 -0677 FBDD -0679 FB66 FB67 FB68 FB69 -067A FB5E FB5F FB60 FB61 -067B FB52 FB53 FB54 FB55 -067E FB56 FB57 FB58 FB59 -067F FB62 FB63 FB64 FB65 -0680 FB5A FB5B FB5C FB5D -0683 FB76 FB77 FB78 FB79 -0684 FB72 FB73 FB74 FB75 -0686 06BF FB7A FB7B FB7C FB7D -0687 FB7E FB7F FB80 FB81 -0688 FB88 FB89 -068C FB84 FB85 -068D FB82 FB83 -068E FB86 FB87 -0691 FB8C FB8D -0698 FB8A FB8B -06A4 FB6A FB6B FB6C FB6D -06A6 FB6E FB6F FB70 FB71 -06A9 FB8E FB8F FB90 FB91 -06AD FBD3 FBD4 FBD5 FBD6 -06AF 06B0 06B2 06B4 FB92 FB93 FB94 FB95 -06B1 FB9A FB9B FB9C FB9D -06B3 FB96 FB97 FB98 FB99 -06BA FB9E FB9F -06BB FBA0 FBA1 FBA2 FBA3 -06BE FBAA FBAB FBAC FBAD -06C0 FBA4 FBA5 -06C1 06C2 FBA6 FBA7 FBA8 FBA9 -06C5 FBE0 FBE1 -06C6 FBD9 FBDA -06C7 0677 FBD7 FBD8 -06C8 FBDB FBDC -06C9 FBE2 FBE3 -06CB FBDE FBDF -06CC FBFC FBFD FBFE FBFF -06D0 FBE4 FBE5 FBE6 FBE7 -06D2 06D3 FBAE FBAF -06D3 FBB0 FBB1 -06D5 06C0 -0915 0958 -0916 0959 -0917 095A -091C 095B -0921 095C -0922 095D -0928 0929 -092B 095E -092F 095F -0930 0931 -0933 0934 -09A1 09DC -09A2 09DD -09AF 09DF -09B0 09F0 09F1 -0A16 0A59 -0A17 0A5A -0A1C 0A5B -0A2B 0A5E -0A32 0A33 -0A38 0A36 -0B21 0B5C -0B22 0B5D -0B92 0B94 -0EAB 0EDC 0EDD -0F40 0F69 -0F42 0F43 -0F4C 0F4D -0F51 0F52 -0F56 0F57 -0F5B 0F5C -1025 1026 -1100 3131 -1101 3132 -1102 3134 -1103 3137 -1104 3138 -1105 3139 -1106 3141 -1107 3142 -1108 3143 -1109 3145 -110A 3146 -110B 3147 -110C 3148 -110D 3149 -110E 314A -110F 314B -1110 314C -1111 314D -1112 314E -1114 3165 -1115 3166 -111A 3140 -111C 316E -111D 3171 -111E 3172 -1120 3173 -1121 3144 -1122 3174 -1123 3175 -1127 3176 -1129 3177 -112B 3178 -112C 3179 -112D 317A -112E 317B -112F 317C -1132 317D -1136 317E -1140 317F -1147 3180 -114C 3181 -1157 3184 -1158 3185 -1159 3186 -1160 3164 -1161 314F -1162 3150 -1163 3151 -1164 3152 -1165 3153 -1166 3154 -1167 3155 -1168 3156 -1169 3157 -116A 3158 -116B 3159 -116C 315A -116D 315B -116E 315C -116F 315D -1170 315E -1171 315F -1172 3160 -1173 3161 -1174 3162 -1175 3163 -1184 3187 -1185 3188 -1188 3189 -1191 318A -1192 318B -1194 318C -119E 318D -11A1 318E -11AA 3133 -11AC 3135 -11AD 3136 -11B0 313A -11B1 313B -11B2 313C -11B3 313D -11B4 313E -11B5 313F -11C7 3167 -11C8 3168 -11CC 3169 -11CE 316A -11D3 316B -11D7 316C -11D9 316D -11DD 316F -11DF 3170 -11F1 3182 -11F2 3183 -1E36 1E38 -1E37 1E39 -1E5A 1E5C -1E5B 1E5D -1E62 1E68 -1E63 1E69 -1EA0 1EAC 1EB6 -1EA1 1EAD 1EB7 -1EB8 1EC6 -1EB9 1EC7 -1ECC 1ED8 -1ECD 1ED9 -1F00 1F02 1F04 1F06 1F80 -1F01 1F03 1F05 1F07 1F81 -1F02 1F82 -1F03 1F83 -1F04 1F84 -1F05 1F85 -1F06 1F86 -1F07 1F87 -1F08 1F0A 1F0C 1F0E 1F88 -1F09 1F0B 1F0D 1F0F 1F89 -1F0A 1F8A -1F0B 1F8B -1F0C 1F8C -1F0D 1F8D -1F0E 1F8E -1F0F 1F8F -1F10 1F12 1F14 -1F11 1F13 1F15 -1F18 1F1A 1F1C -1F19 1F1B 1F1D -1F20 1F22 1F24 1F26 1F90 -1F21 1F23 1F25 1F27 1F91 -1F22 1F92 -1F23 1F93 -1F24 1F94 -1F25 1F95 -1F26 1F96 -1F27 1F97 -1F28 1F2A 1F2C 1F2E 1F98 -1F29 1F2B 1F2D 1F2F 1F99 -1F2A 1F9A -1F2B 1F9B -1F2C 1F9C -1F2D 1F9D -1F2E 1F9E -1F2F 1F9F -1F30 1F32 1F34 1F36 -1F31 1F33 1F35 1F37 -1F38 1F3A 1F3C 1F3E -1F39 1F3B 1F3D 1F3F -1F40 1F42 1F44 -1F41 1F43 1F45 -1F48 1F4A 1F4C -1F49 1F4B 1F4D -1F50 1F52 1F54 1F56 -1F51 1F53 1F55 1F57 -1F59 1F5B 1F5D 1F5F -1F60 1F62 1F64 1F66 1FA0 -1F61 1F63 1F65 1F67 1FA1 -1F62 1FA2 -1F63 1FA3 -1F64 1FA4 -1F65 1FA5 -1F66 1FA6 -1F67 1FA7 -1F68 1F6A 1F6C 1F6E 1FA8 -1F69 1F6B 1F6D 1F6F 1FA9 -1F6A 1FAA -1F6B 1FAB -1F6C 1FAC -1F6D 1FAD -1F6E 1FAE -1F6F 1FAF -1F70 1FB2 -1F74 1FC2 -1F7C 1FF2 -1FB6 1FB7 -1FC6 1FC7 -1FF6 1FF7 -3046 3094 -304B 304C -304D 304E -304F 3050 -3051 3052 -3053 3054 -3055 3056 -3057 3058 -3059 305A -305B 305C -305D 305E -305F 3060 -3061 3062 -3064 3065 -3066 3067 -3068 3069 -306F 3070 3071 -3072 3073 3074 -3075 3076 3077 -3078 3079 307A -307B 307C 307D -309D 309E -30A1 FF67 -30A2 FF71 -30A3 FF68 -30A4 FF72 -30A5 FF69 -30A6 30F4 FF73 -30A7 FF6A -30A8 FF74 -30A9 FF6B -30AA FF75 -30AB 30AC FF76 -30AD 30AE FF77 -30AF 30B0 FF78 -30B1 30B2 FF79 -30B3 30B4 FF7A -30B5 30B6 FF7B -30B7 30B8 FF7C -30B9 30BA FF7D -30BB 30BC FF7E -30BD 30BE FF7F -30BF 30C0 FF80 -30C1 30C2 FF81 -30C3 FF6F -30C4 30C5 FF82 -30C6 30C7 FF83 -30C8 30C9 FF84 -30CA FF85 -30CB FF86 -30CC FF87 -30CD FF88 -30CE FF89 -30CF 30D0 30D1 FF8A -30D2 30D3 30D4 FF8B -30D5 30D6 30D7 FF8C -30D8 30D9 30DA FF8D -30DB 30DC 30DD FF8E -30DE FF8F -30DF FF90 -30E0 FF91 -30E1 FF92 -30E2 FF93 -30E3 FF6C -30E4 FF94 -30E5 FF6D -30E6 FF95 -30E7 FF6E -30E8 FF96 -30E9 FF97 -30EA FF98 -30EB FF99 -30EC FF9A -30ED FF9B -30EF 30F7 FF9C -30F0 30F8 -30F1 30F9 -30F2 30FA FF66 -30F3 FF9D -30FC FF70 -30FD 30FE -3131 FFA1 -3132 FFA2 -3133 FFA3 -3134 FFA4 -3135 FFA5 -3136 FFA6 -3137 FFA7 -3138 FFA8 -3139 FFA9 -313A FFAA -313B FFAB -313C FFAC -313D FFAD -313E FFAE -313F FFAF -3140 FFB0 -3141 FFB1 -3142 FFB2 -3143 FFB3 -3144 FFB4 -3145 FFB5 -3146 FFB6 -3147 FFB7 -3148 FFB8 -3149 FFB9 -314A FFBA -314B FFBB -314C FFBC -314D FFBD -314E FFBE -314F FFC2 -3150 FFC3 -3151 FFC4 -3152 FFC5 -3153 FFC6 -3154 FFC7 -3155 FFCA -3156 FFCB -3157 FFCC -3158 FFCD -3159 FFCE -315A FFCF -315B FFD2 -315C FFD3 -315D FFD4 -315E FFD5 -315F FFD6 -3160 FFD7 -3161 FFDA -3162 FFDB -3163 FFDC -3164 FFA0 -FB49 FB2C FB2D -END diff --git a/lib/unicode/In/AlphabeticPresentationForms.pl b/lib/unicode/In/AlphabeticPresentationForms.pl index 93ded27a55..c42e944a3c 100644 --- a/lib/unicode/In/AlphabeticPresentationForms.pl +++ b/lib/unicode/In/AlphabeticPresentationForms.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FB00 FB4F END diff --git a/lib/unicode/In/Arabic.pl b/lib/unicode/In/Arabic.pl index a9645d55a2..5010ab73de 100644 --- a/lib/unicode/In/Arabic.pl +++ b/lib/unicode/In/Arabic.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0600 06FF END diff --git a/lib/unicode/In/ArabicPresentationForms-A.pl b/lib/unicode/In/ArabicPresentationForms-A.pl index b87293762a..6edd74d755 100644 --- a/lib/unicode/In/ArabicPresentationForms-A.pl +++ b/lib/unicode/In/ArabicPresentationForms-A.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FB50 FDFF END diff --git a/lib/unicode/In/ArabicPresentationForms-B.pl b/lib/unicode/In/ArabicPresentationForms-B.pl index 9e81cf9572..964073931e 100644 --- a/lib/unicode/In/ArabicPresentationForms-B.pl +++ b/lib/unicode/In/ArabicPresentationForms-B.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FE70 FEFE END diff --git a/lib/unicode/In/Armenian.pl b/lib/unicode/In/Armenian.pl index f86fd3c58a..19b74acd71 100644 --- a/lib/unicode/In/Armenian.pl +++ b/lib/unicode/In/Armenian.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0530 058F END diff --git a/lib/unicode/In/Arrows.pl b/lib/unicode/In/Arrows.pl index 3910c8dacd..7ce44183a1 100644 --- a/lib/unicode/In/Arrows.pl +++ b/lib/unicode/In/Arrows.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2190 21FF END diff --git a/lib/unicode/In/BasicLatin.pl b/lib/unicode/In/BasicLatin.pl index 9ce83b3d2d..39987f16ec 100644 --- a/lib/unicode/In/BasicLatin.pl +++ b/lib/unicode/In/BasicLatin.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0000 007F END diff --git a/lib/unicode/In/Bengali.pl b/lib/unicode/In/Bengali.pl index 0589b85d81..c0a47d30d1 100644 --- a/lib/unicode/In/Bengali.pl +++ b/lib/unicode/In/Bengali.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0980 09FF END diff --git a/lib/unicode/In/BlockElements.pl b/lib/unicode/In/BlockElements.pl index a52c848d11..e96e64faa0 100644 --- a/lib/unicode/In/BlockElements.pl +++ b/lib/unicode/In/BlockElements.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2580 259F END diff --git a/lib/unicode/In/Bopomofo.pl b/lib/unicode/In/Bopomofo.pl index 5af1356e3e..553560670c 100644 --- a/lib/unicode/In/Bopomofo.pl +++ b/lib/unicode/In/Bopomofo.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3100 312F END diff --git a/lib/unicode/In/BoxDrawing.pl b/lib/unicode/In/BoxDrawing.pl index c9c1d1e5bc..d580199b7f 100644 --- a/lib/unicode/In/BoxDrawing.pl +++ b/lib/unicode/In/BoxDrawing.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2500 257F END diff --git a/lib/unicode/In/CJKCompatibility.pl b/lib/unicode/In/CJKCompatibility.pl index 66cbc545c9..07ab8edfd4 100644 --- a/lib/unicode/In/CJKCompatibility.pl +++ b/lib/unicode/In/CJKCompatibility.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3300 33FF END diff --git a/lib/unicode/In/CJKCompatibilityForms.pl b/lib/unicode/In/CJKCompatibilityForms.pl index e65dbd3aba..122ccd7ad6 100644 --- a/lib/unicode/In/CJKCompatibilityForms.pl +++ b/lib/unicode/In/CJKCompatibilityForms.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FE30 FE4F END diff --git a/lib/unicode/In/CJKCompatibilityIdeographs.pl b/lib/unicode/In/CJKCompatibilityIdeographs.pl index b6822621e8..59c8e5dd5b 100644 --- a/lib/unicode/In/CJKCompatibilityIdeographs.pl +++ b/lib/unicode/In/CJKCompatibilityIdeographs.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; F900 FAFF END diff --git a/lib/unicode/In/CJKSymbolsandPunctuation.pl b/lib/unicode/In/CJKSymbolsandPunctuation.pl index bdf4ab90f2..24ecc37b67 100644 --- a/lib/unicode/In/CJKSymbolsandPunctuation.pl +++ b/lib/unicode/In/CJKSymbolsandPunctuation.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3000 303F END diff --git a/lib/unicode/In/CJKUnifiedIdeographs.pl b/lib/unicode/In/CJKUnifiedIdeographs.pl index 04d0a08e05..351cf74a82 100644 --- a/lib/unicode/In/CJKUnifiedIdeographs.pl +++ b/lib/unicode/In/CJKUnifiedIdeographs.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 4E00 9FFF END diff --git a/lib/unicode/In/CombiningDiacriticalMarks.pl b/lib/unicode/In/CombiningDiacriticalMarks.pl index 2308c52d25..a32f974bfb 100644 --- a/lib/unicode/In/CombiningDiacriticalMarks.pl +++ b/lib/unicode/In/CombiningDiacriticalMarks.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0300 036F END diff --git a/lib/unicode/In/CombiningHalfMarks.pl b/lib/unicode/In/CombiningHalfMarks.pl index 004d8052a2..100471bdbb 100644 --- a/lib/unicode/In/CombiningHalfMarks.pl +++ b/lib/unicode/In/CombiningHalfMarks.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FE20 FE2F END diff --git a/lib/unicode/In/CombiningMarksforSymbols.pl b/lib/unicode/In/CombiningMarksforSymbols.pl index b80f637a56..f45e7e0490 100644 --- a/lib/unicode/In/CombiningMarksforSymbols.pl +++ b/lib/unicode/In/CombiningMarksforSymbols.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 20D0 20FF END diff --git a/lib/unicode/In/ControlPictures.pl b/lib/unicode/In/ControlPictures.pl index cfaa3c545b..77a759f1a0 100644 --- a/lib/unicode/In/ControlPictures.pl +++ b/lib/unicode/In/ControlPictures.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2400 243F END diff --git a/lib/unicode/In/CurrencySymbols.pl b/lib/unicode/In/CurrencySymbols.pl index 1a89d72a49..567ae97da3 100644 --- a/lib/unicode/In/CurrencySymbols.pl +++ b/lib/unicode/In/CurrencySymbols.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 20A0 20CF END diff --git a/lib/unicode/In/Cyrillic.pl b/lib/unicode/In/Cyrillic.pl index 657824c1b9..9ca104c7db 100644 --- a/lib/unicode/In/Cyrillic.pl +++ b/lib/unicode/In/Cyrillic.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0400 04FF END diff --git a/lib/unicode/In/Devanagari.pl b/lib/unicode/In/Devanagari.pl index 1a0bffc2aa..61372b58ab 100644 --- a/lib/unicode/In/Devanagari.pl +++ b/lib/unicode/In/Devanagari.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0900 097F END diff --git a/lib/unicode/In/Dingbats.pl b/lib/unicode/In/Dingbats.pl index 3800470f4e..0f820ca711 100644 --- a/lib/unicode/In/Dingbats.pl +++ b/lib/unicode/In/Dingbats.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2700 27BF END diff --git a/lib/unicode/In/EnclosedAlphanumerics.pl b/lib/unicode/In/EnclosedAlphanumerics.pl index 760ebd16e8..de52aa8d99 100644 --- a/lib/unicode/In/EnclosedAlphanumerics.pl +++ b/lib/unicode/In/EnclosedAlphanumerics.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2460 24FF END diff --git a/lib/unicode/In/EnclosedCJKLettersandMonths.pl b/lib/unicode/In/EnclosedCJKLettersandMonths.pl index 96a9d75796..e4de0e0261 100644 --- a/lib/unicode/In/EnclosedCJKLettersandMonths.pl +++ b/lib/unicode/In/EnclosedCJKLettersandMonths.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3200 32FF END diff --git a/lib/unicode/In/Ethiopic.pl b/lib/unicode/In/Ethiopic.pl index 0ae7c17b0e..13c309050a 100644 --- a/lib/unicode/In/Ethiopic.pl +++ b/lib/unicode/In/Ethiopic.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 1200 137F END diff --git a/lib/unicode/In/GeneralPunctuation.pl b/lib/unicode/In/GeneralPunctuation.pl index a582d1f159..81c76992dc 100644 --- a/lib/unicode/In/GeneralPunctuation.pl +++ b/lib/unicode/In/GeneralPunctuation.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2000 206F END diff --git a/lib/unicode/In/GeometricShapes.pl b/lib/unicode/In/GeometricShapes.pl index 46086b8e8b..170422d2d0 100644 --- a/lib/unicode/In/GeometricShapes.pl +++ b/lib/unicode/In/GeometricShapes.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 25A0 25FF END diff --git a/lib/unicode/In/Georgian.pl b/lib/unicode/In/Georgian.pl index df1230d700..773ed1562a 100644 --- a/lib/unicode/In/Georgian.pl +++ b/lib/unicode/In/Georgian.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 10A0 10FF END diff --git a/lib/unicode/In/Greek.pl b/lib/unicode/In/Greek.pl index 10c1cf85ea..ff753d19b4 100644 --- a/lib/unicode/In/Greek.pl +++ b/lib/unicode/In/Greek.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0370 03FF END diff --git a/lib/unicode/In/GreekExtended.pl b/lib/unicode/In/GreekExtended.pl index f588406f43..b8f02e7f0a 100644 --- a/lib/unicode/In/GreekExtended.pl +++ b/lib/unicode/In/GreekExtended.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 1F00 1FFF END diff --git a/lib/unicode/In/Gujarati.pl b/lib/unicode/In/Gujarati.pl index 8a31d92571..ff6c6503bb 100644 --- a/lib/unicode/In/Gujarati.pl +++ b/lib/unicode/In/Gujarati.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0A80 0AFF END diff --git a/lib/unicode/In/Gurmukhi.pl b/lib/unicode/In/Gurmukhi.pl index 1b6857e181..b888df6941 100644 --- a/lib/unicode/In/Gurmukhi.pl +++ b/lib/unicode/In/Gurmukhi.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0A00 0A7F END diff --git a/lib/unicode/In/HalfwidthandFullwidthForms.pl b/lib/unicode/In/HalfwidthandFullwidthForms.pl index d7ff603e42..e45265393f 100644 --- a/lib/unicode/In/HalfwidthandFullwidthForms.pl +++ b/lib/unicode/In/HalfwidthandFullwidthForms.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FF00 FFEF END diff --git a/lib/unicode/In/HangulCompatibilityJamo.pl b/lib/unicode/In/HangulCompatibilityJamo.pl index e602d4553d..c15379fafc 100644 --- a/lib/unicode/In/HangulCompatibilityJamo.pl +++ b/lib/unicode/In/HangulCompatibilityJamo.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3130 318F END diff --git a/lib/unicode/In/HangulJamo.pl b/lib/unicode/In/HangulJamo.pl index dd5df946d8..c329b54c34 100644 --- a/lib/unicode/In/HangulJamo.pl +++ b/lib/unicode/In/HangulJamo.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 1100 11FF END diff --git a/lib/unicode/In/HangulSyllables.pl b/lib/unicode/In/HangulSyllables.pl index 95bc194dff..7d91a363f5 100644 --- a/lib/unicode/In/HangulSyllables.pl +++ b/lib/unicode/In/HangulSyllables.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; AC00 D7A3 END diff --git a/lib/unicode/In/Hebrew.pl b/lib/unicode/In/Hebrew.pl index e34e6feb39..abe7b9ede4 100644 --- a/lib/unicode/In/Hebrew.pl +++ b/lib/unicode/In/Hebrew.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0590 05FF END diff --git a/lib/unicode/In/HighPrivateUseSurrogates.pl b/lib/unicode/In/HighPrivateUseSurrogates.pl index 000cb70d01..6ed7ac96fd 100644 --- a/lib/unicode/In/HighPrivateUseSurrogates.pl +++ b/lib/unicode/In/HighPrivateUseSurrogates.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; DB80 DBFF END diff --git a/lib/unicode/In/HighSurrogates.pl b/lib/unicode/In/HighSurrogates.pl index 95c7498511..924a0c9bdb 100644 --- a/lib/unicode/In/HighSurrogates.pl +++ b/lib/unicode/In/HighSurrogates.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; D800 DB7F END diff --git a/lib/unicode/In/Hiragana.pl b/lib/unicode/In/Hiragana.pl index ce8c3ed223..7a65302188 100644 --- a/lib/unicode/In/Hiragana.pl +++ b/lib/unicode/In/Hiragana.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3040 309F END diff --git a/lib/unicode/In/IPAExtensions.pl b/lib/unicode/In/IPAExtensions.pl index 106d84bb83..20906d6300 100644 --- a/lib/unicode/In/IPAExtensions.pl +++ b/lib/unicode/In/IPAExtensions.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0250 02AF END diff --git a/lib/unicode/In/Kanbun.pl b/lib/unicode/In/Kanbun.pl index 6d575a86bc..57d6bd21f4 100644 --- a/lib/unicode/In/Kanbun.pl +++ b/lib/unicode/In/Kanbun.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 3190 319F END diff --git a/lib/unicode/In/Kannada.pl b/lib/unicode/In/Kannada.pl index ad70ade385..109197a6f7 100644 --- a/lib/unicode/In/Kannada.pl +++ b/lib/unicode/In/Kannada.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0C80 0CFF END diff --git a/lib/unicode/In/Katakana.pl b/lib/unicode/In/Katakana.pl index cb0f30e474..93bd5a03fa 100644 --- a/lib/unicode/In/Katakana.pl +++ b/lib/unicode/In/Katakana.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 30A0 30FF END diff --git a/lib/unicode/In/Lao.pl b/lib/unicode/In/Lao.pl index ff2d587264..41ff11f805 100644 --- a/lib/unicode/In/Lao.pl +++ b/lib/unicode/In/Lao.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0E80 0EFF END diff --git a/lib/unicode/In/Latin-1Supplement.pl b/lib/unicode/In/Latin-1Supplement.pl index 3c8b04cac0..1b252eb23e 100644 --- a/lib/unicode/In/Latin-1Supplement.pl +++ b/lib/unicode/In/Latin-1Supplement.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0080 00FF END diff --git a/lib/unicode/In/LatinExtended-A.pl b/lib/unicode/In/LatinExtended-A.pl index 872689f969..b8be987db0 100644 --- a/lib/unicode/In/LatinExtended-A.pl +++ b/lib/unicode/In/LatinExtended-A.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0100 017F END diff --git a/lib/unicode/In/LatinExtended-B.pl b/lib/unicode/In/LatinExtended-B.pl index be497d6bfb..b9aff43f3d 100644 --- a/lib/unicode/In/LatinExtended-B.pl +++ b/lib/unicode/In/LatinExtended-B.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0180 024F END diff --git a/lib/unicode/In/LatinExtendedAdditional.pl b/lib/unicode/In/LatinExtendedAdditional.pl index 3f1cda1271..d309e90814 100644 --- a/lib/unicode/In/LatinExtendedAdditional.pl +++ b/lib/unicode/In/LatinExtendedAdditional.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 1E00 1EFF END diff --git a/lib/unicode/In/LetterlikeSymbols.pl b/lib/unicode/In/LetterlikeSymbols.pl index 96ab07b446..1768740d42 100644 --- a/lib/unicode/In/LetterlikeSymbols.pl +++ b/lib/unicode/In/LetterlikeSymbols.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2100 214F END diff --git a/lib/unicode/In/LowSurrogates.pl b/lib/unicode/In/LowSurrogates.pl index a30148c54e..752b264e81 100644 --- a/lib/unicode/In/LowSurrogates.pl +++ b/lib/unicode/In/LowSurrogates.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; DC00 DFFF END diff --git a/lib/unicode/In/Malayalam.pl b/lib/unicode/In/Malayalam.pl index 784bac9004..8fb57cdb10 100644 --- a/lib/unicode/In/Malayalam.pl +++ b/lib/unicode/In/Malayalam.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0D00 0D7F END diff --git a/lib/unicode/In/MathematicalOperators.pl b/lib/unicode/In/MathematicalOperators.pl index b1c2db47cb..055f19e590 100644 --- a/lib/unicode/In/MathematicalOperators.pl +++ b/lib/unicode/In/MathematicalOperators.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2200 22FF END diff --git a/lib/unicode/In/MiscellaneousSymbols.pl b/lib/unicode/In/MiscellaneousSymbols.pl index 5c6dcd4271..9dcdd26954 100644 --- a/lib/unicode/In/MiscellaneousSymbols.pl +++ b/lib/unicode/In/MiscellaneousSymbols.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2600 26FF END diff --git a/lib/unicode/In/MiscellaneousTechnical.pl b/lib/unicode/In/MiscellaneousTechnical.pl index 0eb7d1e34b..370c00f320 100644 --- a/lib/unicode/In/MiscellaneousTechnical.pl +++ b/lib/unicode/In/MiscellaneousTechnical.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2300 23FF END diff --git a/lib/unicode/In/NumberForms.pl b/lib/unicode/In/NumberForms.pl index 7d83d317b9..d33ece0bbc 100644 --- a/lib/unicode/In/NumberForms.pl +++ b/lib/unicode/In/NumberForms.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2150 218F END diff --git a/lib/unicode/In/OpticalCharacterRecognition.pl b/lib/unicode/In/OpticalCharacterRecognition.pl index 9168cc758b..be1d981c7c 100644 --- a/lib/unicode/In/OpticalCharacterRecognition.pl +++ b/lib/unicode/In/OpticalCharacterRecognition.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2440 245F END diff --git a/lib/unicode/In/Oriya.pl b/lib/unicode/In/Oriya.pl index 4d61ed359a..5a680f6743 100644 --- a/lib/unicode/In/Oriya.pl +++ b/lib/unicode/In/Oriya.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0B00 0B7F END diff --git a/lib/unicode/In/PrivateUse.pl b/lib/unicode/In/PrivateUse.pl index 5b90e4d9b3..0c118f4fe4 100644 --- a/lib/unicode/In/PrivateUse.pl +++ b/lib/unicode/In/PrivateUse.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; E000 F8FF END diff --git a/lib/unicode/In/SmallFormVariants.pl b/lib/unicode/In/SmallFormVariants.pl index 4153052890..736415e67e 100644 --- a/lib/unicode/In/SmallFormVariants.pl +++ b/lib/unicode/In/SmallFormVariants.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FE50 FE6F END diff --git a/lib/unicode/In/SpacingModifierLetters.pl b/lib/unicode/In/SpacingModifierLetters.pl index 69179e615d..6e9cdf0b53 100644 --- a/lib/unicode/In/SpacingModifierLetters.pl +++ b/lib/unicode/In/SpacingModifierLetters.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 02B0 02FF END diff --git a/lib/unicode/In/Specials.pl b/lib/unicode/In/Specials.pl index 6be56a4039..f9f730f840 100644 --- a/lib/unicode/In/Specials.pl +++ b/lib/unicode/In/Specials.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; FFF0 FFFD END diff --git a/lib/unicode/In/SuperscriptsandSubscripts.pl b/lib/unicode/In/SuperscriptsandSubscripts.pl index c4041aae3e..efcec0b841 100644 --- a/lib/unicode/In/SuperscriptsandSubscripts.pl +++ b/lib/unicode/In/SuperscriptsandSubscripts.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2070 209F END diff --git a/lib/unicode/In/Tamil.pl b/lib/unicode/In/Tamil.pl index 27f61fa3d7..e65ed2fa19 100644 --- a/lib/unicode/In/Tamil.pl +++ b/lib/unicode/In/Tamil.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0B80 0BFF END diff --git a/lib/unicode/In/Telugu.pl b/lib/unicode/In/Telugu.pl index 7342ec2cb1..d5ed2368c2 100644 --- a/lib/unicode/In/Telugu.pl +++ b/lib/unicode/In/Telugu.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0C00 0C7F END diff --git a/lib/unicode/In/Thai.pl b/lib/unicode/In/Thai.pl index c5c789c3e0..3376de4e18 100644 --- a/lib/unicode/In/Thai.pl +++ b/lib/unicode/In/Thai.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0E00 0E7F END diff --git a/lib/unicode/In/Tibetan.pl b/lib/unicode/In/Tibetan.pl index bf2888d38d..50837ad8bc 100644 --- a/lib/unicode/In/Tibetan.pl +++ b/lib/unicode/In/Tibetan.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0F00 0FFF END diff --git a/lib/unicode/Is/Upper.pl b/lib/unicode/Is/Upper.pl index eb8052e70d..8dde2742d0 100644 --- a/lib/unicode/Is/Upper.pl +++ b/lib/unicode/Is/Upper.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0041 005a 00c0 00d6 diff --git a/lib/unicode/Is/Word.pl b/lib/unicode/Is/Word.pl index f30d2f126b..23186bd27d 100644 --- a/lib/unicode/Is/Word.pl +++ b/lib/unicode/Is/Word.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0030 0039 0041 005a diff --git a/lib/unicode/Is/XDigit.pl b/lib/unicode/Is/XDigit.pl index f0b7044eb6..e55682500b 100644 --- a/lib/unicode/Is/XDigit.pl +++ b/lib/unicode/Is/XDigit.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0030 0039 0041 0046 diff --git a/lib/unicode/Is/Z.pl b/lib/unicode/Is/Z.pl index 42e0249273..22a9792d4f 100644 --- a/lib/unicode/Is/Z.pl +++ b/lib/unicode/Is/Z.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0020 00a0 diff --git a/lib/unicode/Is/Zl.pl b/lib/unicode/Is/Zl.pl index cdc04d65d6..0989e1d920 100644 --- a/lib/unicode/Is/Zl.pl +++ b/lib/unicode/Is/Zl.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2028 END diff --git a/lib/unicode/Is/Zp.pl b/lib/unicode/Is/Zp.pl index 3a6981114d..3b23446fe9 100644 --- a/lib/unicode/Is/Zp.pl +++ b/lib/unicode/Is/Zp.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 2029 END diff --git a/lib/unicode/Is/Zs.pl b/lib/unicode/Is/Zs.pl index 067c7c33df..db18055ea4 100644 --- a/lib/unicode/Is/Zs.pl +++ b/lib/unicode/Is/Zs.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0020 00a0 diff --git a/lib/unicode/JamoShort.pl b/lib/unicode/JamoShort.pl index 433ee82951..760bcba03e 100644 --- a/lib/unicode/JamoShort.pl +++ b/lib/unicode/JamoShort.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 1100 G 1101 GG diff --git a/lib/unicode/Name.pl b/lib/unicode/Name.pl index 155031cbba..ef8979f0d1 100644 --- a/lib/unicode/Name.pl +++ b/lib/unicode/Name.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0000 001f <control> 0020 SPACE diff --git a/lib/unicode/Number.pl b/lib/unicode/Number.pl index 55cc8571ff..b0e054a0d0 100644 --- a/lib/unicode/Number.pl +++ b/lib/unicode/Number.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0031 1 0032 2 diff --git a/lib/unicode/To/Digit.pl b/lib/unicode/To/Digit.pl index 1a7b88c470..a96bc1c1a6 100644 --- a/lib/unicode/To/Digit.pl +++ b/lib/unicode/To/Digit.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0030 0039 0000 00b2 00b3 0002 diff --git a/lib/unicode/To/Lower.pl b/lib/unicode/To/Lower.pl index da8512ebb6..a78a7e4492 100644 --- a/lib/unicode/To/Lower.pl +++ b/lib/unicode/To/Lower.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0041 005a 0061 00c0 00d6 00e0 diff --git a/lib/unicode/To/Title.pl b/lib/unicode/To/Title.pl index cf99256802..d8f5c048d4 100644 --- a/lib/unicode/To/Title.pl +++ b/lib/unicode/To/Title.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0061 007a 0041 00b5 039c diff --git a/lib/unicode/To/Upper.pl b/lib/unicode/To/Upper.pl index 31d6eefa88..1fc7637753 100644 --- a/lib/unicode/To/Upper.pl +++ b/lib/unicode/To/Upper.pl @@ -1,3 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; 0061 007a 0041 00b5 039c diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL index 48d40f4541..cef6936b68 100755 --- a/lib/unicode/mktables.PL +++ b/lib/unicode/mktables.PL @@ -7,7 +7,6 @@ $UnicodeData = "Unicode.300"; mkdir "In", 0777; mkdir "Is", 0777; mkdir "To", 0777; -mkdir "Eq", 0777; @todo = ( # typical @@ -337,106 +336,4 @@ END $out; } -# Create the equivalence mappings. - -open(UNICODEDATA, $UnicodeData) || die "$0: $UnicodeData: $!\n"; - -while (<UNICODEDATA>) { - ($code, $name, $category, $decomposition) = (split /;/)[0,1,2,5]; - - $code{$name} = $code; - $name{$code} = $name; - $category{$code} = $category; - - next unless $category =~ /^L/; - - # The definition of "equivalence" is twofold. - if ($decomposition ne '') { - # (1) If there's an official Unicode decomposition - # and the base is a Unicode letter. - $decomposition =~ s/^<\w+> //; - @decomposition = split(' ', $decomposition); - # Some Arabic ligatures like - # FC5E;ARABIC LIGATURE SHADDA WITH DAMMATAN ISOLATED FORM;Lo;... - # are problematic because their decomposition begins with - # a space (0020) -- which could be just skipped -- but then - # their base glyph is not a letter, for example - # the above decomposes as <isolated> 0020 064C 0651, - # but 064C is 064C;ARABIC DAMMATAN;Mn;... - # (the 0651 being ARABIC SHADDA;Mn) - ($basecode) = shift @decomposition; - push @base, [ $code, $basecode ]; - } elsif ($name =~ /^(.+?) WITH /) { - # (2) If there's a "FOO WITH ..." Unicode name and FOO - # happens to be valid Unicode letter. This is - # a debatable definition and all fault is by me (jhi). - # For example this definition adds - # LATIN SMALL LETTER O WITH STROKE - # as a derivative of - # LATIN SMALL LETTER O - # which some might rightfully contest, especially - # the speakers of languages who have the former - # phonetically as very distinct from the latter. - push @with, [ $code, $1 ]; - } -} - -foreach my $w (@with) { - ($code, $basename) = @$w; - next if not exists $code{$basename} or - not $category{$code{$basename}} =~ /^L/; - push @base, [ $code, $code{$basename} ]; -} - -@base = sort { $a->[0] cmp $b->[0] } @base; - -foreach my $b (@base) { - ($code, $basecode) = @$b; - $basename = $name{$basecode}; - next if not defined $basename or - not exists $code{$basename} or - not $category{$code{$basename}} =~ /^L/; - push @{$unicode{$code{$basename}}}, $code; -# print "$code: $name{$code} -> $basename\n", -} - -@unicode = sort keys %unicode; - -print "EqUnicode\n"; -if (open(OUT, ">Eq/Unicode.pl")) { - print OUT <<EOH; -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! -# This file is built by $0 from e.g. $UnicodeData. -# Any changes made here will be lost! -return <<'END'; -EOH - foreach my $c (@unicode) { - print OUT "$c @{$unicode{$c}}\n"; - } - print OUT "END\n"; - close OUT; -} else { - die "$0: failed to open Eq/Unicode.pl for writing: $!\n"; -} - -print "EqLatin1\n"; -if (open(OUT, ">Eq/Latin1.pl")) { - print OUT <<EOH; -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! -# This file is built by $0 from e.g. $UnicodeData. -# Any changes made here will be lost! -return <<'END'; -EOH - foreach my $c (@unicode) { - last if hex($c) > 255; - my @c = grep { hex($_) < 256 } @{$unicode{$c}}; - next unless @c; - print OUT "$c @c\n"; - } - print OUT "END\n"; - close OUT; -} else { - die "$0: failed to open Eq/Latin1.pl for writing: $!\n"; -} - # eof diff --git a/lib/utf8.pm b/lib/utf8.pm index d9e9becdda..3098fe21bd 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -70,6 +70,6 @@ of byte semantics. =head1 SEE ALSO -L<perlunicode>, L<byte> +L<perlunicode>, L<bytes> =cut diff --git a/lib/warnings.pm b/lib/warnings.pm index 6b87d85f2b..11fd5b0718 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -17,98 +17,141 @@ warnings - Perl pragma to control optional warnings 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] - '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\x04\x00\x00\x00\x00", # [17] - 'digit' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18] - '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\x40\x00\x00\x00\x00", # [19] - '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\x01\x00\x00\x00", # [20] - 'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4] - 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29] - 'precedence' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21] - '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] - '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\x08\x00\x00\x00\x00", # [17] - 'digit' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18] - '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\x80\x00\x00\x00\x00", # [19] - '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\x02\x00\x00\x00", # [20] - 'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4] - 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29] - 'precedence' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21] - '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 ; @@ -141,12 +184,34 @@ sub unimport { 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; diff --git a/makedef.pl b/makedef.pl index 1b77855814..e3b6fd638f 100644 --- a/makedef.pl +++ b/makedef.pl @@ -100,6 +100,33 @@ while (<CFG>) { } close(CFG); +# perl.h logic duplication begins + +if ($define{USE_ITHREADS}) { + if (!$define{MULTIPLICITY} && !defined{PERL_OBJECT}) { + $define{MULTIPLICITY} = 1; + } +} + +$define{PERL_IMPLICIT_CONTEXT} ||= + $define{USE_ITHREADS} || + $define{USE_THREADS} || + $define{MULTIPLICITY} ; + +if ($define{PERL_CAPI}) { + delete $define{PERL_OBJECT}; + $define{MULTIPLICITY} = 1; + $define{PERL_IMPLICIT_CONTEXT} = 1; + $define{PERL_IMPLICIT_SYS} = 1; +} + +if ($define{PERL_OBJECT}) { + $define{PERL_IMPLICIT_CONTEXT} = 1; + $define{PERL_IMPLICIT_SYS} = 1; +} + +# perl.h logic duplication ends + if ($PLATFORM eq 'win32') { warn join(' ',keys %define)."\n"; print "LIBRARY Perl56\n"; @@ -314,9 +341,18 @@ else { )]; } +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 + Perl_get_mstats Perl_malloc Perl_mfree Perl_realloc @@ -332,6 +368,7 @@ else { skip_symbols [qw( PL_malloc_mutex Perl_dump_mstats + Perl_get_mstats Perl_malloc Perl_mfree Perl_realloc @@ -476,6 +513,11 @@ if ($define{'PERL_OBJECT'} || $define{'MULTIPLICITY'}) { my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" }); emit_symbols $glob; } + # XXX AIX seems to want the perlvars.h symbols, for some reason + if ($PLATFORM eq 'aix') { + my $glob = readvar($perlvars_h); + emit_symbols $glob; + } } else { unless ($define{'PERL_GLOBAL_STRUCT'}) { @@ -125,6 +125,9 @@ # Type of size argument for allocation functions MEM_SIZE unsigned long + # size of void* + PTRSIZE 4 + # Maximal value in LONG LONG_MAX 0x7FFFFFFF @@ -245,6 +248,9 @@ # ifndef Malloc_t # define Malloc_t void * # endif +# ifndef PTRSIZE +# define PTRSIZE 4 +# endif # ifndef MEM_SIZE # define MEM_SIZE unsigned long # endif @@ -332,6 +338,13 @@ } STMT_END #endif +#ifdef PERL_IMPLICIT_CONTEXT +# define PERL_IS_ALIVE aTHX +#else +# define PERL_IS_ALIVE TRUE +#endif + + /* * Layout of memory: * ~~~~~~~~~~~~~~~~ @@ -815,6 +828,16 @@ static char bucket_of[] = # define SBRK_FAILURE_PRICE 50 #endif +static void morecore (register int bucket); +# if defined(DEBUGGING) +static void botch (char *diag, char *s); +# endif +static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip); +static void* get_from_chain (MEM_SIZE size); +static void* get_from_bigger_buckets(int bucket, MEM_SIZE size); +static union overhead *getpages (MEM_SIZE needed, int *nblksp, int bucket); +static int getpages_adjacent(MEM_SIZE require); + #if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE) # ifndef BIG_SIZE @@ -831,18 +854,6 @@ static char bucket_of[] = static char *emergency_buffer; static MEM_SIZE emergency_buffer_size; -static int findbucket (union overhead *freep, int srchlen); -static void morecore (register int bucket); -# if defined(DEBUGGING) -static void botch (char *diag, char *s); -# endif -static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip); -static Malloc_t emergency_sbrk (MEM_SIZE size); -static void* get_from_chain (MEM_SIZE size); -static void* get_from_bigger_buckets(int bucket, MEM_SIZE size); -static union overhead *getpages (int needed, int *nblksp, int bucket); -static int getpages_adjacent(int require); - static Malloc_t emergency_sbrk(MEM_SIZE size) { @@ -908,14 +919,22 @@ emergency_sbrk(MEM_SIZE size) # define emergency_sbrk(size) -1 #endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ +#ifndef BITS_IN_PTR +# define BITS_IN_PTR (8*PTRSIZE) +#endif + /* * nextf[i] is the pointer to the next free block of size 2^i. The * smallest allocatable block is 8 bytes. The overhead information * precedes the data area returned to the user. */ -#define NBUCKETS (32*BUCKETS_PER_POW2 + 1) +#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1) static union overhead *nextf[NBUCKETS]; +#if defined(PURIFY) && !defined(USE_PERL_SBRK) +# define USE_PERL_SBRK +#endif + #ifdef USE_PERL_SBRK #define sbrk(a) Perl_sbrk(a) Malloc_t Perl_sbrk (int size); @@ -947,7 +966,7 @@ static u_int goodsbrk; static void botch(char *diag, char *s) { - dTHXo; + dTHX; PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s); PerlProc_abort(); } @@ -1032,13 +1051,13 @@ Perl_malloc(register size_t nbytes) /* 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", @@ -1179,14 +1198,14 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) } static union overhead * -getpages(int needed, int *nblksp, int bucket) +getpages(MEM_SIZE needed, int *nblksp, int bucket) { /* Need to do (possibly expensive) system call. Try to optimize it for rare calling. */ MEM_SIZE require = needed - sbrked_remains; char *cp; union overhead *ovp; - int slack = 0; + MEM_SIZE slack = 0; if (sbrk_good > 0) { if (!last_sbrk_top && require < FIRST_SBRK) @@ -1332,7 +1351,7 @@ getpages(int needed, int *nblksp, int bucket) } static int -getpages_adjacent(int require) +getpages_adjacent(MEM_SIZE require) { if (require <= sbrked_remains) { sbrked_remains -= require; @@ -1502,18 +1521,36 @@ Perl_mfree(void *mp) { 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 @@ -1584,19 +1621,39 @@ Perl_realloc(void *mp, size_t nbytes) { 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 */ } @@ -1717,28 +1774,6 @@ Perl_realloc(void *mp, size_t nbytes) return ((Malloc_t)res); } -/* - * Search ``srchlen'' elements of each free list for a block whose - * header starts at ``freep''. If srchlen is -1 search the whole list. - * Return bucket number, or -1 if not found. - */ -static int -findbucket(union overhead *freep, int srchlen) -{ - register union overhead *p; - register int i, j; - - for (i = 0; i < NBUCKETS; i++) { - j = 0; - for (p = nextf[i]; p && j != srchlen; p = p->ov_next) { - if (p == freep) - return (i); - j++; - } - } - return (-1); -} - Malloc_t Perl_calloc(register size_t elements, register size_t size) { @@ -1814,95 +1849,134 @@ Perl_malloced_size(void *p) # else # define MIN_EVEN_REPORT MIN_BUCKET # endif -/* - * mstats - print out statistics about malloc - * - * Prints two lines of numbers, one showing the length of the free list - * for each size category, the second showing the number of mallocs - - * frees for each size category. - */ -void -Perl_dump_mstats(pTHX_ char *s) + +int +Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) { #ifdef DEBUGGING_MSTATS register int i, j; register union overhead *p; - int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0; - u_int nfree[NBUCKETS]; - int total_chain = 0; struct chunk_chain_s* nextchain; + buf->topbucket = buf->topbucket_ev = buf->topbucket_odd + = buf->totfree = buf->total = buf->total_chain = 0; + + buf->minbucket = MIN_BUCKET; MALLOC_LOCK; for (i = MIN_BUCKET ; i < NBUCKETS; i++) { for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) ; - nfree[i] = j; - totfree += nfree[i] * BUCKET_SIZE_REAL(i); - total += nmalloc[i] * BUCKET_SIZE_REAL(i); + if (i < buflen) { + buf->nfree[i] = j; + buf->ntotal[i] = nmalloc[i]; + } + buf->totfree += j * BUCKET_SIZE_REAL(i); + buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i); if (nmalloc[i]) { - i % 2 ? (topbucket_odd = i) : (topbucket_ev = i); - topbucket = i; + i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i); + buf->topbucket = i; } } nextchain = chunk_chain; while (nextchain) { - total_chain += nextchain->size; + buf->total_chain += nextchain->size; nextchain = nextchain->next; } + buf->total_sbrk = goodsbrk + sbrk_slack; + buf->sbrks = sbrks; + buf->sbrk_good = sbrk_good; + buf->sbrk_slack = sbrk_slack; + buf->start_slack = start_slack; + buf->sbrked_remains = sbrked_remains; MALLOC_UNLOCK; + if (level) { + for (i = MIN_BUCKET ; i < NBUCKETS; i++) { + if (i >= buflen) + break; + buf->bucket_mem_size[i] = BUCKET_SIZE(i); + buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i); + } + } +#endif /* defined DEBUGGING_MSTATS */ + return 0; /* XXX unused */ +} +/* + * mstats - print out statistics about malloc + * + * Prints two lines of numbers, one showing the length of the free list + * for each size category, the second showing the number of mallocs - + * frees for each size category. + */ +void +Perl_dump_mstats(pTHX_ char *s) +{ +#ifdef DEBUGGING_MSTATS + register int i, j; + register union overhead *p; + perl_mstats_t buffer; + unsigned long nf[NBUCKETS]; + unsigned long nt[NBUCKETS]; + struct chunk_chain_s* nextchain; + + buffer.nfree = nf; + buffer.ntotal = nt; + get_mstats(&buffer, NBUCKETS, 0); + if (s) PerlIO_printf(Perl_error_log, "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n", s, (long)BUCKET_SIZE_REAL(MIN_BUCKET), (long)BUCKET_SIZE(MIN_BUCKET), - (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket)); - PerlIO_printf(Perl_error_log, "%8d free:", totfree); - for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { + (long)BUCKET_SIZE_REAL(buffer.topbucket), + (long)BUCKET_SIZE(buffer.topbucket)); + PerlIO_printf(Perl_error_log, "%8ld free:", buffer.totfree); + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nfree[i]); + buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nfree[i]); + buffer.nfree[i]); } #endif - PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree); - for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, "\n%8ld used:", buffer.total - buffer.totfree); + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nmalloc[i] - nfree[i]); + buffer.ntotal[i] - buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nmalloc[i] - nfree[i]); + buffer.ntotal[i] - buffer.nfree[i]); } #endif - PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", - goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack, - start_slack, total_chain, sbrked_remains); + PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %ld/%ld:%ld. Odd ends: pad+heads+chain+tail: %ld+%ld+%ld+%ld.\n", + buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, + buffer.sbrk_slack, buffer.start_slack, + buffer.total_chain, buffer.sbrked_remains); #endif /* DEBUGGING_MSTATS */ } #endif /* lint */ #ifdef USE_PERL_SBRK -# if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__) +# if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__) || defined(PURIFY) # define PERL_SBRK_VIA_MALLOC /* * MachTen's malloc() returns a buffer aligned on a two-byte boundary. @@ -1009,7 +1009,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) 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; } diff --git a/myconfig.SH b/myconfig.SH index dc76e73175..7861f5e0ed 100644 --- a/myconfig.SH +++ b/myconfig.SH @@ -33,9 +33,9 @@ Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL uname='$myuname' config_args='$config_args' hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction - usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads - usesocks=$usesocks useperlio=$useperlio d_sfio=$d_sfio - use64bits=$use64bits uselargefiles=$uselargefiles usemultiplicity=$usemultiplicity + usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads usemultiplicity=$usemultiplicity + useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles + use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble usesocks=$usesocks Compiler: cc='$cc', optimize='$optimize', gccversion=$gccversion cppflags='$cppflags' @@ -43,6 +43,7 @@ Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize + ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize alignbytes=$alignbytes, usemymalloc=$usemymalloc, prototype=$prototype Linker and Libraries: ld='$ld', ldflags ='$ldflags' @@ -13,7 +13,6 @@ /* XXX soon to be eliminated, only a few things in PERLCORE need these now */ #if defined(PERL_IMPLICIT_SYS) -#else #endif #if defined(USE_ITHREADS) # if defined(PERL_IMPLICIT_SYS) @@ -1738,6 +1737,10 @@ #define Perl_sv_vsetpvfn pPerl->Perl_sv_vsetpvfn #undef sv_vsetpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn +#undef Perl_str_to_version +#define Perl_str_to_version pPerl->Perl_str_to_version +#undef str_to_version +#define str_to_version Perl_str_to_version #undef Perl_swash_init #define Perl_swash_init pPerl->Perl_swash_init #undef swash_init @@ -1830,6 +1833,10 @@ #define Perl_dump_mstats pPerl->Perl_dump_mstats #undef dump_mstats #define dump_mstats Perl_dump_mstats +#undef Perl_get_mstats +#define Perl_get_mstats pPerl->Perl_get_mstats +#undef get_mstats +#define get_mstats Perl_get_mstats #endif #undef Perl_safesysmalloc #define Perl_safesysmalloc pPerl->Perl_safesysmalloc @@ -1983,6 +1990,7 @@ #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 @@ -1991,6 +1999,7 @@ #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 @@ -2019,6 +2028,22 @@ #define Perl_sv_pvbyte pPerl->Perl_sv_pvbyte #undef sv_pvbyte #define sv_pvbyte Perl_sv_pvbyte +#undef Perl_sv_utf8_upgrade +#define Perl_sv_utf8_upgrade pPerl->Perl_sv_utf8_upgrade +#undef sv_utf8_upgrade +#define sv_utf8_upgrade Perl_sv_utf8_upgrade +#undef Perl_sv_utf8_downgrade +#define Perl_sv_utf8_downgrade pPerl->Perl_sv_utf8_downgrade +#undef sv_utf8_downgrade +#define sv_utf8_downgrade Perl_sv_utf8_downgrade +#undef Perl_sv_utf8_encode +#define Perl_sv_utf8_encode pPerl->Perl_sv_utf8_encode +#undef sv_utf8_encode +#define sv_utf8_encode Perl_sv_utf8_encode +#undef Perl_sv_utf8_decode +#define Perl_sv_utf8_decode pPerl->Perl_sv_utf8_decode +#undef sv_utf8_decode +#define sv_utf8_decode Perl_sv_utf8_decode #undef Perl_sv_force_normal #define Perl_sv_force_normal pPerl->Perl_sv_force_normal #undef sv_force_normal @@ -2131,12 +2156,16 @@ #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 @@ -2153,9 +2182,6 @@ #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #endif #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -# if defined(PURIFY) -# else -# endif # if defined(DEBUGGING) # endif #endif @@ -151,7 +151,7 @@ Perl_pad_allocmy(pTHX_ char *name) } 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); @@ -163,7 +163,7 @@ Perl_pad_allocmy(pTHX_ char *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, @@ -179,9 +179,9 @@ Perl_pad_allocmy(pTHX_ char *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; } @@ -1412,18 +1412,19 @@ Perl_mod(pTHX_ OP *o, I32 type) if (kid->op_type == OP_METHOD_NAMED || kid->op_type == OP_METHOD) { - OP *newop; + UNOP *newop; if (kid->op_sibling || kid->op_next != kid) { yyerror("panic: unexpected optree near method call"); break; } - NewOp(1101, newop, 1, OP); + NewOp(1101, newop, 1, UNOP); newop->op_type = OP_RV2CV; newop->op_ppaddr = PL_ppaddr[OP_RV2CV]; - newop->op_next = newop; - kid->op_sibling = newop; + newop->op_first = Nullop; + newop->op_next = (OP*)newop; + kid->op_sibling = (OP*)newop; newop->op_private |= OPpLVAL_INTRO; break; } @@ -1946,7 +1947,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) 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 || @@ -1957,7 +1958,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) 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); } @@ -2606,7 +2607,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) I32 to_utf = o->op_private & OPpTRANS_TO_UTF; if (complement) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; U8** cp; UV nextmin = 0; New(1109, cp, tlen, U8*); @@ -3105,45 +3106,55 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) veop = Nullop; - if(version != Nullop) { + if (version != Nullop) { SV *vesv = ((SVOP*)version)->op_sv; - if (arg == Nullop && !SvNIOK(vesv)) { + if (arg == Nullop && !SvNIOKp(vesv)) { arg = version; } else { OP *pack; + SV *meth; - if (version->op_type != OP_CONST || !SvNIOK(vesv)) + if (version->op_type != OP_CONST || !SvNIOKp(vesv)) Perl_croak(aTHX_ "Version number must be constant number"); /* Make copy of id so we don't free it twice */ pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); /* Fake up a method call to VERSION */ + meth = newSVpvn("VERSION",7); + sv_upgrade(meth, SVt_PVIV); + SvIOK_on(meth); + PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth)); veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, append_elem(OP_LIST, - prepend_elem(OP_LIST, pack, list(version)), - newSVOP(OP_METHOD_NAMED, 0, - newSVpvn("VERSION", 7)))); + prepend_elem(OP_LIST, pack, list(version)), + newSVOP(OP_METHOD_NAMED, 0, meth))); } } /* Fake up an import/unimport */ if (arg && arg->op_type == OP_STUB) imop = arg; /* no import on explicit () */ - else if(SvNIOK(((SVOP*)id)->op_sv)) { + else if (SvNIOKp(((SVOP*)id)->op_sv)) { imop = Nullop; /* use 5.0; */ } else { + SV *meth; + /* Make copy of id so we don't free it twice */ pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); + + /* Fake up a method call to import/unimport */ + meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);; + sv_upgrade(meth, SVt_PVIV); + SvIOK_on(meth); + PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth)); imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, - append_elem(OP_LIST, - prepend_elem(OP_LIST, pack, list(arg)), - newSVOP(OP_METHOD_NAMED, 0, - aver ? newSVpvn("import", 6) - : newSVpvn("unimport", 8)))); + append_elem(OP_LIST, + prepend_elem(OP_LIST, pack, list(arg)), + newSVOP(OP_METHOD_NAMED, 0, meth))); } /* Fake up a require, handle override, if any */ @@ -3504,9 +3515,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } } if (first->op_type == OP_CONST) { - if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE)) - Perl_warner(aTHX_ WARN_PRECEDENCE, "Probable precedence problem on %s", - PL_op_desc[type]); + if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) + Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional"); if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { op_free(first); *firstp = Nullop; @@ -3524,7 +3534,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) 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; @@ -3553,7 +3563,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) 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) @@ -3754,6 +3764,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * OP *listop; OP *o; OP *condop; + U8 loopflags = 0; if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) { @@ -3786,8 +3797,10 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * block = scope(block); } - if (cont) + if (cont) { next = LINKLIST(cont); + loopflags |= OPpLOOP_CONTINUE; + } if (expr) { cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0)); if ((line_t)whileline != NOLINE) { @@ -3830,6 +3843,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * loop->op_redoop = redo; loop->op_lastop = o; + o->op_private |= loopflags; if (next) loop->op_nextop = next; @@ -4214,7 +4228,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) { 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; @@ -4230,7 +4244,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) 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); } } @@ -4247,10 +4261,10 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv) { SV *sv = Nullsv; - if(!o) + if (!o) return Nullsv; - if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) + if (o->op_type == OP_LINESEQ && cLISTOPo->op_first) o = cLISTOPo->op_first->op_sibling; for (; o; o = o->op_next) { @@ -4336,9 +4350,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) 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); } @@ -4370,13 +4384,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name); if (!block) goto withattrs; - if(const_sv = cv_const_sv(cv)) + 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); @@ -5354,8 +5364,8 @@ Perl_ck_fun(pTHX_ OP *o) 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); @@ -5374,8 +5384,8 @@ Perl_ck_fun(pTHX_ OP *o) 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); @@ -5494,6 +5504,7 @@ Perl_ck_glob(pTHX_ OP *o) { GV *gv; + o = ck_fun(o); if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) append_elem(OP_GLOB, o, newDEFSVOP()); @@ -5532,7 +5543,7 @@ Perl_ck_glob(pTHX_ OP *o) gv_IOadd(gv); append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); scalarkids(o); - return ck_fun(o); + return o; } OP * @@ -5709,7 +5720,9 @@ Perl_ck_sassign(pTHX_ OP *o) OP *kid = cLISTOPo->op_first; /* has a disposable target? */ if ((PL_opargs[kid->op_type] & OA_TARGLEX) - && !(kid->op_flags & OPf_STACKED)) + && !(kid->op_flags & OPf_STACKED) + /* Cannot steal the second time! */ + && !(kid->op_private & OPpTARGET_MY)) { OP *kkid = kid->op_sibling; @@ -5956,7 +5969,7 @@ S_simplify_sort(pTHX_ OP *o) return; if (strEQ(GvNAME(gv), "a")) reversed = 0; - else if(strEQ(GvNAME(gv), "b")) + else if (strEQ(GvNAME(gv), "b")) reversed = 1; else return; @@ -6379,13 +6392,13 @@ Perl_peep(pTHX_ register OP *o) 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)); } @@ -6446,11 +6459,12 @@ Perl_peep(pTHX_ register OP *o) UNOP *rop; SV *lexname; GV **fields; - SV **svp, **indsvp; + SV **svp, **indsvp, *sv; I32 ind; char *key; STRLEN keylen; + o->op_seq = PL_op_seqmax++; if ((o->op_private & (OPpLVAL_INTRO)) || ((BINOP*)o)->op_last->op_type != OP_CONST) break; @@ -6477,8 +6491,76 @@ Perl_peep(pTHX_ register OP *o) rop->op_ppaddr = PL_ppaddr[OP_RV2AV]; o->op_type = OP_AELEM; o->op_ppaddr = PL_ppaddr[OP_AELEM]; + sv = newSViv(ind); + if (SvREADONLY(*svp)) + SvREADONLY_on(sv); + SvFLAGS(sv) |= (SvFLAGS(*svp) + & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY)); SvREFCNT_dec(*svp); - *svp = newSViv(ind); + *svp = sv; + break; + } + + case OP_HSLICE: { + UNOP *rop; + SV *lexname; + GV **fields; + SV **svp, **indsvp, *sv; + I32 ind; + char *key; + STRLEN keylen; + SVOP *first_key_op, *key_op; + + o->op_seq = PL_op_seqmax++; + if ((o->op_private & (OPpLVAL_INTRO)) + /* I bet there's always a pushmark... */ + || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST) + /* hmmm, no optimization if list contains only one key. */ + break; + rop = (UNOP*)((LISTOP*)o)->op_last; + if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV) + break; + lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE); + if (!SvOBJECT(lexname)) + break; + fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); + if (!fields || !GvHV(*fields)) + break; + /* Again guessing that the pushmark can be jumped over.... */ + first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling) + ->op_first->op_sibling; + /* Check that the key list contains only constants. */ + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) + if (key_op->op_type != OP_CONST) + break; + if (key_op) + break; + rop->op_type = OP_RV2AV; + rop->op_ppaddr = PL_ppaddr[OP_RV2AV]; + o->op_type = OP_ASLICE; + o->op_ppaddr = PL_ppaddr[OP_ASLICE]; + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) { + svp = cSVOPx_svp(key_op); + key = SvPV(*svp, keylen); + indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + if (!indsvp) { + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" " + "in variable %s of type %s", + key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); + } + ind = SvIV(*indsvp); + if (ind < 1) + Perl_croak(aTHX_ "Bad index while coercing array into hash"); + sv = newSViv(ind); + if (SvREADONLY(*svp)) + SvREADONLY_on(sv); + SvFLAGS(sv) |= (SvFLAGS(*svp) + & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY)); + SvREFCNT_dec(*svp); + *svp = sv; + } break; } @@ -139,6 +139,9 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_REPEAT */ #define OPpREPEAT_DOLIST 64 /* List replication. */ +/* Private for OP_LEAVELOOP */ +#define OPpLOOP_CONTINUE 64 /* a continue block is present */ + /* Private for OP_RV2?V, OP_?ELEM */ #define OPpDEREF (32|64) /* Want ref to something: */ #define OPpDEREF_AV 32 /* Want ref to AV. */ @@ -1477,7 +1477,7 @@ EXT U32 PL_opargs[] = { 0x0001368c, /* ref */ 0x00122804, /* bless */ 0x00001608, /* backtick */ - 0x00132808, /* glob */ + 0x00012808, /* glob */ 0x00001608, /* readline */ 0x00001608, /* rcatline */ 0x00002204, /* regcmaybe */ @@ -1725,7 +1725,7 @@ EXT U32 PL_opargs[] = { 0x0002291c, /* link */ 0x0002291c, /* symlink */ 0x0001368c, /* readlink */ - 0x0002291c, /* mkdir */ + 0x0012291c, /* mkdir */ 0x0001379c, /* rmdir */ 0x0002c814, /* open_dir */ 0x0000d600, /* readdir */ @@ -379,7 +379,7 @@ bless bless ck_fun s@ S S? 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% @@ -709,7 +709,7 @@ rename rename ck_fun isT@ S S 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. diff --git a/patchlevel.h b/patchlevel.h index 3c6f5a7c92..b36e20c4ff 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -5,7 +5,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 5 /* epoch */ -#define PERL_SUBVERSION 650 /* generation */ +#define PERL_SUBVERSION 660 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -27,13 +27,6 @@ char *getenv (char *); /* Usually in <stdlib.h> */ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen); -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif - #ifdef IAMSUID #ifndef DOSUID #define DOSUID @@ -162,7 +155,9 @@ perl_construct(pTHXx) 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 */ @@ -225,7 +220,7 @@ perl_construct(pTHXx) PL_patchlevel = NEWSV(0,4); SvUPGRADE(PL_patchlevel, SVt_PVNV); if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127) - SvGROW(PL_patchlevel,24); + SvGROW(PL_patchlevel, UTF8_MAXLEN*3+1); s = (U8*)SvPVX(PL_patchlevel); s = uv_to_utf8(s, (UV)PERL_REVISION); s = uv_to_utf8(s, (UV)PERL_VERSION); @@ -442,10 +437,10 @@ perl_destruct(pTHXx) /* magical thingies */ - Safefree(PL_ofs); /* $, */ + Safefree(PL_ofs); /* $, */ PL_ofs = Nullch; - Safefree(PL_ors); /* $\ */ + Safefree(PL_ors); /* $\ */ PL_ors = Nullch; SvREFCNT_dec(PL_rs); /* $/ */ @@ -454,7 +449,9 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_nrs); /* $/ helper */ PL_nrs = Nullsv; - PL_multiline = 0; /* $* */ + PL_multiline = 0; /* $* */ + Safefree(PL_osname); /* $^O */ + PL_osname = Nullch; SvREFCNT_dec(PL_statname); PL_statname = Nullsv; @@ -504,8 +501,6 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_argvout_stack); PL_argvout_stack = Nullav; - SvREFCNT_dec(PL_fdpid); - PL_fdpid = Nullav; SvREFCNT_dec(PL_modglobal); PL_modglobal = Nullhv; SvREFCNT_dec(PL_preambleav); @@ -522,6 +517,17 @@ perl_destruct(pTHXx) PL_bodytarget = Nullsv; PL_formtarget = Nullsv; + /* free locale stuff */ +#ifdef USE_LOCALE_COLLATE + Safefree(PL_collation_name); + PL_collation_name = Nullch; +#endif + +#ifdef USE_LOCALE_NUMERIC + Safefree(PL_numeric_name); + PL_numeric_name = Nullch; +#endif + /* clear utf8 character classes */ SvREFCNT_dec(PL_utf8_alnum); SvREFCNT_dec(PL_utf8_alnumc); @@ -593,14 +599,21 @@ perl_destruct(pTHXx) /* Now absolutely destruct everything, somehow or other, loops or no. */ last_sv_count = 0; + SvFLAGS(PL_fdpid) |= SVTYPEMASK; /* don't clean out pid table now */ SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */ while (PL_sv_count != 0 && PL_sv_count != last_sv_count) { last_sv_count = PL_sv_count; sv_clean_all(); } + SvFLAGS(PL_fdpid) &= ~SVTYPEMASK; + SvFLAGS(PL_fdpid) |= SVt_PVAV; SvFLAGS(PL_strtab) &= ~SVTYPEMASK; SvFLAGS(PL_strtab) |= SVt_PVHV; - + + AvREAL_off(PL_fdpid); /* no surviving entries */ + SvREFCNT_dec(PL_fdpid); /* needed in io_close() */ + PL_fdpid = Nullav; + /* Destruct the global string table. */ { /* Yell and reset the HeVAL() slots that are still holding refcounts, @@ -632,6 +645,16 @@ perl_destruct(pTHXx) } SvREFCNT_dec(PL_strtab); + /* free special SVs */ + + SvREFCNT(&PL_sv_yes) = 0; + sv_clear(&PL_sv_yes); + SvANY(&PL_sv_yes) = NULL; + + SvREFCNT(&PL_sv_no) = 0; + sv_clear(&PL_sv_no); + SvANY(&PL_sv_no) = NULL; + if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count); @@ -665,7 +688,7 @@ perl_destruct(pTHXx) Safefree(PL_thrsv); PL_thrsv = Nullsv; #endif /* USE_THREADS */ - + /* As the absolutely last thing, free the non-arena SV for mess() */ if (PL_mess_sv) { @@ -779,13 +802,20 @@ setuid perl scripts securely.\n"); 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 */ @@ -797,21 +827,34 @@ setuid perl scripts securely.\n"); 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_parse_body(pTHX_ va_list args) +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_ 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; @@ -821,8 +864,6 @@ S_parse_body(pTHX_ va_list args) 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); @@ -944,8 +985,11 @@ S_parse_body(pTHX_ va_list args) # ifdef USE_ITHREADS sv_catpv(PL_Sv," USE_ITHREADS"); # endif -# ifdef USE_64_BITS - sv_catpv(PL_Sv," USE_64_BITS"); +# ifdef USE_64_BIT_INT + sv_catpv(PL_Sv," USE_64_BIT_INT"); +# endif +# ifdef USE_64_BIT_ALL + sv_catpv(PL_Sv," USE_64_BIT_ALL"); # endif # ifdef USE_LONG_DOUBLE sv_catpv(PL_Sv," USE_LONG_DOUBLE"); @@ -1127,11 +1171,13 @@ print \" \\@INC:\\n @INC\\n\";"); CvPADLIST(PL_compcv) = comppadlist; boot_core_UNIVERSAL(); +#ifndef PERL_MICRO boot_core_xsutils(); +#endif if (xsinit) (*xsinit)(aTHXo); /* in case linked C routines want magical variables */ -#if defined(VMS) || defined(WIN32) || defined(DJGPP) +#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) init_os_extras(); #endif @@ -1207,7 +1253,7 @@ perl_run(pTHXx) { dTHR; I32 oldscope; - int ret; + int ret = 0; dJMPENV; #ifdef USE_THREADS dTHX; @@ -1215,14 +1261,23 @@ perl_run(pTHXx) 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; @@ -1233,7 +1288,8 @@ perl_run(pTHXx) 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); @@ -1241,19 +1297,30 @@ perl_run(pTHXx) } 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")); @@ -1452,13 +1519,15 @@ Perl_call_method(pTHX_ const char *methname, I32 flags) { dSP; OP myop; - if (!PL_op) + if (!PL_op) { + Zero(&myop, 1, OP); PL_op = &myop; + } XPUSHs(sv_2mortal(newSVpv(methname,0))); PUTBACK; pp_method(); - if(PL_op == &myop) - PL_op = Nullop; + if (PL_op == &myop) + PL_op = Nullop; return call_sv(*PL_stack_sp--, flags); } @@ -1518,7 +1587,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) 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); } @@ -1546,11 +1615,19 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) } 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,""); @@ -1562,6 +1639,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) /* 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(); @@ -1595,6 +1673,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) PL_curpm = newpm; LEAVE; } + JMPENV_POP; } if (flags & G_DISCARD) { @@ -1607,18 +1686,20 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) 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; @@ -1678,11 +1759,19 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) 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,""); @@ -1694,6 +1783,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) /* 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(); @@ -1714,6 +1804,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) break; } + JMPENV_POP; if (flags & G_DISCARD) { PL_stack_sp = PL_stack_base + oldmark; retval = 0; @@ -1819,6 +1910,8 @@ S_usage(pTHX_ char *name) /* XXX move this out into a module ? */ "-v print version, subversion (includes VERY IMPORTANT perl info)", "-V[:variable] print configuration summary (or a single Config.pm variable)", "-w enable many useful warnings (RECOMMENDED)", +"-W enable all warnings", +"-X disable all warnings", "-x[directory] strip off text before #!perl line and perhaps cd to directory", "\n", NULL @@ -2034,7 +2127,7 @@ Perl_moreswitches(pTHX_ char *s) s++; return s; case 'v': - printf(Perl_form(aTHX_ "\nThis is perl, v%v built for %s", + printf(Perl_form(aTHX_ "\nThis is perl, v%vd built for %s", PL_patchlevel, ARCHNAME)); #if defined(LOCAL_PATCH_COUNT) if (LOCAL_PATCH_COUNT > 0) @@ -2078,6 +2171,9 @@ Perl_moreswitches(pTHX_ char *s) #ifdef __MINT__ printf("MiNT port by Guido Flohr, 1997-1999\n"); #endif +#ifdef EPOC + printf("EPOC port by Olaf Flebbe, 1999-2000\n"); +#endif #ifdef BINARY_BUILD_NOTICE BINARY_BUILD_NOTICE; #endif @@ -2446,7 +2542,7 @@ sed %s -e \"/^[^#]/b\" \ /* Mention * I_SYSSTATVFS HAS_FSTATVFS * I_SYSMOUNT - * I_STATFS HAS_FSTATFS + * I_STATFS HAS_FSTATFS HAS_GETFSSTAT * I_MNTENT HAS_GETMNTENT HAS_HASMNTOPT * here so that metaconfig picks them up. */ @@ -3348,9 +3444,16 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) 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) { @@ -3367,6 +3470,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) : "END"); while (PL_scopestack_ix > oldscope) LEAVE; + JMPENV_POP; Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a)); } break; @@ -3381,6 +3485,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) 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"); @@ -3402,15 +3507,22 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) 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; @@ -215,7 +215,10 @@ struct perl_thread; #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 @@ -489,6 +492,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include <stdlib.h> #endif +#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ +# define MYSWAP +#endif + #if !defined(PERL_FOR_X2P) && !defined(WIN32) # include "embed.h" #endif @@ -529,6 +536,19 @@ Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes); * that causes clashes with case-insensitive linkers */ Free_t Perl_mfree (Malloc_t where); +typedef struct perl_mstats perl_mstats_t; + +struct perl_mstats { + unsigned long *nfree; + unsigned long *ntotal; + long topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; + long total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; + long minbucket; + /* Level 1 info */ + unsigned long *bucket_mem_size; + unsigned long *bucket_available_size; +}; + # define safemalloc Perl_malloc # define safecalloc Perl_calloc # define saferealloc Perl_realloc @@ -804,6 +824,10 @@ Free_t Perl_mfree (Malloc_t where); * in the face of half-implementations.) */ +#ifdef I_SYSMODE +#include <sys/mode.h> +#endif + #ifndef S_IFMT # ifdef _S_IFMT # define S_IFMT _S_IFMT @@ -882,12 +906,30 @@ Free_t Perl_mfree (Malloc_t where); # define S_IWUSR 0200 # define S_IXUSR 0100 # endif -# define S_IRGRP (S_IRUSR>>3) -# define S_IWGRP (S_IWUSR>>3) -# define S_IXGRP (S_IXUSR>>3) -# define S_IROTH (S_IRUSR>>6) -# define S_IWOTH (S_IWUSR>>6) -# define S_IXOTH (S_IXUSR>>6) +#endif + +#ifndef S_IRGRP +# ifdef S_IRUSR +# define S_IRGRP (S_IRUSR>>3) +# define S_IWGRP (S_IWUSR>>3) +# define S_IXGRP (S_IXUSR>>3) +# else +# define S_IRGRP 0040 +# define S_IWGRP 0020 +# define S_IXGRP 0010 +# endif +#endif + +#ifndef S_IROTH +# ifdef S_IRUSR +# define S_IROTH (S_IRUSR>>6) +# define S_IWOTH (S_IWUSR>>6) +# define S_IXOTH (S_IXUSR>>6) +# else +# define S_IROTH 0040 +# define S_IWOTH 0020 +# define S_IXOTH 0010 +# endif #endif #ifndef S_ISUID @@ -898,6 +940,30 @@ Free_t Perl_mfree (Malloc_t where); # define S_ISGID 02000 #endif +#ifndef S_IRWXU +# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) +#endif + +#ifndef S_IRWXG +# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) +#endif + +#ifndef S_IRWXO +# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) +#endif + +#ifndef S_IREAD +# define S_IREAD S_IRUSR +#endif + +#ifndef S_IWRITE +# define S_IWRITE S_IWUSR +#endif + +#ifndef S_IEXEC +# define S_IEXEC S_IXUSR +#endif + #ifdef ff_next # undef ff_next #endif @@ -919,7 +985,7 @@ Free_t Perl_mfree (Malloc_t where); typedef IVTYPE IV; typedef UVTYPE UV; -#if defined(USE_64_BITS) && defined(HAS_QUAD) +#if defined(USE_64_BIT_INT) && defined(HAS_QUAD) # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) # define IV_MAX INT64_MAX # define IV_MIN INT64_MIN @@ -2042,9 +2108,9 @@ char *crypt (const char*, const char*); # ifndef getenv char *getenv (const char*); # endif /* !getenv */ -#if !defined(EPOC) && !(defined(__hpux) && defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS == 64) +# if !defined(EPOC) && !(defined(__hpux) && defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS == 64) && !defined(HAS_LSEEK_PROTO) Off_t lseek (int,Off_t,int); -#endif +# endif # endif /* !DONT_DECLARE_STD */ char *getlogin (void); #endif /* !__cplusplus */ @@ -3012,24 +3078,26 @@ typedef struct am_table_short AMTS; #endif /* !USE_LOCALE_NUMERIC */ -#if !defined(Atol) && defined(HAS_LONG_LONG) +#if !defined(Atol) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG # if !defined(Atol) && defined(HAS_STRTOLL) # define Atol(s) strtoll(s, (char**)NULL, 10) # endif # if !defined(Atol) && defined(HAS_ATOLL) # define Atol atoll # endif -#endif /* is there atoq() anywhere? */ +#endif #if !defined(Atol) # define Atol atol /* we assume atol being available anywhere */ #endif -#if !defined(Strtoul) && defined(HAS_LONG_LONG) && defined(HAS_STRTOULL) -# define Strtoul strtoull +#if !defined(Strtoul) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG +# if !defined(Strtoul) && defined(HAS_STRTOULL) +# define Strtoul strtoull +# endif #endif /* is there atouq() anywhere? */ -#if !defined(Strtoul) && defined(USE_64_BITS) && defined(HAS_STRTOUQ) +#if !defined(Strtoul) && defined(HAS_STRTOUQ) # define Strtoul strtouq #endif #if !defined(Strtoul) @@ -3121,6 +3189,22 @@ typedef struct am_table_short AMTS; # endif #endif +#ifdef I_FCNTL +# include <fcntl.h> +#endif + +#ifdef I_SYS_FILE +# include <sys/file.h> +#endif + +#ifndef O_RDONLY +/* Assume UNIX defaults */ +# define O_RDONLY 0000 +# define O_WRONLY 0001 +# define O_RDWR 0002 +# define O_CREAT 0100 +#endif + #ifdef IAMSUID #ifdef I_SYS_STATVFS @@ -3171,9 +3255,24 @@ typedef struct am_table_short AMTS; /* Mention NV_PRESERVES_UV + HAS_ICONV I_ICONV + HAS_MKSTEMP + HAS_MKSTEMPS + HAS_MKDTEMP + + HAS_GETCWD + + HAS_MMAP + HAS_MPROTECT + HAS_MSYNC + HAS_MADVSISE + HAS_MUNMAP + I_SYSMMAN + Mmap_t + so that Configure picks them up. */ #endif /* Include guard */ @@ -7,7 +7,7 @@ #include "perl.h" #include "perlapi.h" -#if defined(PERL_OBJECT) +#if defined(PERL_OBJECT) || defined (MULTIPLICITY) /* accessor functions for Perl variables (provides binary compatibility) */ START_EXTERN_C @@ -16,10 +16,19 @@ START_EXTERN_C #undef PERLVARA #undef PERLVARI #undef PERLVARIC + +#if defined(PERL_OBJECT) #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } +#else /* MULTIPLICITY */ +#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \ + { return &(aTHX->v); } +#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \ + { return &(aTHX->v); } +#endif + #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v, const t) @@ -40,6 +49,23 @@ START_EXTERN_C #undef PERLVARIC #if defined(PERL_OBJECT) + +/* C-API layer for PERL_OBJECT */ + +#if defined(PERL_IMPLICIT_SYS) +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#endif +#if defined(PERL_OBJECT) +#ifndef __BORLANDC__ +#endif +#endif +#if defined(PERL_OBJECT) +#else #endif #undef Perl_amagic_call @@ -56,25 +82,11 @@ Perl_Gv_AMupdate(pTHXo_ HV* stash) return ((CPerlObj*)pPerl)->Perl_Gv_AMupdate(stash); } -#undef Perl_append_elem -OP* -Perl_append_elem(pTHXo_ I32 optype, OP* head, OP* tail) -{ - return ((CPerlObj*)pPerl)->Perl_append_elem(optype, head, tail); -} - -#undef Perl_append_list -OP* -Perl_append_list(pTHXo_ I32 optype, LISTOP* first, LISTOP* last) -{ - return ((CPerlObj*)pPerl)->Perl_append_list(optype, first, last); -} - -#undef Perl_apply -I32 -Perl_apply(pTHXo_ I32 type, SV** mark, SV** sp) +#undef Perl_avhv_delete_ent +SV* +Perl_avhv_delete_ent(pTHXo_ AV *ar, SV* keysv, I32 flags, U32 hash) { - return ((CPerlObj*)pPerl)->Perl_apply(type, mark, sp); + return ((CPerlObj*)pPerl)->Perl_avhv_delete_ent(ar, keysv, flags, hash); } #undef Perl_avhv_exists_ent @@ -119,6 +131,20 @@ Perl_av_clear(pTHXo_ AV* ar) ((CPerlObj*)pPerl)->Perl_av_clear(ar); } +#undef Perl_av_delete +SV* +Perl_av_delete(pTHXo_ AV* ar, I32 key, I32 flags) +{ + return ((CPerlObj*)pPerl)->Perl_av_delete(ar, key, flags); +} + +#undef Perl_av_exists +bool +Perl_av_exists(pTHXo_ AV* ar, I32 key) +{ + return ((CPerlObj*)pPerl)->Perl_av_exists(ar, key); +} + #undef Perl_av_extend void Perl_av_extend(pTHXo_ AV* ar, I32 key) @@ -210,20 +236,6 @@ Perl_av_unshift(pTHXo_ AV* ar, I32 num) ((CPerlObj*)pPerl)->Perl_av_unshift(ar, num); } -#undef Perl_bind_match -OP* -Perl_bind_match(pTHXo_ I32 type, OP* left, OP* pat) -{ - return ((CPerlObj*)pPerl)->Perl_bind_match(type, left, pat); -} - -#undef Perl_block_end -OP* -Perl_block_end(pTHXo_ I32 floor, OP* seq) -{ - return ((CPerlObj*)pPerl)->Perl_block_end(floor, seq); -} - #undef Perl_block_gimme I32 Perl_block_gimme(pTHXo) @@ -231,20 +243,6 @@ Perl_block_gimme(pTHXo) return ((CPerlObj*)pPerl)->Perl_block_gimme(); } -#undef Perl_block_start -int -Perl_block_start(pTHXo_ int full) -{ - return ((CPerlObj*)pPerl)->Perl_block_start(full); -} - -#undef Perl_boot_core_UNIVERSAL -void -Perl_boot_core_UNIVERSAL(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_boot_core_UNIVERSAL(); -} - #undef Perl_call_list void Perl_call_list(pTHXo_ I32 oldscope, AV* av_list) @@ -252,13 +250,6 @@ Perl_call_list(pTHXo_ I32 oldscope, AV* av_list) ((CPerlObj*)pPerl)->Perl_call_list(oldscope, av_list); } -#undef Perl_cando -bool -Perl_cando(pTHXo_ Mode_t mode, Uid_t effective, Stat_t* statbufp) -{ - return ((CPerlObj*)pPerl)->Perl_cando(mode, effective, statbufp); -} - #undef Perl_cast_ulong U32 Perl_cast_ulong(pTHXo_ NV f) @@ -305,13 +296,6 @@ Perl_condpair_magic(pTHXo_ SV *sv) } #endif -#undef Perl_convert -OP* -Perl_convert(pTHXo_ I32 optype, I32 flags, OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_convert(optype, flags, o); -} - #undef Perl_croak void Perl_croak(pTHXo_ const char* pat, ...) @@ -477,41 +461,6 @@ Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...) #undef Perl_fprintf_nocontext #endif -#undef Perl_cv_ckproto -void -Perl_cv_ckproto(pTHXo_ CV* cv, GV* gv, char* p) -{ - ((CPerlObj*)pPerl)->Perl_cv_ckproto(cv, gv, p); -} - -#undef Perl_cv_clone -CV* -Perl_cv_clone(pTHXo_ CV* proto) -{ - return ((CPerlObj*)pPerl)->Perl_cv_clone(proto); -} - -#undef Perl_cv_const_sv -SV* -Perl_cv_const_sv(pTHXo_ CV* cv) -{ - return ((CPerlObj*)pPerl)->Perl_cv_const_sv(cv); -} - -#undef Perl_op_const_sv -SV* -Perl_op_const_sv(pTHXo_ OP* o, CV* cv) -{ - return ((CPerlObj*)pPerl)->Perl_op_const_sv(o, cv); -} - -#undef Perl_cv_undef -void -Perl_cv_undef(pTHXo_ CV* cv) -{ - ((CPerlObj*)pPerl)->Perl_cv_undef(cv); -} - #undef Perl_cx_dump void Perl_cx_dump(pTHXo_ PERL_CONTEXT* cs) @@ -554,20 +503,6 @@ Perl_get_op_names(pTHXo) return ((CPerlObj*)pPerl)->Perl_get_op_names(); } -#undef Perl_get_no_modify -char* -Perl_get_no_modify(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_get_no_modify(); -} - -#undef Perl_get_opargs -U32* -Perl_get_opargs(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_get_opargs(); -} - #undef Perl_get_ppaddr PPADDR_t* Perl_get_ppaddr(pTHXo) @@ -575,13 +510,6 @@ Perl_get_ppaddr(pTHXo) return ((CPerlObj*)pPerl)->Perl_get_ppaddr(); } -#undef Perl_cxinc -I32 -Perl_cxinc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_cxinc(); -} - #undef Perl_deb void Perl_deb(pTHXo_ const char* pat, ...) @@ -599,13 +527,6 @@ Perl_vdeb(pTHXo_ const char* pat, va_list* args) ((CPerlObj*)pPerl)->Perl_vdeb(pat, args); } -#undef Perl_deb_growlevel -void -Perl_deb_growlevel(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_deb_growlevel(); -} - #undef Perl_debprofdump void Perl_debprofdump(pTHXo) @@ -641,13 +562,6 @@ Perl_delimcpy(pTHXo_ char* to, char* toend, char* from, char* fromend, int delim return ((CPerlObj*)pPerl)->Perl_delimcpy(to, toend, from, fromend, delim, retlen); } -#undef Perl_deprecate -void -Perl_deprecate(pTHXo_ char* s) -{ - ((CPerlObj*)pPerl)->Perl_deprecate(s); -} - #undef Perl_die OP* Perl_die(pTHXo_ const char* pat, ...) @@ -661,20 +575,6 @@ Perl_die(pTHXo_ const char* pat, ...) } -#undef Perl_vdie -OP* -Perl_vdie(pTHXo_ const char* pat, va_list* args) -{ - return ((CPerlObj*)pPerl)->Perl_vdie(pat, args); -} - -#undef Perl_die_where -OP* -Perl_die_where(pTHXo_ char* message, STRLEN msglen) -{ - return ((CPerlObj*)pPerl)->Perl_die_where(message, msglen); -} - #undef Perl_dounwind void Perl_dounwind(pTHXo_ I32 cxix) @@ -682,129 +582,17 @@ Perl_dounwind(pTHXo_ I32 cxix) ((CPerlObj*)pPerl)->Perl_dounwind(cxix); } -#undef Perl_do_aexec -bool -Perl_do_aexec(pTHXo_ SV* really, SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_aexec(really, mark, sp); -} - -#undef Perl_do_aexec5 -bool -Perl_do_aexec5(pTHXo_ SV* really, SV** mark, SV** sp, int fd, int flag) -{ - return ((CPerlObj*)pPerl)->Perl_do_aexec5(really, mark, sp, fd, flag); -} - #undef Perl_do_binmode int Perl_do_binmode(pTHXo_ PerlIO *fp, int iotype, int flag) { return ((CPerlObj*)pPerl)->Perl_do_binmode(fp, iotype, flag); } - -#undef Perl_do_chop -void -Perl_do_chop(pTHXo_ SV* asv, SV* sv) -{ - ((CPerlObj*)pPerl)->Perl_do_chop(asv, sv); -} - -#undef Perl_do_close -bool -Perl_do_close(pTHXo_ GV* gv, bool not_implicit) -{ - return ((CPerlObj*)pPerl)->Perl_do_close(gv, not_implicit); -} - -#undef Perl_do_eof -bool -Perl_do_eof(pTHXo_ GV* gv) -{ - return ((CPerlObj*)pPerl)->Perl_do_eof(gv); -} - -#undef Perl_do_exec -bool -Perl_do_exec(pTHXo_ char* cmd) -{ - return ((CPerlObj*)pPerl)->Perl_do_exec(cmd); -} #if !defined(WIN32) - -#undef Perl_do_exec3 -bool -Perl_do_exec3(pTHXo_ char* cmd, int fd, int flag) -{ - return ((CPerlObj*)pPerl)->Perl_do_exec3(cmd, fd, flag); -} #endif - -#undef Perl_do_execfree -void -Perl_do_execfree(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_do_execfree(); -} #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - -#undef Perl_do_ipcctl -I32 -Perl_do_ipcctl(pTHXo_ I32 optype, SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_ipcctl(optype, mark, sp); -} - -#undef Perl_do_ipcget -I32 -Perl_do_ipcget(pTHXo_ I32 optype, SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_ipcget(optype, mark, sp); -} - -#undef Perl_do_msgrcv -I32 -Perl_do_msgrcv(pTHXo_ SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_msgrcv(mark, sp); -} - -#undef Perl_do_msgsnd -I32 -Perl_do_msgsnd(pTHXo_ SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_msgsnd(mark, sp); -} - -#undef Perl_do_semop -I32 -Perl_do_semop(pTHXo_ SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_semop(mark, sp); -} - -#undef Perl_do_shmio -I32 -Perl_do_shmio(pTHXo_ I32 optype, SV** mark, SV** sp) -{ - return ((CPerlObj*)pPerl)->Perl_do_shmio(optype, mark, sp); -} #endif -#undef Perl_do_join -void -Perl_do_join(pTHXo_ SV* sv, SV* del, SV** mark, SV** sp) -{ - ((CPerlObj*)pPerl)->Perl_do_join(sv, del, mark, sp); -} - -#undef Perl_do_kv -OP* -Perl_do_kv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_do_kv(); -} - #undef Perl_do_open bool Perl_do_open(pTHXo_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp) @@ -819,97 +607,6 @@ Perl_do_open9(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int r return ((CPerlObj*)pPerl)->Perl_do_open9(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svs, num); } -#undef Perl_do_pipe -void -Perl_do_pipe(pTHXo_ SV* sv, GV* rgv, GV* wgv) -{ - ((CPerlObj*)pPerl)->Perl_do_pipe(sv, rgv, wgv); -} - -#undef Perl_do_print -bool -Perl_do_print(pTHXo_ SV* sv, PerlIO* fp) -{ - return ((CPerlObj*)pPerl)->Perl_do_print(sv, fp); -} - -#undef Perl_do_readline -OP* -Perl_do_readline(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_do_readline(); -} - -#undef Perl_do_chomp -I32 -Perl_do_chomp(pTHXo_ SV* sv) -{ - return ((CPerlObj*)pPerl)->Perl_do_chomp(sv); -} - -#undef Perl_do_seek -bool -Perl_do_seek(pTHXo_ GV* gv, Off_t pos, int whence) -{ - return ((CPerlObj*)pPerl)->Perl_do_seek(gv, pos, whence); -} - -#undef Perl_do_sprintf -void -Perl_do_sprintf(pTHXo_ SV* sv, I32 len, SV** sarg) -{ - ((CPerlObj*)pPerl)->Perl_do_sprintf(sv, len, sarg); -} - -#undef Perl_do_sysseek -Off_t -Perl_do_sysseek(pTHXo_ GV* gv, Off_t pos, int whence) -{ - return ((CPerlObj*)pPerl)->Perl_do_sysseek(gv, pos, whence); -} - -#undef Perl_do_tell -Off_t -Perl_do_tell(pTHXo_ GV* gv) -{ - return ((CPerlObj*)pPerl)->Perl_do_tell(gv); -} - -#undef Perl_do_trans -I32 -Perl_do_trans(pTHXo_ SV* sv) -{ - return ((CPerlObj*)pPerl)->Perl_do_trans(sv); -} - -#undef Perl_do_vecget -UV -Perl_do_vecget(pTHXo_ SV* sv, I32 offset, I32 size) -{ - return ((CPerlObj*)pPerl)->Perl_do_vecget(sv, offset, size); -} - -#undef Perl_do_vecset -void -Perl_do_vecset(pTHXo_ SV* sv) -{ - ((CPerlObj*)pPerl)->Perl_do_vecset(sv); -} - -#undef Perl_do_vop -void -Perl_do_vop(pTHXo_ I32 optype, SV* sv, SV* left, SV* right) -{ - ((CPerlObj*)pPerl)->Perl_do_vop(optype, sv, left, right); -} - -#undef Perl_dofile -OP* -Perl_dofile(pTHXo_ OP* term) -{ - return ((CPerlObj*)pPerl)->Perl_dofile(term); -} - #undef Perl_dowantarray I32 Perl_dowantarray(pTHXo) @@ -995,37 +692,9 @@ Perl_fbm_instr(pTHXo_ unsigned char* big, unsigned char* bigend, SV* littlesv, U { return ((CPerlObj*)pPerl)->Perl_fbm_instr(big, bigend, littlesv, flags); } - -#undef Perl_find_script -char* -Perl_find_script(pTHXo_ char *scriptname, bool dosearch, char **search_ext, I32 flags) -{ - return ((CPerlObj*)pPerl)->Perl_find_script(scriptname, dosearch, search_ext, flags); -} #if defined(USE_THREADS) - -#undef Perl_find_threadsv -PADOFFSET -Perl_find_threadsv(pTHXo_ const char *name) -{ - return ((CPerlObj*)pPerl)->Perl_find_threadsv(name); -} #endif -#undef Perl_force_list -OP* -Perl_force_list(pTHXo_ OP* arg) -{ - return ((CPerlObj*)pPerl)->Perl_force_list(arg); -} - -#undef Perl_fold_constants -OP* -Perl_fold_constants(pTHXo_ OP* arg) -{ - return ((CPerlObj*)pPerl)->Perl_fold_constants(arg); -} - #undef Perl_form char* Perl_form(pTHXo_ const char* pat, ...) @@ -1052,21 +721,7 @@ Perl_free_tmps(pTHXo) { ((CPerlObj*)pPerl)->Perl_free_tmps(); } - -#undef Perl_gen_constant_list -OP* -Perl_gen_constant_list(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_gen_constant_list(o); -} #if !defined(HAS_GETENV_LEN) - -#undef Perl_getenv_len -char* -Perl_getenv_len(pTHXo_ char* key, unsigned long *len) -{ - return ((CPerlObj*)pPerl)->Perl_getenv_len(key, len); -} #endif #undef Perl_gp_free @@ -1363,20 +1018,6 @@ Perl_ibcmp_locale(pTHXo_ const char* a, const char* b, I32 len) return ((CPerlObj*)pPerl)->Perl_ibcmp_locale(a, b, len); } -#undef Perl_ingroup -bool -Perl_ingroup(pTHXo_ Gid_t testgid, Uid_t effective) -{ - return ((CPerlObj*)pPerl)->Perl_ingroup(testgid, effective); -} - -#undef Perl_init_debugger -void -Perl_init_debugger(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_init_debugger(); -} - #undef Perl_init_stacks void Perl_init_stacks(pTHXo) @@ -1384,13 +1025,6 @@ Perl_init_stacks(pTHXo) ((CPerlObj*)pPerl)->Perl_init_stacks(); } -#undef Perl_intro_my -U32 -Perl_intro_my(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_intro_my(); -} - #undef Perl_instr char* Perl_instr(pTHXo_ const char* big, const char* little) @@ -1398,20 +1032,6 @@ Perl_instr(pTHXo_ const char* big, const char* little) return ((CPerlObj*)pPerl)->Perl_instr(big, little); } -#undef Perl_io_close -bool -Perl_io_close(pTHXo_ IO* io, bool not_implicit) -{ - return ((CPerlObj*)pPerl)->Perl_io_close(io, not_implicit); -} - -#undef Perl_invert -OP* -Perl_invert(pTHXo_ OP* cmd) -{ - return ((CPerlObj*)pPerl)->Perl_invert(cmd); -} - #undef Perl_is_uni_alnum bool Perl_is_uni_alnum(pTHXo_ U32 c) @@ -1755,20 +1375,6 @@ Perl_is_utf8_mark(pTHXo_ U8 *p) return ((CPerlObj*)pPerl)->Perl_is_utf8_mark(p); } -#undef Perl_jmaybe -OP* -Perl_jmaybe(pTHXo_ OP* arg) -{ - return ((CPerlObj*)pPerl)->Perl_jmaybe(arg); -} - -#undef Perl_keyword -I32 -Perl_keyword(pTHXo_ char* d, I32 len) -{ - return ((CPerlObj*)pPerl)->Perl_keyword(d, len); -} - #undef Perl_leave_scope void Perl_leave_scope(pTHXo_ I32 base) @@ -1776,396 +1382,15 @@ Perl_leave_scope(pTHXo_ I32 base) ((CPerlObj*)pPerl)->Perl_leave_scope(base); } -#undef Perl_lex_end -void -Perl_lex_end(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_lex_end(); -} - -#undef Perl_lex_start -void -Perl_lex_start(pTHXo_ SV* line) -{ - ((CPerlObj*)pPerl)->Perl_lex_start(line); -} - -#undef Perl_linklist -OP* -Perl_linklist(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_linklist(o); -} - -#undef Perl_list -OP* -Perl_list(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_list(o); -} - -#undef Perl_listkids -OP* -Perl_listkids(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_listkids(o); -} - -#undef Perl_localize -OP* -Perl_localize(pTHXo_ OP* arg, I32 lexical) -{ - return ((CPerlObj*)pPerl)->Perl_localize(arg, lexical); -} - #undef Perl_looks_like_number I32 Perl_looks_like_number(pTHXo_ SV* sv) { return ((CPerlObj*)pPerl)->Perl_looks_like_number(sv); } - -#undef Perl_magic_clearenv -int -Perl_magic_clearenv(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_clearenv(sv, mg); -} - -#undef Perl_magic_clear_all_env -int -Perl_magic_clear_all_env(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_clear_all_env(sv, mg); -} - -#undef Perl_magic_clearpack -int -Perl_magic_clearpack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_clearpack(sv, mg); -} - -#undef Perl_magic_clearsig -int -Perl_magic_clearsig(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_clearsig(sv, mg); -} - -#undef Perl_magic_existspack -int -Perl_magic_existspack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_existspack(sv, mg); -} - -#undef Perl_magic_freeregexp -int -Perl_magic_freeregexp(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_freeregexp(sv, mg); -} - -#undef Perl_magic_get -int -Perl_magic_get(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_get(sv, mg); -} - -#undef Perl_magic_getarylen -int -Perl_magic_getarylen(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getarylen(sv, mg); -} - -#undef Perl_magic_getdefelem -int -Perl_magic_getdefelem(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getdefelem(sv, mg); -} - -#undef Perl_magic_getglob -int -Perl_magic_getglob(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getglob(sv, mg); -} - -#undef Perl_magic_getnkeys -int -Perl_magic_getnkeys(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getnkeys(sv, mg); -} - -#undef Perl_magic_getpack -int -Perl_magic_getpack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getpack(sv, mg); -} - -#undef Perl_magic_getpos -int -Perl_magic_getpos(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getpos(sv, mg); -} - -#undef Perl_magic_getsig -int -Perl_magic_getsig(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getsig(sv, mg); -} - -#undef Perl_magic_getsubstr -int -Perl_magic_getsubstr(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getsubstr(sv, mg); -} - -#undef Perl_magic_gettaint -int -Perl_magic_gettaint(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_gettaint(sv, mg); -} - -#undef Perl_magic_getuvar -int -Perl_magic_getuvar(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getuvar(sv, mg); -} - -#undef Perl_magic_getvec -int -Perl_magic_getvec(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_getvec(sv, mg); -} - -#undef Perl_magic_len -U32 -Perl_magic_len(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_len(sv, mg); -} #if defined(USE_THREADS) - -#undef Perl_magic_mutexfree -int -Perl_magic_mutexfree(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_mutexfree(sv, mg); -} #endif - -#undef Perl_magic_nextpack -int -Perl_magic_nextpack(pTHXo_ SV* sv, MAGIC* mg, SV* key) -{ - return ((CPerlObj*)pPerl)->Perl_magic_nextpack(sv, mg, key); -} - -#undef Perl_magic_regdata_cnt -U32 -Perl_magic_regdata_cnt(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_regdata_cnt(sv, mg); -} - -#undef Perl_magic_regdatum_get -int -Perl_magic_regdatum_get(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_regdatum_get(sv, mg); -} - -#undef Perl_magic_set -int -Perl_magic_set(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_set(sv, mg); -} - -#undef Perl_magic_setamagic -int -Perl_magic_setamagic(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setamagic(sv, mg); -} - -#undef Perl_magic_setarylen -int -Perl_magic_setarylen(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setarylen(sv, mg); -} - -#undef Perl_magic_setbm -int -Perl_magic_setbm(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setbm(sv, mg); -} - -#undef Perl_magic_setdbline -int -Perl_magic_setdbline(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setdbline(sv, mg); -} #if defined(USE_LOCALE_COLLATE) - -#undef Perl_magic_setcollxfrm -int -Perl_magic_setcollxfrm(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setcollxfrm(sv, mg); -} -#endif - -#undef Perl_magic_setdefelem -int -Perl_magic_setdefelem(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setdefelem(sv, mg); -} - -#undef Perl_magic_setenv -int -Perl_magic_setenv(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setenv(sv, mg); -} - -#undef Perl_magic_setfm -int -Perl_magic_setfm(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setfm(sv, mg); -} - -#undef Perl_magic_setisa -int -Perl_magic_setisa(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setisa(sv, mg); -} - -#undef Perl_magic_setglob -int -Perl_magic_setglob(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setglob(sv, mg); -} - -#undef Perl_magic_setmglob -int -Perl_magic_setmglob(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setmglob(sv, mg); -} - -#undef Perl_magic_setnkeys -int -Perl_magic_setnkeys(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setnkeys(sv, mg); -} - -#undef Perl_magic_setpack -int -Perl_magic_setpack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setpack(sv, mg); -} - -#undef Perl_magic_setpos -int -Perl_magic_setpos(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setpos(sv, mg); -} - -#undef Perl_magic_setsig -int -Perl_magic_setsig(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setsig(sv, mg); -} - -#undef Perl_magic_setsubstr -int -Perl_magic_setsubstr(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setsubstr(sv, mg); -} - -#undef Perl_magic_settaint -int -Perl_magic_settaint(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_settaint(sv, mg); -} - -#undef Perl_magic_setuvar -int -Perl_magic_setuvar(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setuvar(sv, mg); -} - -#undef Perl_magic_setvec -int -Perl_magic_setvec(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_setvec(sv, mg); -} - -#undef Perl_magic_set_all_env -int -Perl_magic_set_all_env(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_set_all_env(sv, mg); -} - -#undef Perl_magic_sizepack -U32 -Perl_magic_sizepack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_sizepack(sv, mg); -} - -#undef Perl_magic_wipepack -int -Perl_magic_wipepack(pTHXo_ SV* sv, MAGIC* mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_wipepack(sv, mg); -} - -#undef Perl_magicname -void -Perl_magicname(pTHXo_ char* sym, char* name, I32 namlen) -{ - ((CPerlObj*)pPerl)->Perl_magicname(sym, name, namlen); -} -#if defined(MYMALLOC) - -#undef Perl_malloced_size -MEM_SIZE -Perl_malloced_size(void *p) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_malloced_size(p); -} #endif #undef Perl_markstack_grow @@ -2175,13 +1400,6 @@ Perl_markstack_grow(pTHXo) ((CPerlObj*)pPerl)->Perl_markstack_grow(); } #if defined(USE_LOCALE_COLLATE) - -#undef Perl_mem_collxfrm -char* -Perl_mem_collxfrm(pTHXo_ const char* s, STRLEN len, STRLEN* xlen) -{ - return ((CPerlObj*)pPerl)->Perl_mem_collxfrm(s, len, xlen); -} #endif #undef Perl_mess @@ -2204,13 +1422,6 @@ Perl_vmess(pTHXo_ const char* pat, va_list* args) return ((CPerlObj*)pPerl)->Perl_vmess(pat, args); } -#undef Perl_qerror -void -Perl_qerror(pTHXo_ SV* err) -{ - ((CPerlObj*)pPerl)->Perl_qerror(err); -} - #undef Perl_mg_clear int Perl_mg_clear(pTHXo_ SV* sv) @@ -2274,13 +1485,6 @@ Perl_mg_size(pTHXo_ SV* sv) return ((CPerlObj*)pPerl)->Perl_mg_size(sv); } -#undef Perl_mod -OP* -Perl_mod(pTHXo_ OP* o, I32 type) -{ - return ((CPerlObj*)pPerl)->Perl_mod(o, type); -} - #undef Perl_moreswitches char* Perl_moreswitches(pTHXo_ char* s) @@ -2288,13 +1492,6 @@ Perl_moreswitches(pTHXo_ char* s) return ((CPerlObj*)pPerl)->Perl_moreswitches(s); } -#undef Perl_my -OP* -Perl_my(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_my(o); -} - #undef Perl_my_atof NV Perl_my_atof(pTHXo_ const char *s) @@ -2305,8 +1502,9 @@ Perl_my_atof(pTHXo_ const char *s) #undef Perl_my_bcopy char* -Perl_my_bcopy(pTHXo_ const char* from, char* to, I32 len) +Perl_my_bcopy(const char* from, char* to, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_bcopy(from, to, len); } #endif @@ -2314,8 +1512,9 @@ Perl_my_bcopy(pTHXo_ const char* from, char* to, I32 len) #undef Perl_my_bzero char* -Perl_my_bzero(pTHXo_ char* loc, I32 len) +Perl_my_bzero(char* loc, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_bzero(loc, len); } #endif @@ -2351,8 +1550,9 @@ Perl_my_lstat(pTHXo) #undef Perl_my_memcmp I32 -Perl_my_memcmp(pTHXo_ const char* s1, const char* s2, I32 len) +Perl_my_memcmp(const char* s1, const char* s2, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_memcmp(s1, s2, len); } #endif @@ -2360,8 +1560,9 @@ Perl_my_memcmp(pTHXo_ const char* s1, const char* s2, I32 len) #undef Perl_my_memset void* -Perl_my_memset(pTHXo_ char* loc, I32 ch, I32 len) +Perl_my_memset(char* loc, I32 ch, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_memset(loc, ch, len); } #endif @@ -2419,13 +1620,6 @@ Perl_my_ntohl(pTHXo_ long l) } #endif -#undef Perl_my_unexec -void -Perl_my_unexec(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_my_unexec(); -} - #undef Perl_newANONLIST OP* Perl_newANONLIST(pTHXo_ OP* o) @@ -2643,6 +1837,13 @@ Perl_newLISTOP(pTHXo_ I32 type, I32 flags, OP* first, OP* last) return ((CPerlObj*)pPerl)->Perl_newLISTOP(type, flags, first, last); } +#undef Perl_newPADOP +OP* +Perl_newPADOP(pTHXo_ I32 type, I32 flags, SV* sv) +{ + return ((CPerlObj*)pPerl)->Perl_newPADOP(type, flags, sv); +} + #undef Perl_newPMOP OP* Perl_newPMOP(pTHXo_ I32 type, I32 flags) @@ -2775,13 +1976,6 @@ Perl_new_stackinfo(pTHXo_ I32 stitems, I32 cxitems) return ((CPerlObj*)pPerl)->Perl_new_stackinfo(stitems, cxitems); } -#undef Perl_nextargv -PerlIO* -Perl_nextargv(pTHXo_ GV* gv) -{ - return ((CPerlObj*)pPerl)->Perl_nextargv(gv); -} - #undef Perl_ninstr char* Perl_ninstr(pTHXo_ const char* big, const char* bigend, const char* little, const char* lend) @@ -2789,13 +1983,6 @@ Perl_ninstr(pTHXo_ const char* big, const char* bigend, const char* little, cons return ((CPerlObj*)pPerl)->Perl_ninstr(big, bigend, little, lend); } -#undef Perl_oopsCV -OP* -Perl_oopsCV(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_oopsCV(o); -} - #undef Perl_op_free void Perl_op_free(pTHXo_ OP* arg) @@ -2803,99 +1990,49 @@ Perl_op_free(pTHXo_ OP* arg) ((CPerlObj*)pPerl)->Perl_op_free(arg); } -#undef Perl_package -void -Perl_package(pTHXo_ OP* o) -{ - ((CPerlObj*)pPerl)->Perl_package(o); -} - -#undef Perl_pad_alloc -PADOFFSET -Perl_pad_alloc(pTHXo_ I32 optype, U32 tmptype) -{ - return ((CPerlObj*)pPerl)->Perl_pad_alloc(optype, tmptype); -} - -#undef Perl_pad_allocmy -PADOFFSET -Perl_pad_allocmy(pTHXo_ char* name) -{ - return ((CPerlObj*)pPerl)->Perl_pad_allocmy(name); -} - -#undef Perl_pad_findmy -PADOFFSET -Perl_pad_findmy(pTHXo_ char* name) -{ - return ((CPerlObj*)pPerl)->Perl_pad_findmy(name); -} - -#undef Perl_oopsAV -OP* -Perl_oopsAV(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_oopsAV(o); -} - -#undef Perl_oopsHV -OP* -Perl_oopsHV(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_oopsHV(o); -} - -#undef Perl_pad_leavemy -void -Perl_pad_leavemy(pTHXo_ I32 fill) -{ - ((CPerlObj*)pPerl)->Perl_pad_leavemy(fill); -} - #undef Perl_pad_sv SV* Perl_pad_sv(pTHXo_ PADOFFSET po) { return ((CPerlObj*)pPerl)->Perl_pad_sv(po); } +#if defined(PERL_OBJECT) -#undef Perl_pad_free +#undef Perl_construct void -Perl_pad_free(pTHXo_ PADOFFSET po) +Perl_construct(pTHXo) { - ((CPerlObj*)pPerl)->Perl_pad_free(po); + ((CPerlObj*)pPerl)->Perl_construct(); } -#undef Perl_pad_reset +#undef Perl_destruct void -Perl_pad_reset(pTHXo) +Perl_destruct(pTHXo) { - ((CPerlObj*)pPerl)->Perl_pad_reset(); + ((CPerlObj*)pPerl)->Perl_destruct(); } -#undef Perl_pad_swipe +#undef Perl_free void -Perl_pad_swipe(pTHXo_ PADOFFSET po) +Perl_free(pTHXo) { - ((CPerlObj*)pPerl)->Perl_pad_swipe(po); + ((CPerlObj*)pPerl)->Perl_free(); } -#undef Perl_peep -void -Perl_peep(pTHXo_ OP* o) +#undef Perl_run +int +Perl_run(pTHXo) { - ((CPerlObj*)pPerl)->Perl_peep(o); + return ((CPerlObj*)pPerl)->Perl_run(); } -#if defined(PERL_OBJECT) -#else -#undef perl_alloc -PerlInterpreter* -perl_alloc() +#undef Perl_parse +int +Perl_parse(pTHXo_ XSINIT_t xsinit, int argc, char** argv, char** env) { - dTHXo; - return ((CPerlObj*)pPerl)->perl_alloc(); + return ((CPerlObj*)pPerl)->Perl_parse(xsinit, argc, argv, env); } +#endif #if defined(USE_THREADS) #undef Perl_new_struct_thread @@ -2905,7 +2042,6 @@ Perl_new_struct_thread(pTHXo_ struct perl_thread *t) return ((CPerlObj*)pPerl)->Perl_new_struct_thread(t); } #endif -#endif #undef Perl_call_atexit void @@ -3047,13 +2183,6 @@ Perl_require_pv(pTHXo_ const char* pv) ((CPerlObj*)pPerl)->Perl_require_pv(pv); } -#undef Perl_pidgone -void -Perl_pidgone(pTHXo_ Pid_t pid, int status) -{ - ((CPerlObj*)pPerl)->Perl_pidgone(pid, status); -} - #undef Perl_pmflag void Perl_pmflag(pTHXo_ U16* pmfl, int ch) @@ -3061,27 +2190,6 @@ Perl_pmflag(pTHXo_ U16* pmfl, int ch) ((CPerlObj*)pPerl)->Perl_pmflag(pmfl, ch); } -#undef Perl_pmruntime -OP* -Perl_pmruntime(pTHXo_ OP* pm, OP* expr, OP* repl) -{ - return ((CPerlObj*)pPerl)->Perl_pmruntime(pm, expr, repl); -} - -#undef Perl_pmtrans -OP* -Perl_pmtrans(pTHXo_ OP* o, OP* expr, OP* repl) -{ - return ((CPerlObj*)pPerl)->Perl_pmtrans(o, expr, repl); -} - -#undef Perl_pop_return -OP* -Perl_pop_return(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pop_return(); -} - #undef Perl_pop_scope void Perl_pop_scope(pTHXo) @@ -3089,20 +2197,6 @@ Perl_pop_scope(pTHXo) ((CPerlObj*)pPerl)->Perl_pop_scope(); } -#undef Perl_prepend_elem -OP* -Perl_prepend_elem(pTHXo_ I32 optype, OP* head, OP* tail) -{ - return ((CPerlObj*)pPerl)->Perl_prepend_elem(optype, head, tail); -} - -#undef Perl_push_return -void -Perl_push_return(pTHXo_ OP* o) -{ - ((CPerlObj*)pPerl)->Perl_push_return(o); -} - #undef Perl_push_scope void Perl_push_scope(pTHXo) @@ -3110,20 +2204,6 @@ Perl_push_scope(pTHXo) ((CPerlObj*)pPerl)->Perl_push_scope(); } -#undef Perl_ref -OP* -Perl_ref(pTHXo_ OP* o, I32 type) -{ - return ((CPerlObj*)pPerl)->Perl_ref(o, type); -} - -#undef Perl_refkids -OP* -Perl_refkids(pTHXo_ OP* o, I32 type) -{ - return ((CPerlObj*)pPerl)->Perl_refkids(o, type); -} - #undef Perl_regdump void Perl_regdump(pTHXo_ regexp* r) @@ -3180,13 +2260,6 @@ Perl_regnext(pTHXo_ regnode* p) return ((CPerlObj*)pPerl)->Perl_regnext(p); } -#undef Perl_regprop -void -Perl_regprop(pTHXo_ SV* sv, regnode* o) -{ - ((CPerlObj*)pPerl)->Perl_regprop(sv, o); -} - #undef Perl_repeatcpy void Perl_repeatcpy(pTHXo_ char* to, const char* from, I32 len, I32 count) @@ -3200,63 +2273,7 @@ Perl_rninstr(pTHXo_ const char* big, const char* bigend, const char* little, con { return ((CPerlObj*)pPerl)->Perl_rninstr(big, bigend, little, lend); } - -#undef Perl_rsignal -Sighandler_t -Perl_rsignal(pTHXo_ int i, Sighandler_t t) -{ - return ((CPerlObj*)pPerl)->Perl_rsignal(i, t); -} - -#undef Perl_rsignal_restore -int -Perl_rsignal_restore(pTHXo_ int i, Sigsave_t* t) -{ - return ((CPerlObj*)pPerl)->Perl_rsignal_restore(i, t); -} - -#undef Perl_rsignal_save -int -Perl_rsignal_save(pTHXo_ int i, Sighandler_t t1, Sigsave_t* t2) -{ - return ((CPerlObj*)pPerl)->Perl_rsignal_save(i, t1, t2); -} - -#undef Perl_rsignal_state -Sighandler_t -Perl_rsignal_state(pTHXo_ int i) -{ - return ((CPerlObj*)pPerl)->Perl_rsignal_state(i); -} - -#undef Perl_rxres_free -void -Perl_rxres_free(pTHXo_ void** rsp) -{ - ((CPerlObj*)pPerl)->Perl_rxres_free(rsp); -} - -#undef Perl_rxres_restore -void -Perl_rxres_restore(pTHXo_ void** rsp, REGEXP* prx) -{ - ((CPerlObj*)pPerl)->Perl_rxres_restore(rsp, prx); -} - -#undef Perl_rxres_save -void -Perl_rxres_save(pTHXo_ void** rsp, REGEXP* prx) -{ - ((CPerlObj*)pPerl)->Perl_rxres_save(rsp, prx); -} #if !defined(HAS_RENAME) - -#undef Perl_same_dirent -I32 -Perl_same_dirent(pTHXo_ char* a, char* b) -{ - return ((CPerlObj*)pPerl)->Perl_same_dirent(a, b); -} #endif #undef Perl_savepv @@ -3324,23 +2341,23 @@ Perl_save_delete(pTHXo_ HV* hv, char* key, I32 klen) #undef Perl_save_destructor void -Perl_save_destructor(pTHXo_ DESTRUCTORFUNC_t f, void* p) +Perl_save_destructor(pTHXo_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { ((CPerlObj*)pPerl)->Perl_save_destructor(f, p); } -#undef Perl_save_freesv +#undef Perl_save_destructor_x void -Perl_save_freesv(pTHXo_ SV* sv) +Perl_save_destructor_x(pTHXo_ DESTRUCTORFUNC_t f, void* p) { - ((CPerlObj*)pPerl)->Perl_save_freesv(sv); + ((CPerlObj*)pPerl)->Perl_save_destructor_x(f, p); } -#undef Perl_save_freeop +#undef Perl_save_freesv void -Perl_save_freeop(pTHXo_ OP* o) +Perl_save_freesv(pTHXo_ SV* sv) { - ((CPerlObj*)pPerl)->Perl_save_freeop(o); + ((CPerlObj*)pPerl)->Perl_save_freesv(sv); } #undef Perl_save_freepv @@ -3406,6 +2423,13 @@ Perl_save_I32(pTHXo_ I32* intp) ((CPerlObj*)pPerl)->Perl_save_I32(intp); } +#undef Perl_save_I8 +void +Perl_save_I8(pTHXo_ I8* bytep) +{ + ((CPerlObj*)pPerl)->Perl_save_I8(bytep); +} + #undef Perl_save_int void Perl_save_int(pTHXo_ int* intp) @@ -3448,13 +2472,6 @@ Perl_save_nogv(pTHXo_ GV* gv) ((CPerlObj*)pPerl)->Perl_save_nogv(gv); } -#undef Perl_save_op -void -Perl_save_op(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_save_op(); -} - #undef Perl_save_scalar SV* Perl_save_scalar(pTHXo_ GV* gv) @@ -3469,6 +2486,13 @@ Perl_save_pptr(pTHXo_ char** pptr) ((CPerlObj*)pPerl)->Perl_save_pptr(pptr); } +#undef Perl_save_vptr +void +Perl_save_vptr(pTHXo_ void* pptr) +{ + ((CPerlObj*)pPerl)->Perl_save_vptr(pptr); +} + #undef Perl_save_re_context void Perl_save_re_context(pTHXo) @@ -3497,41 +2521,6 @@ Perl_save_threadsv(pTHXo_ PADOFFSET i) return ((CPerlObj*)pPerl)->Perl_save_threadsv(i); } -#undef Perl_sawparens -OP* -Perl_sawparens(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_sawparens(o); -} - -#undef Perl_scalar -OP* -Perl_scalar(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_scalar(o); -} - -#undef Perl_scalarkids -OP* -Perl_scalarkids(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_scalarkids(o); -} - -#undef Perl_scalarseq -OP* -Perl_scalarseq(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_scalarseq(o); -} - -#undef Perl_scalarvoid -OP* -Perl_scalarvoid(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_scalarvoid(o); -} - #undef Perl_scan_bin NV Perl_scan_bin(pTHXo_ char* start, I32 len, I32* retlen) @@ -3560,13 +2549,6 @@ Perl_scan_oct(pTHXo_ char* start, I32 len, I32* retlen) return ((CPerlObj*)pPerl)->Perl_scan_oct(start, len, retlen); } -#undef Perl_scope -OP* -Perl_scope(pTHXo_ OP* o) -{ - return ((CPerlObj*)pPerl)->Perl_scope(o); -} - #undef Perl_screaminstr char* Perl_screaminstr(pTHXo_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last) @@ -3574,22 +2556,8 @@ Perl_screaminstr(pTHXo_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, return ((CPerlObj*)pPerl)->Perl_screaminstr(bigsv, littlesv, start_shift, end_shift, state, last); } #if !defined(VMS) - -#undef Perl_setenv_getix -I32 -Perl_setenv_getix(pTHXo_ char* nam) -{ - return ((CPerlObj*)pPerl)->Perl_setenv_getix(nam); -} #endif -#undef Perl_setdefout -void -Perl_setdefout(pTHXo_ GV* gv) -{ - ((CPerlObj*)pPerl)->Perl_setdefout(gv); -} - #undef Perl_sharepvn char* Perl_sharepvn(pTHXo_ const char* sv, I32 len, U32 hash) @@ -3597,21 +2565,6 @@ Perl_sharepvn(pTHXo_ const char* sv, I32 len, U32 hash) return ((CPerlObj*)pPerl)->Perl_sharepvn(sv, len, hash); } -#undef Perl_share_hek -HEK* -Perl_share_hek(pTHXo_ const char* sv, I32 len, U32 hash) -{ - return ((CPerlObj*)pPerl)->Perl_share_hek(sv, len, hash); -} - -#undef Perl_sighandler -Signal_t -Perl_sighandler(int sig) -{ - dTHXo; - ((CPerlObj*)pPerl)->Perl_sighandler(sig); -} - #undef Perl_stack_grow SV** Perl_stack_grow(pTHXo_ SV** sp, SV**p, int n) @@ -3626,13 +2579,6 @@ Perl_start_subparse(pTHXo_ I32 is_format, U32 flags) return ((CPerlObj*)pPerl)->Perl_start_subparse(is_format, flags); } -#undef Perl_sub_crush_depth -void -Perl_sub_crush_depth(pTHXo_ CV* cv) -{ - ((CPerlObj*)pPerl)->Perl_sub_crush_depth(cv); -} - #undef Perl_sv_2bool bool Perl_sv_2bool(pTHXo_ SV* sv) @@ -3682,6 +2628,20 @@ Perl_sv_2pv(pTHXo_ SV* sv, STRLEN* lp) return ((CPerlObj*)pPerl)->Perl_sv_2pv(sv, lp); } +#undef Perl_sv_2pvutf8 +char* +Perl_sv_2pvutf8(pTHXo_ SV* sv, STRLEN* lp) +{ + return ((CPerlObj*)pPerl)->Perl_sv_2pvutf8(sv, lp); +} + +#undef Perl_sv_2pvbyte +char* +Perl_sv_2pvbyte(pTHXo_ SV* sv, STRLEN* lp) +{ + return ((CPerlObj*)pPerl)->Perl_sv_2pvbyte(sv, lp); +} + #undef Perl_sv_2uv UV Perl_sv_2uv(pTHXo_ SV* sv) @@ -3717,6 +2677,20 @@ Perl_sv_pvn(pTHXo_ SV *sv, STRLEN *len) return ((CPerlObj*)pPerl)->Perl_sv_pvn(sv, len); } +#undef Perl_sv_pvutf8n +char* +Perl_sv_pvutf8n(pTHXo_ SV *sv, STRLEN *len) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvutf8n(sv, len); +} + +#undef Perl_sv_pvbyten +char* +Perl_sv_pvbyten(pTHXo_ SV *sv, STRLEN *len) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvbyten(sv, len); +} + #undef Perl_sv_true I32 Perl_sv_true(pTHXo_ SV *sv) @@ -3724,13 +2698,6 @@ Perl_sv_true(pTHXo_ SV *sv) return ((CPerlObj*)pPerl)->Perl_sv_true(sv); } -#undef Perl_sv_add_arena -void -Perl_sv_add_arena(pTHXo_ char* ptr, U32 size, U32 flags) -{ - ((CPerlObj*)pPerl)->Perl_sv_add_arena(ptr, size, flags); -} - #undef Perl_sv_backoff int Perl_sv_backoff(pTHXo_ SV* sv) @@ -3790,20 +2757,6 @@ Perl_sv_chop(pTHXo_ SV* sv, char* ptr) ((CPerlObj*)pPerl)->Perl_sv_chop(sv, ptr); } -#undef Perl_sv_clean_all -void -Perl_sv_clean_all(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_sv_clean_all(); -} - -#undef Perl_sv_clean_objs -void -Perl_sv_clean_objs(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_sv_clean_objs(); -} - #undef Perl_sv_clear void Perl_sv_clear(pTHXo_ SV* sv) @@ -3876,13 +2829,6 @@ Perl_sv_free(pTHXo_ SV* sv) ((CPerlObj*)pPerl)->Perl_sv_free(sv); } -#undef Perl_sv_free_arenas -void -Perl_sv_free_arenas(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_sv_free_arenas(); -} - #undef Perl_sv_gets char* Perl_sv_gets(pTHXo_ SV* sv, PerlIO* fp, I32 append) @@ -3995,6 +2941,20 @@ Perl_sv_pvn_force(pTHXo_ SV* sv, STRLEN* lp) return ((CPerlObj*)pPerl)->Perl_sv_pvn_force(sv, lp); } +#undef Perl_sv_pvutf8n_force +char* +Perl_sv_pvutf8n_force(pTHXo_ SV* sv, STRLEN* lp) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvutf8n_force(sv, lp); +} + +#undef Perl_sv_pvbyten_force +char* +Perl_sv_pvbyten_force(pTHXo_ SV* sv, STRLEN* lp) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvbyten_force(sv, lp); +} + #undef Perl_sv_reftype char* Perl_sv_reftype(pTHXo_ SV* sv, int ob) @@ -4180,6 +3140,13 @@ Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, S ((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted); } +#undef Perl_str_to_version +NV +Perl_str_to_version(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_str_to_version(sv); +} + #undef Perl_swash_init SV* Perl_swash_init(pTHXo_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none) @@ -4203,7 +3170,7 @@ Perl_taint_env(pTHXo) #undef Perl_taint_proper void -Perl_taint_proper(pTHXo_ const char* f, char* s) +Perl_taint_proper(pTHXo_ const char* f, const char* s) { ((CPerlObj*)pPerl)->Perl_taint_proper(f, s); } @@ -4254,20 +3221,6 @@ Perl_unsharepvn(pTHXo_ const char* sv, I32 len, U32 hash) ((CPerlObj*)pPerl)->Perl_unsharepvn(sv, len, hash); } -#undef Perl_unshare_hek -void -Perl_unshare_hek(pTHXo_ HEK* hek) -{ - ((CPerlObj*)pPerl)->Perl_unshare_hek(hek); -} - -#undef Perl_utilize -void -Perl_utilize(pTHXo_ int aver, I32 floor, OP* version, OP* id, OP* arg) -{ - ((CPerlObj*)pPerl)->Perl_utilize(aver, floor, version, id, arg); -} - #undef Perl_utf16_to_utf8 U8* Perl_utf16_to_utf8(pTHXo_ U16* p, U8 *d, I32 bytelen) @@ -4310,27 +3263,6 @@ Perl_uv_to_utf8(pTHXo_ U8 *d, UV uv) return ((CPerlObj*)pPerl)->Perl_uv_to_utf8(d, uv); } -#undef Perl_vivify_defelem -void -Perl_vivify_defelem(pTHXo_ SV* sv) -{ - ((CPerlObj*)pPerl)->Perl_vivify_defelem(sv); -} - -#undef Perl_vivify_ref -void -Perl_vivify_ref(pTHXo_ SV* sv, U32 to_what) -{ - ((CPerlObj*)pPerl)->Perl_vivify_ref(sv, to_what); -} - -#undef Perl_wait4pid -I32 -Perl_wait4pid(pTHXo_ Pid_t pid, int* statusp, int flags) -{ - return ((CPerlObj*)pPerl)->Perl_wait4pid(pid, statusp, flags); -} - #undef Perl_warn void Perl_warn(pTHXo_ const char* pat, ...) @@ -4364,58 +3296,9 @@ Perl_vwarner(pTHXo_ U32 err, const char* pat, va_list* args) { ((CPerlObj*)pPerl)->Perl_vwarner(err, pat, args); } - -#undef Perl_watch -void -Perl_watch(pTHXo_ char** addr) -{ - ((CPerlObj*)pPerl)->Perl_watch(addr); -} - -#undef Perl_whichsig -I32 -Perl_whichsig(pTHXo_ char* sig) -{ - return ((CPerlObj*)pPerl)->Perl_whichsig(sig); -} - -#undef Perl_yyerror -int -Perl_yyerror(pTHXo_ char* s) -{ - return ((CPerlObj*)pPerl)->Perl_yyerror(s); -} #if defined(USE_PURE_BISON) - -#undef Perl_yylex -int -Perl_yylex(pTHXo_ YYSTYPE *lvalp, int *lcharp) -{ - return ((CPerlObj*)pPerl)->Perl_yylex(lvalp, lcharp); -} #else - -#undef Perl_yylex -int -Perl_yylex(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_yylex(); -} #endif - -#undef Perl_yyparse -int -Perl_yyparse(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_yyparse(); -} - -#undef Perl_yywarn -int -Perl_yywarn(pTHXo_ char* s) -{ - return ((CPerlObj*)pPerl)->Perl_yywarn(s); -} #if defined(MYMALLOC) #undef Perl_dump_mstats @@ -4425,36 +3308,11 @@ Perl_dump_mstats(pTHXo_ char* s) ((CPerlObj*)pPerl)->Perl_dump_mstats(s); } -#undef Perl_malloc -Malloc_t -Perl_malloc(MEM_SIZE nbytes) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_malloc(nbytes); -} - -#undef Perl_calloc -Malloc_t -Perl_calloc(MEM_SIZE elements, MEM_SIZE size) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_calloc(elements, size); -} - -#undef Perl_realloc -Malloc_t -Perl_realloc(Malloc_t where, MEM_SIZE nbytes) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_realloc(where, nbytes); -} - -#undef Perl_mfree -Free_t -Perl_mfree(Malloc_t where) +#undef Perl_get_mstats +int +Perl_get_mstats(pTHXo_ perl_mstats_t *buf, int buflen, int level) { - dTHXo; - ((CPerlObj*)pPerl)->Perl_mfree(where); + return ((CPerlObj*)pPerl)->Perl_get_mstats(buf, buflen, level); } #endif @@ -4665,13 +3523,6 @@ Perl_get_vtbl(pTHXo_ int vtbl_id) return ((CPerlObj*)pPerl)->Perl_get_vtbl(vtbl_id); } -#undef Perl_pv_display -char* -Perl_pv_display(pTHXo_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) -{ - return ((CPerlObj*)pPerl)->Perl_pv_display(sv, pv, cur, len, pvlim); -} - #undef Perl_dump_indent void Perl_dump_indent(pTHXo_ I32 level, PerlIO *file, const char* pat, ...) @@ -4744,15 +3595,16 @@ Perl_magic_dump(pTHXo_ MAGIC *mg) { ((CPerlObj*)pPerl)->Perl_magic_dump(mg); } +#if defined(PERL_FLEXIBLE_EXCEPTIONS) #undef Perl_default_protect void* -Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...) +Perl_default_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, ...) { void* retval; va_list args; va_start(args, body); - retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, &args); + retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, &args); va_end(args); return retval; @@ -4760,10 +3612,11 @@ Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...) #undef Perl_vdefault_protect void* -Perl_vdefault_protect(pTHXo_ int *excpt, protect_body_t body, va_list *args) +Perl_vdefault_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args) { - return ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, args); + return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args); } +#endif #undef Perl_reginitcolors void @@ -4779,6 +3632,20 @@ Perl_sv_2pv_nolen(pTHXo_ SV* sv) return ((CPerlObj*)pPerl)->Perl_sv_2pv_nolen(sv); } +#undef Perl_sv_2pvutf8_nolen +char* +Perl_sv_2pvutf8_nolen(pTHXo_ SV* sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_2pvutf8_nolen(sv); +} + +#undef Perl_sv_2pvbyte_nolen +char* +Perl_sv_2pvbyte_nolen(pTHXo_ SV* sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_2pvbyte_nolen(sv); +} + #undef Perl_sv_pv char* Perl_sv_pv(pTHXo_ SV *sv) @@ -4786,6 +3653,48 @@ Perl_sv_pv(pTHXo_ SV *sv) return ((CPerlObj*)pPerl)->Perl_sv_pv(sv); } +#undef Perl_sv_pvutf8 +char* +Perl_sv_pvutf8(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvutf8(sv); +} + +#undef Perl_sv_pvbyte +char* +Perl_sv_pvbyte(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_pvbyte(sv); +} + +#undef Perl_sv_utf8_upgrade +void +Perl_sv_utf8_upgrade(pTHXo_ SV *sv) +{ + ((CPerlObj*)pPerl)->Perl_sv_utf8_upgrade(sv); +} + +#undef Perl_sv_utf8_downgrade +bool +Perl_sv_utf8_downgrade(pTHXo_ SV *sv, bool fail_ok) +{ + return ((CPerlObj*)pPerl)->Perl_sv_utf8_downgrade(sv, fail_ok); +} + +#undef Perl_sv_utf8_encode +void +Perl_sv_utf8_encode(pTHXo_ SV *sv) +{ + ((CPerlObj*)pPerl)->Perl_sv_utf8_encode(sv); +} + +#undef Perl_sv_utf8_decode +bool +Perl_sv_utf8_decode(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_sv_utf8_decode(sv); +} + #undef Perl_sv_force_normal void Perl_sv_force_normal(pTHXo_ SV *sv) @@ -4807,13 +3716,6 @@ Perl_sv_rvweaken(pTHXo_ SV *sv) return ((CPerlObj*)pPerl)->Perl_sv_rvweaken(sv); } -#undef Perl_magic_killbackrefs -int -Perl_magic_killbackrefs(pTHXo_ SV *sv, MAGIC *mg) -{ - return ((CPerlObj*)pPerl)->Perl_magic_killbackrefs(sv, mg); -} - #undef Perl_newANONATTRSUB OP* Perl_newANONATTRSUB(pTHXo_ I32 floor, OP *proto, OP *attrs, OP *block) @@ -4834,21 +3736,124 @@ Perl_newMYSUB(pTHXo_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) { ((CPerlObj*)pPerl)->Perl_newMYSUB(floor, o, proto, attrs, block); } +#if defined(USE_ITHREADS) + +#undef Perl_cx_dup +PERL_CONTEXT* +Perl_cx_dup(pTHXo_ PERL_CONTEXT* cx, I32 ix, I32 max) +{ + return ((CPerlObj*)pPerl)->Perl_cx_dup(cx, ix, max); +} + +#undef Perl_si_dup +PERL_SI* +Perl_si_dup(pTHXo_ PERL_SI* si) +{ + return ((CPerlObj*)pPerl)->Perl_si_dup(si); +} + +#undef Perl_ss_dup +ANY* +Perl_ss_dup(pTHXo_ PerlInterpreter* proto_perl) +{ + return ((CPerlObj*)pPerl)->Perl_ss_dup(proto_perl); +} + +#undef Perl_any_dup +void* +Perl_any_dup(pTHXo_ void* v, PerlInterpreter* proto_perl) +{ + return ((CPerlObj*)pPerl)->Perl_any_dup(v, proto_perl); +} + +#undef Perl_he_dup +HE* +Perl_he_dup(pTHXo_ HE* e, bool shared) +{ + return ((CPerlObj*)pPerl)->Perl_he_dup(e, shared); +} + +#undef Perl_re_dup +REGEXP* +Perl_re_dup(pTHXo_ REGEXP* r) +{ + return ((CPerlObj*)pPerl)->Perl_re_dup(r); +} + +#undef Perl_fp_dup +PerlIO* +Perl_fp_dup(pTHXo_ PerlIO* fp, char type) +{ + return ((CPerlObj*)pPerl)->Perl_fp_dup(fp, type); +} + +#undef Perl_dirp_dup +DIR* +Perl_dirp_dup(pTHXo_ DIR* dp) +{ + return ((CPerlObj*)pPerl)->Perl_dirp_dup(dp); +} + +#undef Perl_gp_dup +GP* +Perl_gp_dup(pTHXo_ GP* gp) +{ + return ((CPerlObj*)pPerl)->Perl_gp_dup(gp); +} + +#undef Perl_mg_dup +MAGIC* +Perl_mg_dup(pTHXo_ MAGIC* mg) +{ + return ((CPerlObj*)pPerl)->Perl_mg_dup(mg); +} + +#undef Perl_sv_dup +SV* +Perl_sv_dup(pTHXo_ SV* sstr) +{ + return ((CPerlObj*)pPerl)->Perl_sv_dup(sstr); +} +#if defined(HAVE_INTERP_INTERN) + +#undef Perl_sys_intern_dup +void +Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst); +} +#endif + +#undef Perl_ptr_table_new +PTR_TBL_t* +Perl_ptr_table_new(pTHXo) +{ + return ((CPerlObj*)pPerl)->Perl_ptr_table_new(); +} + +#undef Perl_ptr_table_fetch +void* +Perl_ptr_table_fetch(pTHXo_ PTR_TBL_t *tbl, void *sv) +{ + return ((CPerlObj*)pPerl)->Perl_ptr_table_fetch(tbl, sv); +} -#undef Perl_my_attrs -OP * -Perl_my_attrs(pTHXo_ OP *o, OP *attrs) +#undef Perl_ptr_table_store +void +Perl_ptr_table_store(pTHXo_ PTR_TBL_t *tbl, void *oldsv, void *newsv) { - return ((CPerlObj*)pPerl)->Perl_my_attrs(o, attrs); + ((CPerlObj*)pPerl)->Perl_ptr_table_store(tbl, oldsv, newsv); } -#undef Perl_boot_core_xsutils +#undef Perl_ptr_table_split void -Perl_boot_core_xsutils(pTHXo) +Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl) { - ((CPerlObj*)pPerl)->Perl_boot_core_xsutils(); + ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl); } +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #endif @@ -4867,12 +3872,16 @@ Perl_boot_core_xsutils(pTHXo) #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 @@ -4889,16 +3898,13 @@ Perl_boot_core_xsutils(pTHXo) #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #endif #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -# if defined(PURIFY) -# else -# endif # if defined(DEBUGGING) # endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) # if defined(CRIPPLED_CC) # endif -# if defined(WIN32) +# if defined(PERL_CR_FILTER) # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) @@ -4907,2687 +3913,8 @@ Perl_boot_core_xsutils(pTHXo) # if defined(LEAKTEST) # endif #endif - -#undef Perl_ck_anoncode -OP * -Perl_ck_anoncode(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_anoncode(o); -} - -#undef Perl_ck_bitop -OP * -Perl_ck_bitop(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_bitop(o); -} - -#undef Perl_ck_concat -OP * -Perl_ck_concat(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_concat(o); -} - -#undef Perl_ck_defined -OP * -Perl_ck_defined(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_defined(o); -} - -#undef Perl_ck_delete -OP * -Perl_ck_delete(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_delete(o); -} - -#undef Perl_ck_eof -OP * -Perl_ck_eof(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_eof(o); -} - -#undef Perl_ck_eval -OP * -Perl_ck_eval(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_eval(o); -} - -#undef Perl_ck_exec -OP * -Perl_ck_exec(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_exec(o); -} - -#undef Perl_ck_exists -OP * -Perl_ck_exists(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_exists(o); -} - -#undef Perl_ck_ftst -OP * -Perl_ck_ftst(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_ftst(o); -} - -#undef Perl_ck_fun -OP * -Perl_ck_fun(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_fun(o); -} - -#undef Perl_ck_fun_locale -OP * -Perl_ck_fun_locale(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_fun_locale(o); -} - -#undef Perl_ck_glob -OP * -Perl_ck_glob(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_glob(o); -} - -#undef Perl_ck_grep -OP * -Perl_ck_grep(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_grep(o); -} - -#undef Perl_ck_index -OP * -Perl_ck_index(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_index(o); -} - -#undef Perl_ck_join -OP * -Perl_ck_join(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_join(o); -} - -#undef Perl_ck_lengthconst -OP * -Perl_ck_lengthconst(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_lengthconst(o); -} - -#undef Perl_ck_lfun -OP * -Perl_ck_lfun(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_lfun(o); -} - -#undef Perl_ck_listiob -OP * -Perl_ck_listiob(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_listiob(o); -} - -#undef Perl_ck_match -OP * -Perl_ck_match(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_match(o); -} - -#undef Perl_ck_method -OP * -Perl_ck_method(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_method(o); -} - -#undef Perl_ck_null -OP * -Perl_ck_null(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_null(o); -} - -#undef Perl_ck_repeat -OP * -Perl_ck_repeat(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_repeat(o); -} - -#undef Perl_ck_require -OP * -Perl_ck_require(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_require(o); -} - -#undef Perl_ck_rfun -OP * -Perl_ck_rfun(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_rfun(o); -} - -#undef Perl_ck_rvconst -OP * -Perl_ck_rvconst(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_rvconst(o); -} - -#undef Perl_ck_sassign -OP * -Perl_ck_sassign(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_sassign(o); -} - -#undef Perl_ck_scmp -OP * -Perl_ck_scmp(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_scmp(o); -} - -#undef Perl_ck_select -OP * -Perl_ck_select(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_select(o); -} - -#undef Perl_ck_shift -OP * -Perl_ck_shift(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_shift(o); -} - -#undef Perl_ck_sort -OP * -Perl_ck_sort(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_sort(o); -} - -#undef Perl_ck_spair -OP * -Perl_ck_spair(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_spair(o); -} - -#undef Perl_ck_split -OP * -Perl_ck_split(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_split(o); -} - -#undef Perl_ck_subr -OP * -Perl_ck_subr(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_subr(o); -} - -#undef Perl_ck_svconst -OP * -Perl_ck_svconst(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_svconst(o); -} - -#undef Perl_ck_trunc -OP * -Perl_ck_trunc(pTHXo_ OP *o) -{ - return ((CPerlObj*)pPerl)->Perl_ck_trunc(o); -} - -#undef Perl_pp_aassign -OP * -Perl_pp_aassign(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_aassign(); -} - -#undef Perl_pp_abs -OP * -Perl_pp_abs(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_abs(); -} - -#undef Perl_pp_accept -OP * -Perl_pp_accept(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_accept(); -} - -#undef Perl_pp_add -OP * -Perl_pp_add(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_add(); -} - -#undef Perl_pp_aelem -OP * -Perl_pp_aelem(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_aelem(); -} - -#undef Perl_pp_aelemfast -OP * -Perl_pp_aelemfast(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_aelemfast(); -} - -#undef Perl_pp_alarm -OP * -Perl_pp_alarm(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_alarm(); -} - -#undef Perl_pp_and -OP * -Perl_pp_and(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_and(); -} - -#undef Perl_pp_andassign -OP * -Perl_pp_andassign(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_andassign(); -} - -#undef Perl_pp_anoncode -OP * -Perl_pp_anoncode(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_anoncode(); -} - -#undef Perl_pp_anonhash -OP * -Perl_pp_anonhash(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_anonhash(); -} - -#undef Perl_pp_anonlist -OP * -Perl_pp_anonlist(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_anonlist(); -} - -#undef Perl_pp_aslice -OP * -Perl_pp_aslice(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_aslice(); -} - -#undef Perl_pp_atan2 -OP * -Perl_pp_atan2(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_atan2(); -} - -#undef Perl_pp_av2arylen -OP * -Perl_pp_av2arylen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_av2arylen(); -} - -#undef Perl_pp_backtick -OP * -Perl_pp_backtick(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_backtick(); -} - -#undef Perl_pp_bind -OP * -Perl_pp_bind(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_bind(); -} - -#undef Perl_pp_binmode -OP * -Perl_pp_binmode(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_binmode(); -} - -#undef Perl_pp_bit_and -OP * -Perl_pp_bit_and(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_bit_and(); -} - -#undef Perl_pp_bit_or -OP * -Perl_pp_bit_or(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_bit_or(); -} - -#undef Perl_pp_bit_xor -OP * -Perl_pp_bit_xor(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_bit_xor(); -} - -#undef Perl_pp_bless -OP * -Perl_pp_bless(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_bless(); -} - -#undef Perl_pp_caller -OP * -Perl_pp_caller(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_caller(); -} - -#undef Perl_pp_chdir -OP * -Perl_pp_chdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chdir(); -} - -#undef Perl_pp_chmod -OP * -Perl_pp_chmod(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chmod(); -} - -#undef Perl_pp_chomp -OP * -Perl_pp_chomp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chomp(); -} - -#undef Perl_pp_chop -OP * -Perl_pp_chop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chop(); -} - -#undef Perl_pp_chown -OP * -Perl_pp_chown(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chown(); -} - -#undef Perl_pp_chr -OP * -Perl_pp_chr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chr(); -} - -#undef Perl_pp_chroot -OP * -Perl_pp_chroot(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_chroot(); -} - -#undef Perl_pp_close -OP * -Perl_pp_close(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_close(); -} - -#undef Perl_pp_closedir -OP * -Perl_pp_closedir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_closedir(); -} - -#undef Perl_pp_complement -OP * -Perl_pp_complement(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_complement(); -} - -#undef Perl_pp_concat -OP * -Perl_pp_concat(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_concat(); -} - -#undef Perl_pp_cond_expr -OP * -Perl_pp_cond_expr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_cond_expr(); -} - -#undef Perl_pp_connect -OP * -Perl_pp_connect(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_connect(); -} - -#undef Perl_pp_const -OP * -Perl_pp_const(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_const(); -} - -#undef Perl_pp_cos -OP * -Perl_pp_cos(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_cos(); -} - -#undef Perl_pp_crypt -OP * -Perl_pp_crypt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_crypt(); -} - -#undef Perl_pp_dbmclose -OP * -Perl_pp_dbmclose(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_dbmclose(); -} - -#undef Perl_pp_dbmopen -OP * -Perl_pp_dbmopen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_dbmopen(); -} - -#undef Perl_pp_dbstate -OP * -Perl_pp_dbstate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_dbstate(); -} - -#undef Perl_pp_defined -OP * -Perl_pp_defined(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_defined(); -} - -#undef Perl_pp_delete -OP * -Perl_pp_delete(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_delete(); -} - -#undef Perl_pp_die -OP * -Perl_pp_die(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_die(); -} - -#undef Perl_pp_divide -OP * -Perl_pp_divide(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_divide(); -} - -#undef Perl_pp_dofile -OP * -Perl_pp_dofile(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_dofile(); -} - -#undef Perl_pp_dump -OP * -Perl_pp_dump(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_dump(); -} - -#undef Perl_pp_each -OP * -Perl_pp_each(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_each(); -} - -#undef Perl_pp_egrent -OP * -Perl_pp_egrent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_egrent(); -} - -#undef Perl_pp_ehostent -OP * -Perl_pp_ehostent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ehostent(); -} - -#undef Perl_pp_enetent -OP * -Perl_pp_enetent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_enetent(); -} - -#undef Perl_pp_enter -OP * -Perl_pp_enter(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_enter(); -} - -#undef Perl_pp_entereval -OP * -Perl_pp_entereval(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_entereval(); -} - -#undef Perl_pp_enteriter -OP * -Perl_pp_enteriter(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_enteriter(); -} - -#undef Perl_pp_enterloop -OP * -Perl_pp_enterloop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_enterloop(); -} - -#undef Perl_pp_entersub -OP * -Perl_pp_entersub(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_entersub(); -} - -#undef Perl_pp_entertry -OP * -Perl_pp_entertry(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_entertry(); -} - -#undef Perl_pp_enterwrite -OP * -Perl_pp_enterwrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_enterwrite(); -} - -#undef Perl_pp_eof -OP * -Perl_pp_eof(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_eof(); -} - -#undef Perl_pp_eprotoent -OP * -Perl_pp_eprotoent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_eprotoent(); -} - -#undef Perl_pp_epwent -OP * -Perl_pp_epwent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_epwent(); -} - -#undef Perl_pp_eq -OP * -Perl_pp_eq(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_eq(); -} - -#undef Perl_pp_eservent -OP * -Perl_pp_eservent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_eservent(); -} - -#undef Perl_pp_exec -OP * -Perl_pp_exec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_exec(); -} - -#undef Perl_pp_exists -OP * -Perl_pp_exists(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_exists(); -} - -#undef Perl_pp_exit -OP * -Perl_pp_exit(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_exit(); -} - -#undef Perl_pp_exp -OP * -Perl_pp_exp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_exp(); -} - -#undef Perl_pp_fcntl -OP * -Perl_pp_fcntl(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fcntl(); -} - -#undef Perl_pp_fileno -OP * -Perl_pp_fileno(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fileno(); -} - -#undef Perl_pp_flip -OP * -Perl_pp_flip(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_flip(); -} - -#undef Perl_pp_flock -OP * -Perl_pp_flock(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_flock(); -} - -#undef Perl_pp_flop -OP * -Perl_pp_flop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_flop(); -} - -#undef Perl_pp_fork -OP * -Perl_pp_fork(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fork(); -} - -#undef Perl_pp_formline -OP * -Perl_pp_formline(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_formline(); -} - -#undef Perl_pp_ftatime -OP * -Perl_pp_ftatime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftatime(); -} - -#undef Perl_pp_ftbinary -OP * -Perl_pp_ftbinary(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftbinary(); -} - -#undef Perl_pp_ftblk -OP * -Perl_pp_ftblk(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftblk(); -} - -#undef Perl_pp_ftchr -OP * -Perl_pp_ftchr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftchr(); -} - -#undef Perl_pp_ftctime -OP * -Perl_pp_ftctime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftctime(); -} - -#undef Perl_pp_ftdir -OP * -Perl_pp_ftdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftdir(); -} - -#undef Perl_pp_fteexec -OP * -Perl_pp_fteexec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fteexec(); -} - -#undef Perl_pp_fteowned -OP * -Perl_pp_fteowned(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fteowned(); -} - -#undef Perl_pp_fteread -OP * -Perl_pp_fteread(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fteread(); -} - -#undef Perl_pp_ftewrite -OP * -Perl_pp_ftewrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftewrite(); -} - -#undef Perl_pp_ftfile -OP * -Perl_pp_ftfile(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftfile(); -} - -#undef Perl_pp_ftis -OP * -Perl_pp_ftis(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftis(); -} - -#undef Perl_pp_ftlink -OP * -Perl_pp_ftlink(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftlink(); -} - -#undef Perl_pp_ftmtime -OP * -Perl_pp_ftmtime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftmtime(); -} - -#undef Perl_pp_ftpipe -OP * -Perl_pp_ftpipe(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftpipe(); -} - -#undef Perl_pp_ftrexec -OP * -Perl_pp_ftrexec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftrexec(); -} - -#undef Perl_pp_ftrowned -OP * -Perl_pp_ftrowned(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftrowned(); -} - -#undef Perl_pp_ftrread -OP * -Perl_pp_ftrread(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftrread(); -} - -#undef Perl_pp_ftrwrite -OP * -Perl_pp_ftrwrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftrwrite(); -} - -#undef Perl_pp_ftsgid -OP * -Perl_pp_ftsgid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftsgid(); -} - -#undef Perl_pp_ftsize -OP * -Perl_pp_ftsize(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftsize(); -} - -#undef Perl_pp_ftsock -OP * -Perl_pp_ftsock(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftsock(); -} - -#undef Perl_pp_ftsuid -OP * -Perl_pp_ftsuid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftsuid(); -} - -#undef Perl_pp_ftsvtx -OP * -Perl_pp_ftsvtx(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftsvtx(); -} - -#undef Perl_pp_fttext -OP * -Perl_pp_fttext(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fttext(); -} - -#undef Perl_pp_fttty -OP * -Perl_pp_fttty(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_fttty(); -} - -#undef Perl_pp_ftzero -OP * -Perl_pp_ftzero(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ftzero(); -} - -#undef Perl_pp_ge -OP * -Perl_pp_ge(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ge(); -} - -#undef Perl_pp_gelem -OP * -Perl_pp_gelem(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gelem(); -} - -#undef Perl_pp_getc -OP * -Perl_pp_getc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getc(); -} - -#undef Perl_pp_getlogin -OP * -Perl_pp_getlogin(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getlogin(); -} - -#undef Perl_pp_getpeername -OP * -Perl_pp_getpeername(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getpeername(); -} - -#undef Perl_pp_getpgrp -OP * -Perl_pp_getpgrp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getpgrp(); -} - -#undef Perl_pp_getppid -OP * -Perl_pp_getppid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getppid(); -} - -#undef Perl_pp_getpriority -OP * -Perl_pp_getpriority(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getpriority(); -} - -#undef Perl_pp_getsockname -OP * -Perl_pp_getsockname(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_getsockname(); -} - -#undef Perl_pp_ggrent -OP * -Perl_pp_ggrent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ggrent(); -} - -#undef Perl_pp_ggrgid -OP * -Perl_pp_ggrgid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ggrgid(); -} - -#undef Perl_pp_ggrnam -OP * -Perl_pp_ggrnam(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ggrnam(); -} - -#undef Perl_pp_ghbyaddr -OP * -Perl_pp_ghbyaddr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ghbyaddr(); -} - -#undef Perl_pp_ghbyname -OP * -Perl_pp_ghbyname(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ghbyname(); -} - -#undef Perl_pp_ghostent -OP * -Perl_pp_ghostent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ghostent(); -} - -#undef Perl_pp_glob -OP * -Perl_pp_glob(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_glob(); -} - -#undef Perl_pp_gmtime -OP * -Perl_pp_gmtime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gmtime(); -} - -#undef Perl_pp_gnbyaddr -OP * -Perl_pp_gnbyaddr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gnbyaddr(); -} - -#undef Perl_pp_gnbyname -OP * -Perl_pp_gnbyname(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gnbyname(); -} - -#undef Perl_pp_gnetent -OP * -Perl_pp_gnetent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gnetent(); -} - -#undef Perl_pp_goto -OP * -Perl_pp_goto(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_goto(); -} - -#undef Perl_pp_gpbyname -OP * -Perl_pp_gpbyname(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gpbyname(); -} - -#undef Perl_pp_gpbynumber -OP * -Perl_pp_gpbynumber(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gpbynumber(); -} - -#undef Perl_pp_gprotoent -OP * -Perl_pp_gprotoent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gprotoent(); -} - -#undef Perl_pp_gpwent -OP * -Perl_pp_gpwent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gpwent(); -} - -#undef Perl_pp_gpwnam -OP * -Perl_pp_gpwnam(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gpwnam(); -} - -#undef Perl_pp_gpwuid -OP * -Perl_pp_gpwuid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gpwuid(); -} - -#undef Perl_pp_grepstart -OP * -Perl_pp_grepstart(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_grepstart(); -} - -#undef Perl_pp_grepwhile -OP * -Perl_pp_grepwhile(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_grepwhile(); -} - -#undef Perl_pp_gsbyname -OP * -Perl_pp_gsbyname(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gsbyname(); -} - -#undef Perl_pp_gsbyport -OP * -Perl_pp_gsbyport(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gsbyport(); -} - -#undef Perl_pp_gservent -OP * -Perl_pp_gservent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gservent(); -} - -#undef Perl_pp_gsockopt -OP * -Perl_pp_gsockopt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gsockopt(); -} - -#undef Perl_pp_gt -OP * -Perl_pp_gt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gt(); -} - -#undef Perl_pp_gv -OP * -Perl_pp_gv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gv(); -} - -#undef Perl_pp_gvsv -OP * -Perl_pp_gvsv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_gvsv(); -} - -#undef Perl_pp_helem -OP * -Perl_pp_helem(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_helem(); -} - -#undef Perl_pp_hex -OP * -Perl_pp_hex(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_hex(); -} - -#undef Perl_pp_hslice -OP * -Perl_pp_hslice(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_hslice(); -} - -#undef Perl_pp_i_add -OP * -Perl_pp_i_add(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_add(); -} - -#undef Perl_pp_i_divide -OP * -Perl_pp_i_divide(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_divide(); -} - -#undef Perl_pp_i_eq -OP * -Perl_pp_i_eq(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_eq(); -} - -#undef Perl_pp_i_ge -OP * -Perl_pp_i_ge(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_ge(); -} - -#undef Perl_pp_i_gt -OP * -Perl_pp_i_gt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_gt(); -} - -#undef Perl_pp_i_le -OP * -Perl_pp_i_le(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_le(); -} - -#undef Perl_pp_i_lt -OP * -Perl_pp_i_lt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_lt(); -} - -#undef Perl_pp_i_modulo -OP * -Perl_pp_i_modulo(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_modulo(); -} - -#undef Perl_pp_i_multiply -OP * -Perl_pp_i_multiply(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_multiply(); -} - -#undef Perl_pp_i_ncmp -OP * -Perl_pp_i_ncmp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_ncmp(); -} - -#undef Perl_pp_i_ne -OP * -Perl_pp_i_ne(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_ne(); -} - -#undef Perl_pp_i_negate -OP * -Perl_pp_i_negate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_negate(); -} - -#undef Perl_pp_i_subtract -OP * -Perl_pp_i_subtract(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_i_subtract(); -} - -#undef Perl_pp_index -OP * -Perl_pp_index(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_index(); -} - -#undef Perl_pp_int -OP * -Perl_pp_int(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_int(); -} - -#undef Perl_pp_ioctl -OP * -Perl_pp_ioctl(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ioctl(); -} - -#undef Perl_pp_iter -OP * -Perl_pp_iter(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_iter(); -} - -#undef Perl_pp_join -OP * -Perl_pp_join(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_join(); -} - -#undef Perl_pp_keys -OP * -Perl_pp_keys(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_keys(); -} - -#undef Perl_pp_kill -OP * -Perl_pp_kill(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_kill(); -} - -#undef Perl_pp_last -OP * -Perl_pp_last(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_last(); -} - -#undef Perl_pp_lc -OP * -Perl_pp_lc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lc(); -} - -#undef Perl_pp_lcfirst -OP * -Perl_pp_lcfirst(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lcfirst(); -} - -#undef Perl_pp_le -OP * -Perl_pp_le(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_le(); -} - -#undef Perl_pp_leave -OP * -Perl_pp_leave(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leave(); -} - -#undef Perl_pp_leaveeval -OP * -Perl_pp_leaveeval(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leaveeval(); -} - -#undef Perl_pp_leaveloop -OP * -Perl_pp_leaveloop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leaveloop(); -} - -#undef Perl_pp_leavesub -OP * -Perl_pp_leavesub(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leavesub(); -} - -#undef Perl_pp_leavesublv -OP * -Perl_pp_leavesublv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leavesublv(); -} - -#undef Perl_pp_leavetry -OP * -Perl_pp_leavetry(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leavetry(); -} - -#undef Perl_pp_leavewrite -OP * -Perl_pp_leavewrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_leavewrite(); -} - -#undef Perl_pp_left_shift -OP * -Perl_pp_left_shift(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_left_shift(); -} - -#undef Perl_pp_length -OP * -Perl_pp_length(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_length(); -} - -#undef Perl_pp_lineseq -OP * -Perl_pp_lineseq(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lineseq(); -} - -#undef Perl_pp_link -OP * -Perl_pp_link(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_link(); -} - -#undef Perl_pp_list -OP * -Perl_pp_list(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_list(); -} - -#undef Perl_pp_listen -OP * -Perl_pp_listen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_listen(); -} - -#undef Perl_pp_localtime -OP * -Perl_pp_localtime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_localtime(); -} - -#undef Perl_pp_lock -OP * -Perl_pp_lock(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lock(); -} - -#undef Perl_pp_log -OP * -Perl_pp_log(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_log(); -} - -#undef Perl_pp_lslice -OP * -Perl_pp_lslice(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lslice(); -} - -#undef Perl_pp_lstat -OP * -Perl_pp_lstat(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lstat(); -} - -#undef Perl_pp_lt -OP * -Perl_pp_lt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_lt(); -} - -#undef Perl_pp_mapstart -OP * -Perl_pp_mapstart(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_mapstart(); -} - -#undef Perl_pp_mapwhile -OP * -Perl_pp_mapwhile(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_mapwhile(); -} - -#undef Perl_pp_match -OP * -Perl_pp_match(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_match(); -} - -#undef Perl_pp_method -OP * -Perl_pp_method(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_method(); -} - -#undef Perl_pp_method_named -OP * -Perl_pp_method_named(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_method_named(); -} - -#undef Perl_pp_mkdir -OP * -Perl_pp_mkdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_mkdir(); -} - -#undef Perl_pp_modulo -OP * -Perl_pp_modulo(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_modulo(); -} - -#undef Perl_pp_msgctl -OP * -Perl_pp_msgctl(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_msgctl(); -} - -#undef Perl_pp_msgget -OP * -Perl_pp_msgget(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_msgget(); -} - -#undef Perl_pp_msgrcv -OP * -Perl_pp_msgrcv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_msgrcv(); -} - -#undef Perl_pp_msgsnd -OP * -Perl_pp_msgsnd(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_msgsnd(); -} - -#undef Perl_pp_multiply -OP * -Perl_pp_multiply(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_multiply(); -} - -#undef Perl_pp_ncmp -OP * -Perl_pp_ncmp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ncmp(); -} - -#undef Perl_pp_ne -OP * -Perl_pp_ne(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ne(); -} - -#undef Perl_pp_negate -OP * -Perl_pp_negate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_negate(); -} - -#undef Perl_pp_next -OP * -Perl_pp_next(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_next(); -} - -#undef Perl_pp_nextstate -OP * -Perl_pp_nextstate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_nextstate(); -} - -#undef Perl_pp_not -OP * -Perl_pp_not(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_not(); -} - -#undef Perl_pp_null -OP * -Perl_pp_null(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_null(); -} - -#undef Perl_pp_oct -OP * -Perl_pp_oct(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_oct(); -} - -#undef Perl_pp_open -OP * -Perl_pp_open(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_open(); -} - -#undef Perl_pp_open_dir -OP * -Perl_pp_open_dir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_open_dir(); -} - -#undef Perl_pp_or -OP * -Perl_pp_or(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_or(); -} - -#undef Perl_pp_orassign -OP * -Perl_pp_orassign(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_orassign(); -} - -#undef Perl_pp_ord -OP * -Perl_pp_ord(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ord(); -} - -#undef Perl_pp_pack -OP * -Perl_pp_pack(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pack(); -} - -#undef Perl_pp_padany -OP * -Perl_pp_padany(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_padany(); -} - -#undef Perl_pp_padav -OP * -Perl_pp_padav(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_padav(); -} - -#undef Perl_pp_padhv -OP * -Perl_pp_padhv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_padhv(); -} - -#undef Perl_pp_padsv -OP * -Perl_pp_padsv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_padsv(); -} - -#undef Perl_pp_pipe_op -OP * -Perl_pp_pipe_op(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pipe_op(); -} - -#undef Perl_pp_pop -OP * -Perl_pp_pop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pop(); -} - -#undef Perl_pp_pos -OP * -Perl_pp_pos(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pos(); -} - -#undef Perl_pp_postdec -OP * -Perl_pp_postdec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_postdec(); -} - -#undef Perl_pp_postinc -OP * -Perl_pp_postinc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_postinc(); -} - -#undef Perl_pp_pow -OP * -Perl_pp_pow(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pow(); -} - -#undef Perl_pp_predec -OP * -Perl_pp_predec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_predec(); -} - -#undef Perl_pp_preinc -OP * -Perl_pp_preinc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_preinc(); -} - -#undef Perl_pp_print -OP * -Perl_pp_print(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_print(); -} - -#undef Perl_pp_prototype -OP * -Perl_pp_prototype(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_prototype(); -} - -#undef Perl_pp_prtf -OP * -Perl_pp_prtf(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_prtf(); -} - -#undef Perl_pp_push -OP * -Perl_pp_push(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_push(); -} - -#undef Perl_pp_pushmark -OP * -Perl_pp_pushmark(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pushmark(); -} - -#undef Perl_pp_pushre -OP * -Perl_pp_pushre(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_pushre(); -} - -#undef Perl_pp_qr -OP * -Perl_pp_qr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_qr(); -} - -#undef Perl_pp_quotemeta -OP * -Perl_pp_quotemeta(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_quotemeta(); -} - -#undef Perl_pp_rand -OP * -Perl_pp_rand(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rand(); -} - -#undef Perl_pp_range -OP * -Perl_pp_range(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_range(); -} - -#undef Perl_pp_rcatline -OP * -Perl_pp_rcatline(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rcatline(); -} - -#undef Perl_pp_read -OP * -Perl_pp_read(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_read(); -} - -#undef Perl_pp_readdir -OP * -Perl_pp_readdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_readdir(); -} - -#undef Perl_pp_readline -OP * -Perl_pp_readline(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_readline(); -} - -#undef Perl_pp_readlink -OP * -Perl_pp_readlink(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_readlink(); -} - -#undef Perl_pp_recv -OP * -Perl_pp_recv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_recv(); -} - -#undef Perl_pp_redo -OP * -Perl_pp_redo(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_redo(); -} - -#undef Perl_pp_ref -OP * -Perl_pp_ref(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ref(); -} - -#undef Perl_pp_refgen -OP * -Perl_pp_refgen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_refgen(); -} - -#undef Perl_pp_regcmaybe -OP * -Perl_pp_regcmaybe(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_regcmaybe(); -} - -#undef Perl_pp_regcomp -OP * -Perl_pp_regcomp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_regcomp(); -} - -#undef Perl_pp_regcreset -OP * -Perl_pp_regcreset(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_regcreset(); -} - -#undef Perl_pp_rename -OP * -Perl_pp_rename(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rename(); -} - -#undef Perl_pp_repeat -OP * -Perl_pp_repeat(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_repeat(); -} - -#undef Perl_pp_require -OP * -Perl_pp_require(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_require(); -} - -#undef Perl_pp_reset -OP * -Perl_pp_reset(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_reset(); -} - -#undef Perl_pp_return -OP * -Perl_pp_return(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_return(); -} - -#undef Perl_pp_reverse -OP * -Perl_pp_reverse(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_reverse(); -} - -#undef Perl_pp_rewinddir -OP * -Perl_pp_rewinddir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rewinddir(); -} - -#undef Perl_pp_right_shift -OP * -Perl_pp_right_shift(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_right_shift(); -} - -#undef Perl_pp_rindex -OP * -Perl_pp_rindex(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rindex(); -} - -#undef Perl_pp_rmdir -OP * -Perl_pp_rmdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rmdir(); -} - -#undef Perl_pp_rv2av -OP * -Perl_pp_rv2av(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rv2av(); -} - -#undef Perl_pp_rv2cv -OP * -Perl_pp_rv2cv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rv2cv(); -} - -#undef Perl_pp_rv2gv -OP * -Perl_pp_rv2gv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rv2gv(); -} - -#undef Perl_pp_rv2hv -OP * -Perl_pp_rv2hv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rv2hv(); -} - -#undef Perl_pp_rv2sv -OP * -Perl_pp_rv2sv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_rv2sv(); -} - -#undef Perl_pp_sassign -OP * -Perl_pp_sassign(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sassign(); -} - -#undef Perl_pp_scalar -OP * -Perl_pp_scalar(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_scalar(); -} - -#undef Perl_pp_schomp -OP * -Perl_pp_schomp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_schomp(); -} - -#undef Perl_pp_schop -OP * -Perl_pp_schop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_schop(); -} - -#undef Perl_pp_scmp -OP * -Perl_pp_scmp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_scmp(); -} - -#undef Perl_pp_scope -OP * -Perl_pp_scope(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_scope(); -} - -#undef Perl_pp_seek -OP * -Perl_pp_seek(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_seek(); -} - -#undef Perl_pp_seekdir -OP * -Perl_pp_seekdir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_seekdir(); -} - -#undef Perl_pp_select -OP * -Perl_pp_select(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_select(); -} - -#undef Perl_pp_semctl -OP * -Perl_pp_semctl(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_semctl(); -} - -#undef Perl_pp_semget -OP * -Perl_pp_semget(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_semget(); -} - -#undef Perl_pp_semop -OP * -Perl_pp_semop(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_semop(); -} - -#undef Perl_pp_send -OP * -Perl_pp_send(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_send(); -} - -#undef Perl_pp_seq -OP * -Perl_pp_seq(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_seq(); -} - -#undef Perl_pp_setpgrp -OP * -Perl_pp_setpgrp(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_setpgrp(); -} - -#undef Perl_pp_setpriority -OP * -Perl_pp_setpriority(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_setpriority(); -} - -#undef Perl_pp_setstate -OP * -Perl_pp_setstate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_setstate(); -} - -#undef Perl_pp_sge -OP * -Perl_pp_sge(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sge(); -} - -#undef Perl_pp_sgrent -OP * -Perl_pp_sgrent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sgrent(); -} - -#undef Perl_pp_sgt -OP * -Perl_pp_sgt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sgt(); -} - -#undef Perl_pp_shift -OP * -Perl_pp_shift(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shift(); -} - -#undef Perl_pp_shmctl -OP * -Perl_pp_shmctl(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shmctl(); -} - -#undef Perl_pp_shmget -OP * -Perl_pp_shmget(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shmget(); -} - -#undef Perl_pp_shmread -OP * -Perl_pp_shmread(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shmread(); -} - -#undef Perl_pp_shmwrite -OP * -Perl_pp_shmwrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shmwrite(); -} - -#undef Perl_pp_shostent -OP * -Perl_pp_shostent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shostent(); -} - -#undef Perl_pp_shutdown -OP * -Perl_pp_shutdown(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_shutdown(); -} - -#undef Perl_pp_sin -OP * -Perl_pp_sin(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sin(); -} - -#undef Perl_pp_sle -OP * -Perl_pp_sle(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sle(); -} - -#undef Perl_pp_sleep -OP * -Perl_pp_sleep(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sleep(); -} - -#undef Perl_pp_slt -OP * -Perl_pp_slt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_slt(); -} - -#undef Perl_pp_sne -OP * -Perl_pp_sne(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sne(); -} - -#undef Perl_pp_snetent -OP * -Perl_pp_snetent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_snetent(); -} - -#undef Perl_pp_socket -OP * -Perl_pp_socket(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_socket(); -} - -#undef Perl_pp_sockpair -OP * -Perl_pp_sockpair(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sockpair(); -} - -#undef Perl_pp_sort -OP * -Perl_pp_sort(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sort(); -} - -#undef Perl_pp_splice -OP * -Perl_pp_splice(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_splice(); -} - -#undef Perl_pp_split -OP * -Perl_pp_split(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_split(); -} - -#undef Perl_pp_sprintf -OP * -Perl_pp_sprintf(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sprintf(); -} - -#undef Perl_pp_sprotoent -OP * -Perl_pp_sprotoent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sprotoent(); -} - -#undef Perl_pp_spwent -OP * -Perl_pp_spwent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_spwent(); -} - -#undef Perl_pp_sqrt -OP * -Perl_pp_sqrt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sqrt(); -} - -#undef Perl_pp_srand -OP * -Perl_pp_srand(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_srand(); -} - -#undef Perl_pp_srefgen -OP * -Perl_pp_srefgen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_srefgen(); -} - -#undef Perl_pp_sselect -OP * -Perl_pp_sselect(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sselect(); -} - -#undef Perl_pp_sservent -OP * -Perl_pp_sservent(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sservent(); -} - -#undef Perl_pp_ssockopt -OP * -Perl_pp_ssockopt(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ssockopt(); -} - -#undef Perl_pp_stat -OP * -Perl_pp_stat(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_stat(); -} - -#undef Perl_pp_stringify -OP * -Perl_pp_stringify(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_stringify(); -} - -#undef Perl_pp_stub -OP * -Perl_pp_stub(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_stub(); -} - -#undef Perl_pp_study -OP * -Perl_pp_study(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_study(); -} - -#undef Perl_pp_subst -OP * -Perl_pp_subst(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_subst(); -} - -#undef Perl_pp_substcont -OP * -Perl_pp_substcont(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_substcont(); -} - -#undef Perl_pp_substr -OP * -Perl_pp_substr(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_substr(); -} - -#undef Perl_pp_subtract -OP * -Perl_pp_subtract(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_subtract(); -} - -#undef Perl_pp_symlink -OP * -Perl_pp_symlink(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_symlink(); -} - -#undef Perl_pp_syscall -OP * -Perl_pp_syscall(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_syscall(); -} - -#undef Perl_pp_sysopen -OP * -Perl_pp_sysopen(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sysopen(); -} - -#undef Perl_pp_sysread -OP * -Perl_pp_sysread(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sysread(); -} - -#undef Perl_pp_sysseek -OP * -Perl_pp_sysseek(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_sysseek(); -} - -#undef Perl_pp_system -OP * -Perl_pp_system(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_system(); -} - -#undef Perl_pp_syswrite -OP * -Perl_pp_syswrite(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_syswrite(); -} - -#undef Perl_pp_tell -OP * -Perl_pp_tell(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_tell(); -} - -#undef Perl_pp_telldir -OP * -Perl_pp_telldir(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_telldir(); -} - -#undef Perl_pp_threadsv -OP * -Perl_pp_threadsv(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_threadsv(); -} - -#undef Perl_pp_tie -OP * -Perl_pp_tie(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_tie(); -} - -#undef Perl_pp_tied -OP * -Perl_pp_tied(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_tied(); -} - -#undef Perl_pp_time -OP * -Perl_pp_time(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_time(); -} - -#undef Perl_pp_tms -OP * -Perl_pp_tms(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_tms(); -} - -#undef Perl_pp_trans -OP * -Perl_pp_trans(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_trans(); -} - -#undef Perl_pp_truncate -OP * -Perl_pp_truncate(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_truncate(); -} - -#undef Perl_pp_uc -OP * -Perl_pp_uc(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_uc(); -} - -#undef Perl_pp_ucfirst -OP * -Perl_pp_ucfirst(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_ucfirst(); -} - -#undef Perl_pp_umask -OP * -Perl_pp_umask(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_umask(); -} - -#undef Perl_pp_undef -OP * -Perl_pp_undef(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_undef(); -} - -#undef Perl_pp_unlink -OP * -Perl_pp_unlink(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_unlink(); -} - -#undef Perl_pp_unpack -OP * -Perl_pp_unpack(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_unpack(); -} - -#undef Perl_pp_unshift -OP * -Perl_pp_unshift(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_unshift(); -} - -#undef Perl_pp_unstack -OP * -Perl_pp_unstack(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_unstack(); -} - -#undef Perl_pp_untie -OP * -Perl_pp_untie(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_untie(); -} - -#undef Perl_pp_utime -OP * -Perl_pp_utime(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_utime(); -} - -#undef Perl_pp_values -OP * -Perl_pp_values(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_values(); -} - -#undef Perl_pp_vec -OP * -Perl_pp_vec(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_vec(); -} - -#undef Perl_pp_wait -OP * -Perl_pp_wait(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_wait(); -} - -#undef Perl_pp_waitpid -OP * -Perl_pp_waitpid(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_waitpid(); -} - -#undef Perl_pp_wantarray -OP * -Perl_pp_wantarray(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_wantarray(); -} - -#undef Perl_pp_warn -OP * -Perl_pp_warn(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_warn(); -} - -#undef Perl_pp_xor -OP * -Perl_pp_xor(pTHXo) -{ - return ((CPerlObj*)pPerl)->Perl_pp_xor(); -} +#if defined(PERL_OBJECT) +#endif #undef Perl_fprintf_nocontext int @@ -7596,9 +3923,10 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) dTHXo; va_list(arglist); va_start(arglist, format); - return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist); + return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist); } END_EXTERN_C #endif /* PERL_OBJECT */ +#endif /* PERL_OBJECT || MULTIPLICITY */ @@ -4,8 +4,10 @@ */ /* declare accessor functions for Perl variables */ +#ifndef __perlapi_h__ +#define __perlapi_h__ -#if defined(PERL_OBJECT) || defined (PERL_CAPI) +#if defined(PERL_OBJECT) || defined (MULTIPLICITY) #if defined(PERL_OBJECT) # undef aTHXo @@ -37,5 +39,852 @@ START_EXTERN_C END_EXTERN_C -#endif /* PERL_OBJECT || PERL_CAPI */ +#if defined(PERL_CORE) + +/* accessor functions for Perl variables (provide binary compatibility) */ + +/* these need to be mentioned here, or most linkers won't put them in + the perl executable */ + +#ifndef PERL_NO_FORCE_LINK + +START_EXTERN_C + +#ifndef DOINIT +EXT void *PL_force_link_funcs[]; +#else +EXT void *PL_force_link_funcs[] = { +#undef PERLVAR +#undef PERLVARA +#undef PERLVARI +#undef PERLVARIC +#define PERLVAR(v,t) (void*)Perl_##v##_ptr, +#define PERLVARA(v,n,t) PERLVAR(v,t) +#define PERLVARI(v,t,i) PERLVAR(v,t) +#define PERLVARIC(v,t,i) PERLVAR(v,t) + +#include "thrdvar.h" +#include "intrpvar.h" +#include "perlvars.h" + +#undef PERLVAR +#undef PERLVARA +#undef PERLVARI +#undef PERLVARIC +}; +#endif /* DOINIT */ + +START_EXTERN_C + +#endif /* PERL_NO_FORCE_LINK */ + +#else /* !PERL_CORE */ + +#undef PL_Argv +#define PL_Argv (*Perl_IArgv_ptr(aTHXo)) +#undef PL_Cmd +#define PL_Cmd (*Perl_ICmd_ptr(aTHXo)) +#undef PL_DBcv +#define PL_DBcv (*Perl_IDBcv_ptr(aTHXo)) +#undef PL_DBgv +#define PL_DBgv (*Perl_IDBgv_ptr(aTHXo)) +#undef PL_DBline +#define PL_DBline (*Perl_IDBline_ptr(aTHXo)) +#undef PL_DBsignal +#define PL_DBsignal (*Perl_IDBsignal_ptr(aTHXo)) +#undef PL_DBsingle +#define PL_DBsingle (*Perl_IDBsingle_ptr(aTHXo)) +#undef PL_DBsub +#define PL_DBsub (*Perl_IDBsub_ptr(aTHXo)) +#undef PL_DBtrace +#define PL_DBtrace (*Perl_IDBtrace_ptr(aTHXo)) +#undef PL_Dir +#define PL_Dir (*Perl_IDir_ptr(aTHXo)) +#undef PL_Env +#define PL_Env (*Perl_IEnv_ptr(aTHXo)) +#undef PL_LIO +#define PL_LIO (*Perl_ILIO_ptr(aTHXo)) +#undef PL_Mem +#define PL_Mem (*Perl_IMem_ptr(aTHXo)) +#undef PL_MemParse +#define PL_MemParse (*Perl_IMemParse_ptr(aTHXo)) +#undef PL_MemShared +#define PL_MemShared (*Perl_IMemShared_ptr(aTHXo)) +#undef PL_Proc +#define PL_Proc (*Perl_IProc_ptr(aTHXo)) +#undef PL_Sock +#define PL_Sock (*Perl_ISock_ptr(aTHXo)) +#undef PL_StdIO +#define PL_StdIO (*Perl_IStdIO_ptr(aTHXo)) +#undef PL_amagic_generation +#define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo)) +#undef PL_an +#define PL_an (*Perl_Ian_ptr(aTHXo)) +#undef PL_argvgv +#define PL_argvgv (*Perl_Iargvgv_ptr(aTHXo)) +#undef PL_argvout_stack +#define PL_argvout_stack (*Perl_Iargvout_stack_ptr(aTHXo)) +#undef PL_argvoutgv +#define PL_argvoutgv (*Perl_Iargvoutgv_ptr(aTHXo)) +#undef PL_basetime +#define PL_basetime (*Perl_Ibasetime_ptr(aTHXo)) +#undef PL_beginav +#define PL_beginav (*Perl_Ibeginav_ptr(aTHXo)) +#undef PL_bitcount +#define PL_bitcount (*Perl_Ibitcount_ptr(aTHXo)) +#undef PL_bufend +#define PL_bufend (*Perl_Ibufend_ptr(aTHXo)) +#undef PL_bufptr +#define PL_bufptr (*Perl_Ibufptr_ptr(aTHXo)) +#undef PL_checkav +#define PL_checkav (*Perl_Icheckav_ptr(aTHXo)) +#undef PL_collation_ix +#define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHXo)) +#undef PL_collation_name +#define PL_collation_name (*Perl_Icollation_name_ptr(aTHXo)) +#undef PL_collation_standard +#define PL_collation_standard (*Perl_Icollation_standard_ptr(aTHXo)) +#undef PL_collxfrm_base +#define PL_collxfrm_base (*Perl_Icollxfrm_base_ptr(aTHXo)) +#undef PL_collxfrm_mult +#define PL_collxfrm_mult (*Perl_Icollxfrm_mult_ptr(aTHXo)) +#undef PL_compcv +#define PL_compcv (*Perl_Icompcv_ptr(aTHXo)) +#undef PL_compiling +#define PL_compiling (*Perl_Icompiling_ptr(aTHXo)) +#undef PL_comppad +#define PL_comppad (*Perl_Icomppad_ptr(aTHXo)) +#undef PL_comppad_name +#define PL_comppad_name (*Perl_Icomppad_name_ptr(aTHXo)) +#undef PL_comppad_name_fill +#define PL_comppad_name_fill (*Perl_Icomppad_name_fill_ptr(aTHXo)) +#undef PL_comppad_name_floor +#define PL_comppad_name_floor (*Perl_Icomppad_name_floor_ptr(aTHXo)) +#undef PL_cop_seqmax +#define PL_cop_seqmax (*Perl_Icop_seqmax_ptr(aTHXo)) +#undef PL_copline +#define PL_copline (*Perl_Icopline_ptr(aTHXo)) +#undef PL_cred_mutex +#define PL_cred_mutex (*Perl_Icred_mutex_ptr(aTHXo)) +#undef PL_cryptseen +#define PL_cryptseen (*Perl_Icryptseen_ptr(aTHXo)) +#undef PL_cshlen +#define PL_cshlen (*Perl_Icshlen_ptr(aTHXo)) +#undef PL_cshname +#define PL_cshname (*Perl_Icshname_ptr(aTHXo)) +#undef PL_curcopdb +#define PL_curcopdb (*Perl_Icurcopdb_ptr(aTHXo)) +#undef PL_curstname +#define PL_curstname (*Perl_Icurstname_ptr(aTHXo)) +#undef PL_curthr +#define PL_curthr (*Perl_Icurthr_ptr(aTHXo)) +#undef PL_dbargs +#define PL_dbargs (*Perl_Idbargs_ptr(aTHXo)) +#undef PL_debstash +#define PL_debstash (*Perl_Idebstash_ptr(aTHXo)) +#undef PL_debug +#define PL_debug (*Perl_Idebug_ptr(aTHXo)) +#undef PL_defgv +#define PL_defgv (*Perl_Idefgv_ptr(aTHXo)) +#undef PL_diehook +#define PL_diehook (*Perl_Idiehook_ptr(aTHXo)) +#undef PL_doextract +#define PL_doextract (*Perl_Idoextract_ptr(aTHXo)) +#undef PL_doswitches +#define PL_doswitches (*Perl_Idoswitches_ptr(aTHXo)) +#undef PL_dowarn +#define PL_dowarn (*Perl_Idowarn_ptr(aTHXo)) +#undef PL_e_script +#define PL_e_script (*Perl_Ie_script_ptr(aTHXo)) +#undef PL_egid +#define PL_egid (*Perl_Iegid_ptr(aTHXo)) +#undef PL_endav +#define PL_endav (*Perl_Iendav_ptr(aTHXo)) +#undef PL_envgv +#define PL_envgv (*Perl_Ienvgv_ptr(aTHXo)) +#undef PL_errgv +#define PL_errgv (*Perl_Ierrgv_ptr(aTHXo)) +#undef PL_error_count +#define PL_error_count (*Perl_Ierror_count_ptr(aTHXo)) +#undef PL_euid +#define PL_euid (*Perl_Ieuid_ptr(aTHXo)) +#undef PL_eval_cond +#define PL_eval_cond (*Perl_Ieval_cond_ptr(aTHXo)) +#undef PL_eval_mutex +#define PL_eval_mutex (*Perl_Ieval_mutex_ptr(aTHXo)) +#undef PL_eval_owner +#define PL_eval_owner (*Perl_Ieval_owner_ptr(aTHXo)) +#undef PL_eval_root +#define PL_eval_root (*Perl_Ieval_root_ptr(aTHXo)) +#undef PL_eval_start +#define PL_eval_start (*Perl_Ieval_start_ptr(aTHXo)) +#undef PL_evalseq +#define PL_evalseq (*Perl_Ievalseq_ptr(aTHXo)) +#undef PL_exit_flags +#define PL_exit_flags (*Perl_Iexit_flags_ptr(aTHXo)) +#undef PL_exitlist +#define PL_exitlist (*Perl_Iexitlist_ptr(aTHXo)) +#undef PL_exitlistlen +#define PL_exitlistlen (*Perl_Iexitlistlen_ptr(aTHXo)) +#undef PL_expect +#define PL_expect (*Perl_Iexpect_ptr(aTHXo)) +#undef PL_fdpid +#define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo)) +#undef PL_filemode +#define PL_filemode (*Perl_Ifilemode_ptr(aTHXo)) +#undef PL_forkprocess +#define PL_forkprocess (*Perl_Iforkprocess_ptr(aTHXo)) +#undef PL_formfeed +#define PL_formfeed (*Perl_Iformfeed_ptr(aTHXo)) +#undef PL_generation +#define PL_generation (*Perl_Igeneration_ptr(aTHXo)) +#undef PL_gensym +#define PL_gensym (*Perl_Igensym_ptr(aTHXo)) +#undef PL_gid +#define PL_gid (*Perl_Igid_ptr(aTHXo)) +#undef PL_glob_index +#define PL_glob_index (*Perl_Iglob_index_ptr(aTHXo)) +#undef PL_globalstash +#define PL_globalstash (*Perl_Iglobalstash_ptr(aTHXo)) +#undef PL_he_root +#define PL_he_root (*Perl_Ihe_root_ptr(aTHXo)) +#undef PL_hintgv +#define PL_hintgv (*Perl_Ihintgv_ptr(aTHXo)) +#undef PL_hints +#define PL_hints (*Perl_Ihints_ptr(aTHXo)) +#undef PL_in_clean_all +#define PL_in_clean_all (*Perl_Iin_clean_all_ptr(aTHXo)) +#undef PL_in_clean_objs +#define PL_in_clean_objs (*Perl_Iin_clean_objs_ptr(aTHXo)) +#undef PL_in_my +#define PL_in_my (*Perl_Iin_my_ptr(aTHXo)) +#undef PL_in_my_stash +#define PL_in_my_stash (*Perl_Iin_my_stash_ptr(aTHXo)) +#undef PL_incgv +#define PL_incgv (*Perl_Iincgv_ptr(aTHXo)) +#undef PL_initav +#define PL_initav (*Perl_Iinitav_ptr(aTHXo)) +#undef PL_inplace +#define PL_inplace (*Perl_Iinplace_ptr(aTHXo)) +#undef PL_last_lop +#define PL_last_lop (*Perl_Ilast_lop_ptr(aTHXo)) +#undef PL_last_lop_op +#define PL_last_lop_op (*Perl_Ilast_lop_op_ptr(aTHXo)) +#undef PL_last_swash_hv +#define PL_last_swash_hv (*Perl_Ilast_swash_hv_ptr(aTHXo)) +#undef PL_last_swash_key +#define PL_last_swash_key (*Perl_Ilast_swash_key_ptr(aTHXo)) +#undef PL_last_swash_klen +#define PL_last_swash_klen (*Perl_Ilast_swash_klen_ptr(aTHXo)) +#undef PL_last_swash_slen +#define PL_last_swash_slen (*Perl_Ilast_swash_slen_ptr(aTHXo)) +#undef PL_last_swash_tmps +#define PL_last_swash_tmps (*Perl_Ilast_swash_tmps_ptr(aTHXo)) +#undef PL_last_uni +#define PL_last_uni (*Perl_Ilast_uni_ptr(aTHXo)) +#undef PL_lastfd +#define PL_lastfd (*Perl_Ilastfd_ptr(aTHXo)) +#undef PL_laststatval +#define PL_laststatval (*Perl_Ilaststatval_ptr(aTHXo)) +#undef PL_laststype +#define PL_laststype (*Perl_Ilaststype_ptr(aTHXo)) +#undef PL_lex_brackets +#define PL_lex_brackets (*Perl_Ilex_brackets_ptr(aTHXo)) +#undef PL_lex_brackstack +#define PL_lex_brackstack (*Perl_Ilex_brackstack_ptr(aTHXo)) +#undef PL_lex_casemods +#define PL_lex_casemods (*Perl_Ilex_casemods_ptr(aTHXo)) +#undef PL_lex_casestack +#define PL_lex_casestack (*Perl_Ilex_casestack_ptr(aTHXo)) +#undef PL_lex_defer +#define PL_lex_defer (*Perl_Ilex_defer_ptr(aTHXo)) +#undef PL_lex_dojoin +#define PL_lex_dojoin (*Perl_Ilex_dojoin_ptr(aTHXo)) +#undef PL_lex_expect +#define PL_lex_expect (*Perl_Ilex_expect_ptr(aTHXo)) +#undef PL_lex_formbrack +#define PL_lex_formbrack (*Perl_Ilex_formbrack_ptr(aTHXo)) +#undef PL_lex_inpat +#define PL_lex_inpat (*Perl_Ilex_inpat_ptr(aTHXo)) +#undef PL_lex_inwhat +#define PL_lex_inwhat (*Perl_Ilex_inwhat_ptr(aTHXo)) +#undef PL_lex_op +#define PL_lex_op (*Perl_Ilex_op_ptr(aTHXo)) +#undef PL_lex_repl +#define PL_lex_repl (*Perl_Ilex_repl_ptr(aTHXo)) +#undef PL_lex_starts +#define PL_lex_starts (*Perl_Ilex_starts_ptr(aTHXo)) +#undef PL_lex_state +#define PL_lex_state (*Perl_Ilex_state_ptr(aTHXo)) +#undef PL_lex_stuff +#define PL_lex_stuff (*Perl_Ilex_stuff_ptr(aTHXo)) +#undef PL_lineary +#define PL_lineary (*Perl_Ilineary_ptr(aTHXo)) +#undef PL_linestart +#define PL_linestart (*Perl_Ilinestart_ptr(aTHXo)) +#undef PL_linestr +#define PL_linestr (*Perl_Ilinestr_ptr(aTHXo)) +#undef PL_localpatches +#define PL_localpatches (*Perl_Ilocalpatches_ptr(aTHXo)) +#undef PL_main_cv +#define PL_main_cv (*Perl_Imain_cv_ptr(aTHXo)) +#undef PL_main_root +#define PL_main_root (*Perl_Imain_root_ptr(aTHXo)) +#undef PL_main_start +#define PL_main_start (*Perl_Imain_start_ptr(aTHXo)) +#undef PL_max_intro_pending +#define PL_max_intro_pending (*Perl_Imax_intro_pending_ptr(aTHXo)) +#undef PL_maxo +#define PL_maxo (*Perl_Imaxo_ptr(aTHXo)) +#undef PL_maxsysfd +#define PL_maxsysfd (*Perl_Imaxsysfd_ptr(aTHXo)) +#undef PL_mess_sv +#define PL_mess_sv (*Perl_Imess_sv_ptr(aTHXo)) +#undef PL_min_intro_pending +#define PL_min_intro_pending (*Perl_Imin_intro_pending_ptr(aTHXo)) +#undef PL_minus_F +#define PL_minus_F (*Perl_Iminus_F_ptr(aTHXo)) +#undef PL_minus_a +#define PL_minus_a (*Perl_Iminus_a_ptr(aTHXo)) +#undef PL_minus_c +#define PL_minus_c (*Perl_Iminus_c_ptr(aTHXo)) +#undef PL_minus_l +#define PL_minus_l (*Perl_Iminus_l_ptr(aTHXo)) +#undef PL_minus_n +#define PL_minus_n (*Perl_Iminus_n_ptr(aTHXo)) +#undef PL_minus_p +#define PL_minus_p (*Perl_Iminus_p_ptr(aTHXo)) +#undef PL_modglobal +#define PL_modglobal (*Perl_Imodglobal_ptr(aTHXo)) +#undef PL_multi_close +#define PL_multi_close (*Perl_Imulti_close_ptr(aTHXo)) +#undef PL_multi_end +#define PL_multi_end (*Perl_Imulti_end_ptr(aTHXo)) +#undef PL_multi_open +#define PL_multi_open (*Perl_Imulti_open_ptr(aTHXo)) +#undef PL_multi_start +#define PL_multi_start (*Perl_Imulti_start_ptr(aTHXo)) +#undef PL_multiline +#define PL_multiline (*Perl_Imultiline_ptr(aTHXo)) +#undef PL_nexttoke +#define PL_nexttoke (*Perl_Inexttoke_ptr(aTHXo)) +#undef PL_nexttype +#define PL_nexttype (*Perl_Inexttype_ptr(aTHXo)) +#undef PL_nextval +#define PL_nextval (*Perl_Inextval_ptr(aTHXo)) +#undef PL_nice_chunk +#define PL_nice_chunk (*Perl_Inice_chunk_ptr(aTHXo)) +#undef PL_nice_chunk_size +#define PL_nice_chunk_size (*Perl_Inice_chunk_size_ptr(aTHXo)) +#undef PL_nomemok +#define PL_nomemok (*Perl_Inomemok_ptr(aTHXo)) +#undef PL_nthreads +#define PL_nthreads (*Perl_Inthreads_ptr(aTHXo)) +#undef PL_nthreads_cond +#define PL_nthreads_cond (*Perl_Inthreads_cond_ptr(aTHXo)) +#undef PL_numeric_local +#define PL_numeric_local (*Perl_Inumeric_local_ptr(aTHXo)) +#undef PL_numeric_name +#define PL_numeric_name (*Perl_Inumeric_name_ptr(aTHXo)) +#undef PL_numeric_radix +#define PL_numeric_radix (*Perl_Inumeric_radix_ptr(aTHXo)) +#undef PL_numeric_standard +#define PL_numeric_standard (*Perl_Inumeric_standard_ptr(aTHXo)) +#undef PL_ofmt +#define PL_ofmt (*Perl_Iofmt_ptr(aTHXo)) +#undef PL_oldbufptr +#define PL_oldbufptr (*Perl_Ioldbufptr_ptr(aTHXo)) +#undef PL_oldname +#define PL_oldname (*Perl_Ioldname_ptr(aTHXo)) +#undef PL_oldoldbufptr +#define PL_oldoldbufptr (*Perl_Ioldoldbufptr_ptr(aTHXo)) +#undef PL_op_mask +#define PL_op_mask (*Perl_Iop_mask_ptr(aTHXo)) +#undef PL_op_seqmax +#define PL_op_seqmax (*Perl_Iop_seqmax_ptr(aTHXo)) +#undef PL_origalen +#define PL_origalen (*Perl_Iorigalen_ptr(aTHXo)) +#undef PL_origargc +#define PL_origargc (*Perl_Iorigargc_ptr(aTHXo)) +#undef PL_origargv +#define PL_origargv (*Perl_Iorigargv_ptr(aTHXo)) +#undef PL_origenviron +#define PL_origenviron (*Perl_Iorigenviron_ptr(aTHXo)) +#undef PL_origfilename +#define PL_origfilename (*Perl_Iorigfilename_ptr(aTHXo)) +#undef PL_ors +#define PL_ors (*Perl_Iors_ptr(aTHXo)) +#undef PL_orslen +#define PL_orslen (*Perl_Iorslen_ptr(aTHXo)) +#undef PL_osname +#define PL_osname (*Perl_Iosname_ptr(aTHXo)) +#undef PL_pad_reset_pending +#define PL_pad_reset_pending (*Perl_Ipad_reset_pending_ptr(aTHXo)) +#undef PL_padix +#define PL_padix (*Perl_Ipadix_ptr(aTHXo)) +#undef PL_padix_floor +#define PL_padix_floor (*Perl_Ipadix_floor_ptr(aTHXo)) +#undef PL_patchlevel +#define PL_patchlevel (*Perl_Ipatchlevel_ptr(aTHXo)) +#undef PL_pending_ident +#define PL_pending_ident (*Perl_Ipending_ident_ptr(aTHXo)) +#undef PL_perl_destruct_level +#define PL_perl_destruct_level (*Perl_Iperl_destruct_level_ptr(aTHXo)) +#undef PL_perldb +#define PL_perldb (*Perl_Iperldb_ptr(aTHXo)) +#undef PL_pidstatus +#define PL_pidstatus (*Perl_Ipidstatus_ptr(aTHXo)) +#undef PL_preambleav +#define PL_preambleav (*Perl_Ipreambleav_ptr(aTHXo)) +#undef PL_preambled +#define PL_preambled (*Perl_Ipreambled_ptr(aTHXo)) +#undef PL_preprocess +#define PL_preprocess (*Perl_Ipreprocess_ptr(aTHXo)) +#undef PL_profiledata +#define PL_profiledata (*Perl_Iprofiledata_ptr(aTHXo)) +#undef PL_psig_name +#define PL_psig_name (*Perl_Ipsig_name_ptr(aTHXo)) +#undef PL_psig_ptr +#define PL_psig_ptr (*Perl_Ipsig_ptr_ptr(aTHXo)) +#undef PL_ptr_table +#define PL_ptr_table (*Perl_Iptr_table_ptr(aTHXo)) +#undef PL_replgv +#define PL_replgv (*Perl_Ireplgv_ptr(aTHXo)) +#undef PL_rsfp +#define PL_rsfp (*Perl_Irsfp_ptr(aTHXo)) +#undef PL_rsfp_filters +#define PL_rsfp_filters (*Perl_Irsfp_filters_ptr(aTHXo)) +#undef PL_runops +#define PL_runops (*Perl_Irunops_ptr(aTHXo)) +#undef PL_sawampersand +#define PL_sawampersand (*Perl_Isawampersand_ptr(aTHXo)) +#undef PL_sh_path +#define PL_sh_path (*Perl_Ish_path_ptr(aTHXo)) +#undef PL_sighandlerp +#define PL_sighandlerp (*Perl_Isighandlerp_ptr(aTHXo)) +#undef PL_splitstr +#define PL_splitstr (*Perl_Isplitstr_ptr(aTHXo)) +#undef PL_srand_called +#define PL_srand_called (*Perl_Isrand_called_ptr(aTHXo)) +#undef PL_statusvalue +#define PL_statusvalue (*Perl_Istatusvalue_ptr(aTHXo)) +#undef PL_statusvalue_vms +#define PL_statusvalue_vms (*Perl_Istatusvalue_vms_ptr(aTHXo)) +#undef PL_stderrgv +#define PL_stderrgv (*Perl_Istderrgv_ptr(aTHXo)) +#undef PL_stdingv +#define PL_stdingv (*Perl_Istdingv_ptr(aTHXo)) +#undef PL_strtab +#define PL_strtab (*Perl_Istrtab_ptr(aTHXo)) +#undef PL_strtab_mutex +#define PL_strtab_mutex (*Perl_Istrtab_mutex_ptr(aTHXo)) +#undef PL_sub_generation +#define PL_sub_generation (*Perl_Isub_generation_ptr(aTHXo)) +#undef PL_sublex_info +#define PL_sublex_info (*Perl_Isublex_info_ptr(aTHXo)) +#undef PL_subline +#define PL_subline (*Perl_Isubline_ptr(aTHXo)) +#undef PL_subname +#define PL_subname (*Perl_Isubname_ptr(aTHXo)) +#undef PL_sv_arenaroot +#define PL_sv_arenaroot (*Perl_Isv_arenaroot_ptr(aTHXo)) +#undef PL_sv_count +#define PL_sv_count (*Perl_Isv_count_ptr(aTHXo)) +#undef PL_sv_mutex +#define PL_sv_mutex (*Perl_Isv_mutex_ptr(aTHXo)) +#undef PL_sv_no +#define PL_sv_no (*Perl_Isv_no_ptr(aTHXo)) +#undef PL_sv_objcount +#define PL_sv_objcount (*Perl_Isv_objcount_ptr(aTHXo)) +#undef PL_sv_root +#define PL_sv_root (*Perl_Isv_root_ptr(aTHXo)) +#undef PL_sv_undef +#define PL_sv_undef (*Perl_Isv_undef_ptr(aTHXo)) +#undef PL_sv_yes +#define PL_sv_yes (*Perl_Isv_yes_ptr(aTHXo)) +#undef PL_svref_mutex +#define PL_svref_mutex (*Perl_Isvref_mutex_ptr(aTHXo)) +#undef PL_sys_intern +#define PL_sys_intern (*Perl_Isys_intern_ptr(aTHXo)) +#undef PL_tainting +#define PL_tainting (*Perl_Itainting_ptr(aTHXo)) +#undef PL_thr_key +#define PL_thr_key (*Perl_Ithr_key_ptr(aTHXo)) +#undef PL_threadnum +#define PL_threadnum (*Perl_Ithreadnum_ptr(aTHXo)) +#undef PL_threads_mutex +#define PL_threads_mutex (*Perl_Ithreads_mutex_ptr(aTHXo)) +#undef PL_threadsv_names +#define PL_threadsv_names (*Perl_Ithreadsv_names_ptr(aTHXo)) +#undef PL_thrsv +#define PL_thrsv (*Perl_Ithrsv_ptr(aTHXo)) +#undef PL_tokenbuf +#define PL_tokenbuf (*Perl_Itokenbuf_ptr(aTHXo)) +#undef PL_uid +#define PL_uid (*Perl_Iuid_ptr(aTHXo)) +#undef PL_unsafe +#define PL_unsafe (*Perl_Iunsafe_ptr(aTHXo)) +#undef PL_utf8_alnum +#define PL_utf8_alnum (*Perl_Iutf8_alnum_ptr(aTHXo)) +#undef PL_utf8_alnumc +#define PL_utf8_alnumc (*Perl_Iutf8_alnumc_ptr(aTHXo)) +#undef PL_utf8_alpha +#define PL_utf8_alpha (*Perl_Iutf8_alpha_ptr(aTHXo)) +#undef PL_utf8_ascii +#define PL_utf8_ascii (*Perl_Iutf8_ascii_ptr(aTHXo)) +#undef PL_utf8_cntrl +#define PL_utf8_cntrl (*Perl_Iutf8_cntrl_ptr(aTHXo)) +#undef PL_utf8_digit +#define PL_utf8_digit (*Perl_Iutf8_digit_ptr(aTHXo)) +#undef PL_utf8_graph +#define PL_utf8_graph (*Perl_Iutf8_graph_ptr(aTHXo)) +#undef PL_utf8_lower +#define PL_utf8_lower (*Perl_Iutf8_lower_ptr(aTHXo)) +#undef PL_utf8_mark +#define PL_utf8_mark (*Perl_Iutf8_mark_ptr(aTHXo)) +#undef PL_utf8_print +#define PL_utf8_print (*Perl_Iutf8_print_ptr(aTHXo)) +#undef PL_utf8_punct +#define PL_utf8_punct (*Perl_Iutf8_punct_ptr(aTHXo)) +#undef PL_utf8_space +#define PL_utf8_space (*Perl_Iutf8_space_ptr(aTHXo)) +#undef PL_utf8_tolower +#define PL_utf8_tolower (*Perl_Iutf8_tolower_ptr(aTHXo)) +#undef PL_utf8_totitle +#define PL_utf8_totitle (*Perl_Iutf8_totitle_ptr(aTHXo)) +#undef PL_utf8_toupper +#define PL_utf8_toupper (*Perl_Iutf8_toupper_ptr(aTHXo)) +#undef PL_utf8_upper +#define PL_utf8_upper (*Perl_Iutf8_upper_ptr(aTHXo)) +#undef PL_utf8_xdigit +#define PL_utf8_xdigit (*Perl_Iutf8_xdigit_ptr(aTHXo)) +#undef PL_uudmap +#define PL_uudmap (*Perl_Iuudmap_ptr(aTHXo)) +#undef PL_warnhook +#define PL_warnhook (*Perl_Iwarnhook_ptr(aTHXo)) +#undef PL_widesyscalls +#define PL_widesyscalls (*Perl_Iwidesyscalls_ptr(aTHXo)) +#undef PL_xiv_arenaroot +#define PL_xiv_arenaroot (*Perl_Ixiv_arenaroot_ptr(aTHXo)) +#undef PL_xiv_root +#define PL_xiv_root (*Perl_Ixiv_root_ptr(aTHXo)) +#undef PL_xnv_root +#define PL_xnv_root (*Perl_Ixnv_root_ptr(aTHXo)) +#undef PL_xpv_root +#define PL_xpv_root (*Perl_Ixpv_root_ptr(aTHXo)) +#undef PL_xpvav_root +#define PL_xpvav_root (*Perl_Ixpvav_root_ptr(aTHXo)) +#undef PL_xpvbm_root +#define PL_xpvbm_root (*Perl_Ixpvbm_root_ptr(aTHXo)) +#undef PL_xpvcv_root +#define PL_xpvcv_root (*Perl_Ixpvcv_root_ptr(aTHXo)) +#undef PL_xpvhv_root +#define PL_xpvhv_root (*Perl_Ixpvhv_root_ptr(aTHXo)) +#undef PL_xpviv_root +#define PL_xpviv_root (*Perl_Ixpviv_root_ptr(aTHXo)) +#undef PL_xpvlv_root +#define PL_xpvlv_root (*Perl_Ixpvlv_root_ptr(aTHXo)) +#undef PL_xpvmg_root +#define PL_xpvmg_root (*Perl_Ixpvmg_root_ptr(aTHXo)) +#undef PL_xpvnv_root +#define PL_xpvnv_root (*Perl_Ixpvnv_root_ptr(aTHXo)) +#undef PL_xrv_root +#define PL_xrv_root (*Perl_Ixrv_root_ptr(aTHXo)) +#undef PL_yychar +#define PL_yychar (*Perl_Iyychar_ptr(aTHXo)) +#undef PL_yydebug +#define PL_yydebug (*Perl_Iyydebug_ptr(aTHXo)) +#undef PL_yyerrflag +#define PL_yyerrflag (*Perl_Iyyerrflag_ptr(aTHXo)) +#undef PL_yylval +#define PL_yylval (*Perl_Iyylval_ptr(aTHXo)) +#undef PL_yynerrs +#define PL_yynerrs (*Perl_Iyynerrs_ptr(aTHXo)) +#undef PL_yyval +#define PL_yyval (*Perl_Iyyval_ptr(aTHXo)) +#undef PL_Sv +#define PL_Sv (*Perl_TSv_ptr(aTHXo)) +#undef PL_Xpv +#define PL_Xpv (*Perl_TXpv_ptr(aTHXo)) +#undef PL_av_fetch_sv +#define PL_av_fetch_sv (*Perl_Tav_fetch_sv_ptr(aTHXo)) +#undef PL_bodytarget +#define PL_bodytarget (*Perl_Tbodytarget_ptr(aTHXo)) +#undef PL_bostr +#define PL_bostr (*Perl_Tbostr_ptr(aTHXo)) +#undef PL_chopset +#define PL_chopset (*Perl_Tchopset_ptr(aTHXo)) +#undef PL_colors +#define PL_colors (*Perl_Tcolors_ptr(aTHXo)) +#undef PL_colorset +#define PL_colorset (*Perl_Tcolorset_ptr(aTHXo)) +#undef PL_curcop +#define PL_curcop (*Perl_Tcurcop_ptr(aTHXo)) +#undef PL_curpad +#define PL_curpad (*Perl_Tcurpad_ptr(aTHXo)) +#undef PL_curpm +#define PL_curpm (*Perl_Tcurpm_ptr(aTHXo)) +#undef PL_curstack +#define PL_curstack (*Perl_Tcurstack_ptr(aTHXo)) +#undef PL_curstackinfo +#define PL_curstackinfo (*Perl_Tcurstackinfo_ptr(aTHXo)) +#undef PL_curstash +#define PL_curstash (*Perl_Tcurstash_ptr(aTHXo)) +#undef PL_defoutgv +#define PL_defoutgv (*Perl_Tdefoutgv_ptr(aTHXo)) +#undef PL_defstash +#define PL_defstash (*Perl_Tdefstash_ptr(aTHXo)) +#undef PL_delaymagic +#define PL_delaymagic (*Perl_Tdelaymagic_ptr(aTHXo)) +#undef PL_dirty +#define PL_dirty (*Perl_Tdirty_ptr(aTHXo)) +#undef PL_dumpindent +#define PL_dumpindent (*Perl_Tdumpindent_ptr(aTHXo)) +#undef PL_efloatbuf +#define PL_efloatbuf (*Perl_Tefloatbuf_ptr(aTHXo)) +#undef PL_efloatsize +#define PL_efloatsize (*Perl_Tefloatsize_ptr(aTHXo)) +#undef PL_errors +#define PL_errors (*Perl_Terrors_ptr(aTHXo)) +#undef PL_extralen +#define PL_extralen (*Perl_Textralen_ptr(aTHXo)) +#undef PL_firstgv +#define PL_firstgv (*Perl_Tfirstgv_ptr(aTHXo)) +#undef PL_formtarget +#define PL_formtarget (*Perl_Tformtarget_ptr(aTHXo)) +#undef PL_hv_fetch_ent_mh +#define PL_hv_fetch_ent_mh (*Perl_Thv_fetch_ent_mh_ptr(aTHXo)) +#undef PL_hv_fetch_sv +#define PL_hv_fetch_sv (*Perl_Thv_fetch_sv_ptr(aTHXo)) +#undef PL_in_eval +#define PL_in_eval (*Perl_Tin_eval_ptr(aTHXo)) +#undef PL_last_in_gv +#define PL_last_in_gv (*Perl_Tlast_in_gv_ptr(aTHXo)) +#undef PL_lastgotoprobe +#define PL_lastgotoprobe (*Perl_Tlastgotoprobe_ptr(aTHXo)) +#undef PL_lastscream +#define PL_lastscream (*Perl_Tlastscream_ptr(aTHXo)) +#undef PL_localizing +#define PL_localizing (*Perl_Tlocalizing_ptr(aTHXo)) +#undef PL_mainstack +#define PL_mainstack (*Perl_Tmainstack_ptr(aTHXo)) +#undef PL_markstack +#define PL_markstack (*Perl_Tmarkstack_ptr(aTHXo)) +#undef PL_markstack_max +#define PL_markstack_max (*Perl_Tmarkstack_max_ptr(aTHXo)) +#undef PL_markstack_ptr +#define PL_markstack_ptr (*Perl_Tmarkstack_ptr_ptr(aTHXo)) +#undef PL_maxscream +#define PL_maxscream (*Perl_Tmaxscream_ptr(aTHXo)) +#undef PL_modcount +#define PL_modcount (*Perl_Tmodcount_ptr(aTHXo)) +#undef PL_na +#define PL_na (*Perl_Tna_ptr(aTHXo)) +#undef PL_nrs +#define PL_nrs (*Perl_Tnrs_ptr(aTHXo)) +#undef PL_ofs +#define PL_ofs (*Perl_Tofs_ptr(aTHXo)) +#undef PL_ofslen +#define PL_ofslen (*Perl_Tofslen_ptr(aTHXo)) +#undef PL_op +#define PL_op (*Perl_Top_ptr(aTHXo)) +#undef PL_opsave +#define PL_opsave (*Perl_Topsave_ptr(aTHXo)) +#undef PL_protect +#define PL_protect (*Perl_Tprotect_ptr(aTHXo)) +#undef PL_reg_call_cc +#define PL_reg_call_cc (*Perl_Treg_call_cc_ptr(aTHXo)) +#undef PL_reg_curpm +#define PL_reg_curpm (*Perl_Treg_curpm_ptr(aTHXo)) +#undef PL_reg_eval_set +#define PL_reg_eval_set (*Perl_Treg_eval_set_ptr(aTHXo)) +#undef PL_reg_flags +#define PL_reg_flags (*Perl_Treg_flags_ptr(aTHXo)) +#undef PL_reg_ganch +#define PL_reg_ganch (*Perl_Treg_ganch_ptr(aTHXo)) +#undef PL_reg_leftiter +#define PL_reg_leftiter (*Perl_Treg_leftiter_ptr(aTHXo)) +#undef PL_reg_magic +#define PL_reg_magic (*Perl_Treg_magic_ptr(aTHXo)) +#undef PL_reg_maxiter +#define PL_reg_maxiter (*Perl_Treg_maxiter_ptr(aTHXo)) +#undef PL_reg_oldcurpm +#define PL_reg_oldcurpm (*Perl_Treg_oldcurpm_ptr(aTHXo)) +#undef PL_reg_oldpos +#define PL_reg_oldpos (*Perl_Treg_oldpos_ptr(aTHXo)) +#undef PL_reg_oldsaved +#define PL_reg_oldsaved (*Perl_Treg_oldsaved_ptr(aTHXo)) +#undef PL_reg_oldsavedlen +#define PL_reg_oldsavedlen (*Perl_Treg_oldsavedlen_ptr(aTHXo)) +#undef PL_reg_poscache +#define PL_reg_poscache (*Perl_Treg_poscache_ptr(aTHXo)) +#undef PL_reg_poscache_size +#define PL_reg_poscache_size (*Perl_Treg_poscache_size_ptr(aTHXo)) +#undef PL_reg_re +#define PL_reg_re (*Perl_Treg_re_ptr(aTHXo)) +#undef PL_reg_start_tmp +#define PL_reg_start_tmp (*Perl_Treg_start_tmp_ptr(aTHXo)) +#undef PL_reg_start_tmpl +#define PL_reg_start_tmpl (*Perl_Treg_start_tmpl_ptr(aTHXo)) +#undef PL_reg_starttry +#define PL_reg_starttry (*Perl_Treg_starttry_ptr(aTHXo)) +#undef PL_reg_sv +#define PL_reg_sv (*Perl_Treg_sv_ptr(aTHXo)) +#undef PL_reg_whilem_seen +#define PL_reg_whilem_seen (*Perl_Treg_whilem_seen_ptr(aTHXo)) +#undef PL_regbol +#define PL_regbol (*Perl_Tregbol_ptr(aTHXo)) +#undef PL_regcc +#define PL_regcc (*Perl_Tregcc_ptr(aTHXo)) +#undef PL_regcode +#define PL_regcode (*Perl_Tregcode_ptr(aTHXo)) +#undef PL_regcomp_parse +#define PL_regcomp_parse (*Perl_Tregcomp_parse_ptr(aTHXo)) +#undef PL_regcomp_rx +#define PL_regcomp_rx (*Perl_Tregcomp_rx_ptr(aTHXo)) +#undef PL_regcompp +#define PL_regcompp (*Perl_Tregcompp_ptr(aTHXo)) +#undef PL_regdata +#define PL_regdata (*Perl_Tregdata_ptr(aTHXo)) +#undef PL_regdummy +#define PL_regdummy (*Perl_Tregdummy_ptr(aTHXo)) +#undef PL_regendp +#define PL_regendp (*Perl_Tregendp_ptr(aTHXo)) +#undef PL_regeol +#define PL_regeol (*Perl_Tregeol_ptr(aTHXo)) +#undef PL_regexecp +#define PL_regexecp (*Perl_Tregexecp_ptr(aTHXo)) +#undef PL_regflags +#define PL_regflags (*Perl_Tregflags_ptr(aTHXo)) +#undef PL_regfree +#define PL_regfree (*Perl_Tregfree_ptr(aTHXo)) +#undef PL_regindent +#define PL_regindent (*Perl_Tregindent_ptr(aTHXo)) +#undef PL_reginput +#define PL_reginput (*Perl_Treginput_ptr(aTHXo)) +#undef PL_regint_start +#define PL_regint_start (*Perl_Tregint_start_ptr(aTHXo)) +#undef PL_regint_string +#define PL_regint_string (*Perl_Tregint_string_ptr(aTHXo)) +#undef PL_reginterp_cnt +#define PL_reginterp_cnt (*Perl_Treginterp_cnt_ptr(aTHXo)) +#undef PL_reglastparen +#define PL_reglastparen (*Perl_Treglastparen_ptr(aTHXo)) +#undef PL_regnarrate +#define PL_regnarrate (*Perl_Tregnarrate_ptr(aTHXo)) +#undef PL_regnaughty +#define PL_regnaughty (*Perl_Tregnaughty_ptr(aTHXo)) +#undef PL_regnpar +#define PL_regnpar (*Perl_Tregnpar_ptr(aTHXo)) +#undef PL_regprecomp +#define PL_regprecomp (*Perl_Tregprecomp_ptr(aTHXo)) +#undef PL_regprev +#define PL_regprev (*Perl_Tregprev_ptr(aTHXo)) +#undef PL_regprogram +#define PL_regprogram (*Perl_Tregprogram_ptr(aTHXo)) +#undef PL_regsawback +#define PL_regsawback (*Perl_Tregsawback_ptr(aTHXo)) +#undef PL_regseen +#define PL_regseen (*Perl_Tregseen_ptr(aTHXo)) +#undef PL_regsize +#define PL_regsize (*Perl_Tregsize_ptr(aTHXo)) +#undef PL_regstartp +#define PL_regstartp (*Perl_Tregstartp_ptr(aTHXo)) +#undef PL_regtill +#define PL_regtill (*Perl_Tregtill_ptr(aTHXo)) +#undef PL_regxend +#define PL_regxend (*Perl_Tregxend_ptr(aTHXo)) +#undef PL_restartop +#define PL_restartop (*Perl_Trestartop_ptr(aTHXo)) +#undef PL_retstack +#define PL_retstack (*Perl_Tretstack_ptr(aTHXo)) +#undef PL_retstack_ix +#define PL_retstack_ix (*Perl_Tretstack_ix_ptr(aTHXo)) +#undef PL_retstack_max +#define PL_retstack_max (*Perl_Tretstack_max_ptr(aTHXo)) +#undef PL_rs +#define PL_rs (*Perl_Trs_ptr(aTHXo)) +#undef PL_savestack +#define PL_savestack (*Perl_Tsavestack_ptr(aTHXo)) +#undef PL_savestack_ix +#define PL_savestack_ix (*Perl_Tsavestack_ix_ptr(aTHXo)) +#undef PL_savestack_max +#define PL_savestack_max (*Perl_Tsavestack_max_ptr(aTHXo)) +#undef PL_scopestack +#define PL_scopestack (*Perl_Tscopestack_ptr(aTHXo)) +#undef PL_scopestack_ix +#define PL_scopestack_ix (*Perl_Tscopestack_ix_ptr(aTHXo)) +#undef PL_scopestack_max +#define PL_scopestack_max (*Perl_Tscopestack_max_ptr(aTHXo)) +#undef PL_screamfirst +#define PL_screamfirst (*Perl_Tscreamfirst_ptr(aTHXo)) +#undef PL_screamnext +#define PL_screamnext (*Perl_Tscreamnext_ptr(aTHXo)) +#undef PL_secondgv +#define PL_secondgv (*Perl_Tsecondgv_ptr(aTHXo)) +#undef PL_seen_evals +#define PL_seen_evals (*Perl_Tseen_evals_ptr(aTHXo)) +#undef PL_seen_zerolen +#define PL_seen_zerolen (*Perl_Tseen_zerolen_ptr(aTHXo)) +#undef PL_sortcop +#define PL_sortcop (*Perl_Tsortcop_ptr(aTHXo)) +#undef PL_sortcxix +#define PL_sortcxix (*Perl_Tsortcxix_ptr(aTHXo)) +#undef PL_sortstash +#define PL_sortstash (*Perl_Tsortstash_ptr(aTHXo)) +#undef PL_stack_base +#define PL_stack_base (*Perl_Tstack_base_ptr(aTHXo)) +#undef PL_stack_max +#define PL_stack_max (*Perl_Tstack_max_ptr(aTHXo)) +#undef PL_stack_sp +#define PL_stack_sp (*Perl_Tstack_sp_ptr(aTHXo)) +#undef PL_start_env +#define PL_start_env (*Perl_Tstart_env_ptr(aTHXo)) +#undef PL_statbuf +#define PL_statbuf (*Perl_Tstatbuf_ptr(aTHXo)) +#undef PL_statcache +#define PL_statcache (*Perl_Tstatcache_ptr(aTHXo)) +#undef PL_statgv +#define PL_statgv (*Perl_Tstatgv_ptr(aTHXo)) +#undef PL_statname +#define PL_statname (*Perl_Tstatname_ptr(aTHXo)) +#undef PL_tainted +#define PL_tainted (*Perl_Ttainted_ptr(aTHXo)) +#undef PL_timesbuf +#define PL_timesbuf (*Perl_Ttimesbuf_ptr(aTHXo)) +#undef PL_tmps_floor +#define PL_tmps_floor (*Perl_Ttmps_floor_ptr(aTHXo)) +#undef PL_tmps_ix +#define PL_tmps_ix (*Perl_Ttmps_ix_ptr(aTHXo)) +#undef PL_tmps_max +#define PL_tmps_max (*Perl_Ttmps_max_ptr(aTHXo)) +#undef PL_tmps_stack +#define PL_tmps_stack (*Perl_Ttmps_stack_ptr(aTHXo)) +#undef PL_top_env +#define PL_top_env (*Perl_Ttop_env_ptr(aTHXo)) +#undef PL_toptarget +#define PL_toptarget (*Perl_Ttoptarget_ptr(aTHXo)) +#undef PL_watchaddr +#define PL_watchaddr (*Perl_Twatchaddr_ptr(aTHXo)) +#undef PL_watchok +#define PL_watchok (*Perl_Twatchok_ptr(aTHXo)) +#undef PL_No +#define PL_No (*Perl_GNo_ptr(NULL)) +#undef PL_Yes +#define PL_Yes (*Perl_GYes_ptr(NULL)) +#undef PL_curinterp +#define PL_curinterp (*Perl_Gcurinterp_ptr(NULL)) +#undef PL_do_undump +#define PL_do_undump (*Perl_Gdo_undump_ptr(NULL)) +#undef PL_hexdigit +#define PL_hexdigit (*Perl_Ghexdigit_ptr(NULL)) +#undef PL_malloc_mutex +#define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL)) +#undef PL_patleave +#define PL_patleave (*Perl_Gpatleave_ptr(NULL)) + +#endif /* !PERL_CORE */ +#endif /* PERL_OBJECT || MULTIPLICITY */ + +#endif /* __perlapi_h__ */ diff --git a/perlvars.h b/perlvars.h index 55769d55ca..220574a2be 100644 --- a/perlvars.h +++ b/perlvars.h @@ -11,11 +11,7 @@ * * 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 *) diff --git a/pod/Win32.pod b/pod/Win32.pod index 08043e83ec..37c5cbd43d 100644 --- a/pod/Win32.pod +++ b/pod/Win32.pod @@ -132,8 +132,8 @@ same value. =item Win32::GetLongPathName(PATHNAME) -[CORE] Returns a representaion of PATHNAME comprised of longname -compnents (if any). The result may not necessarily be longer +[CORE] Returns a representaion of PATHNAME composed of longname +components (if any). The result may not necessarily be longer than PATHNAME. No attempt is made to convert PATHNAME to the absolute path. Compare with Win32::GetShortPathName and Win32::GetFullPathName. @@ -156,7 +156,7 @@ for Windows NT. In scalar context it returns just the ID. =item Win32::GetShortPathName(PATHNAME) -[CORE] Returns a representation of PATHNAME comprised only of +[CORE] Returns a representation of PATHNAME composed only of short (8.3) path components. The result may not necessarily be shorter than PATHNAME. Compare with Win32::GetFullPathName and Win32::GetLongPathName. diff --git a/pod/perl5005delta.pod b/pod/perl5005delta.pod index 335382181d..ca9f185bc5 100644 --- a/pod/perl5005delta.pod +++ b/pod/perl5005delta.pod @@ -27,13 +27,13 @@ Starting with Perl 5.004_50 there were many deep and far-reaching changes 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 @@ -151,7 +151,7 @@ WARNING: Threading is considered an B<experimental> feature. Details of the 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 @@ -496,17 +496,19 @@ the command-line arguments used in F<config.sh>. =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 @@ -514,7 +516,8 @@ Win32 support has been vastly enhanced. Support for Perl Object, a C++ 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. diff --git a/pod/perldata.pod b/pod/perldata.pod index 0b83214a73..a122d34c80 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -600,16 +600,16 @@ of how to arrange for an output ordering. =head2 Slices -A common way access an array or a hash is one scalar element at a time. -You can also subscript a list to get a single element from it. +A common way to access an array or a hash is one scalar element at a +time. You can also subscript a list to get a single element from it. $whoami = $ENV{"USER"}; # one element from the hash $parent = $ISA[0]; # one element from the array $dir = (getpwnam("daemon"))[7]; # likewise, but with list A slice accesses several elements of a list, an array, or a hash -simultaneously using a list of subscripts. It's a more convenient -that writing out the individual elements as a list of separate +simultaneously using a list of subscripts. It's more convenient +than writing out the individual elements as a list of separate scalar values. ($him, $her) = @folks[0,-1]; # array slice @@ -633,8 +633,8 @@ The previous assignments are exactly equivalent to ($folks[0], $folks[-1]) = ($folks[0], $folks[-1]); Since changing a slice changes the original array or hash that it's -slicing, a C<foreach> construct will alter through some--or even -all--of the values of the array or hash. +slicing, a C<foreach> construct will alter some--or even all--of the +values of the array or hash. foreach (@array[ 4 .. 10 ]) { s/peter/paul/ } @@ -644,15 +644,16 @@ all--of the values of the array or hash. s/(\w+)/\u\L$1/g; # "titlecase" words } -You couldn't just loop through C<values %hash> to do this because -that function produces a new list which is a copy of the values, -so changing them doesn't change the original. - A slice of an empty list is still an empty list. Thus: @a = ()[1,0]; # @a has no elements @b = (@a)[0,1]; # @b has no elements - @b = (1,undef)[1,0,1]; # @b has three elements + @c = (0,1)[2,3]; # @c has no elements + +But: + + @a = (1)[1,0]; # @a has two elements + @b = (1,undef)[1,0,2]; # @b has three elements This makes it easy to write loops that terminate when a null list is returned: diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 33ab171746..9f24e12418 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -57,6 +57,45 @@ cases remains unchanged: See L<perldata>. +=head2 Perl's version numbering has changed + +Beginning with Perl version 5.6, the version number convention has been +changed to a "dotted integer" scheme that is more commonly found in open +source projects. + +Maintenance versions of v5.6.0 will be released as v5.6.1, v5.6.2 etc. +The next development series following v5.6 will be numbered v5.7.x, +beginning with v5.7.0, and the next major production release following +v5.6 will be v5.8. + +The English module now sets $PERL_VERSION to $^V (a string value) rather +than C<$]> (a numeric value). (This is a potential incompatibility. +Send us a report via perlbug if you are affected by this.) + +The v1.2.3 syntax is also now legal in Perl. +See L<Support for strings represented as a vector of ordinals> for more on that. + +To cope with the new versioning system's use of at least three significant +digits for each version component, the method used for incrementing the +subversion number has also changed slightly. We assume that versions older +than v5.6 have been incrementing the subversion component in multiples of +10. Versions after v5.6.0 will increment them by 1. Thus, using the new +notation, 5.005_03 is the same as v5.5.30, and the first maintenance +version following v5.6.0 will be v5.6.1, which amounts to a floating point +value of 5.006_001). + +=item Literals of the form C<1.2.3> parse differently + +Previously, numeric literals with more than one dot in them were +interpreted as a floating point number concatenated with one or more +numbers. Such "numbers" are now parsed as strings composed of the +specified ordinals. + +For example, C<print 97.98.99> used to output C<97.9899> in earlier +versions, but now prints C<abc>. + +See L<Support for strings represented as a vector of ordinals> below. + =item Possibly changed pseudo-random number generator In 5.005_0x and earlier, perl's rand() function used the C library @@ -81,13 +120,15 @@ Using the C<undef> operator on a readonly value (such as $1) has the same effect as assigning C<undef> to the readonly value--it throws an exception. -=item Close-on-exec bit may be set on pipe() handles +=item Close-on-exec bit may be set on pipe and socket handles On systems that support a close-on-exec flag on filehandles, the -flag will be set for any handles created by pipe(), if that is -warranted by the value of $^F that may be in effect. Earlier -versions neglected to set the flag for handles created with -pipe(). See L<perlfunc/pipe> and L<perlvar/$^F>. +flag will be set for any handles created by pipe(), socketpair(), +socket(), and accept(), if that is warranted by the value of $^F +that may be in effect. Earlier versions neglected to set the flag +for handles created with these operators. See L<perlfunc/pipe>, +L<perlfunc/socketpair>, L<perlfunc/socket>, L<perlfunc/accept>, +and L<perlvar/$^F>. =item Writing C<"$$1"> to mean C<"${$}1"> is unsupported @@ -284,29 +325,6 @@ create new threads from Perl (i.e., C<use Thread;> will not work with interpreter threads). C<use Thread;> continues to be available when you ask for -Duse5005threads, bugs and all. -=head2 Perl's version numbering has changed - -Beginning with Perl version 5.6, the version number convention has been -changed to a "dotted tuple" scheme that is more commonly found in open -source projects. - -Maintenance versions of v5.6.0 will be released as v5.6.1, v5.6.2 etc. -The next development series following v5.6 will be numbered v5.7.x, -beginning with v5.7.0, and the next major production release following -v5.6 will be v5.8. - -The v1.2.3 syntax is also now legal in Perl. See L<Support for version tuples> -for more on that. - -To cope with the new versioning system's use of at least three significant -digits for each version component, the method used for incrementing the -subversion number has also changed slightly. We assume that versions older -than v5.6 have been incrementing the subversion component in multiples of -10. Versions after v5.6 will increment them by 1. Thus, using the new -notation, 5.005_03 is the same as v5.5.30, and the first maintenance -version following v5.6 will be v5.6.1, which amounts to a floating point -value of 5.006_001). - =head2 New Configure flags The following new flags may be enabled on the Configure command line @@ -315,18 +333,24 @@ by running Configure with C<-Dflag>. usemultiplicity use5005threads + use64bitint (equal to now deprecated 'use64bits') + use64bitall + uselongdouble usemorebits uselargefiles + usesocks (only SOCKS v5 supported) -=head2 -Dusethreads and -Duse64bits now more daring +=head2 Threadedness and 64-bitness now more daring The Configure options enabling the use of threads and the use of -64-bitness are now more daring in the sense that they no more have -an explicit list of operating systems of known threads/64-bit +64-bitness are now more daring in the sense that they no more have an +explicit list of operating systems of known threads/64-bit capabilities. In other words: if your operating system has the -necessary APIs, you should be able just to go ahead and use them. -See also L<"64-bit support">. +necessary APIs and datatypes, you should be able just to go ahead and +use them, for threads by Configure -Dusethreads, and for 64 bits +either explicitly by Configure -Duse64bitint or implicitly if your +system has 64 bit wide datatypes. See also L<"64-bit support">. =head2 Long Doubles @@ -336,7 +360,7 @@ Perl's scalars, use -Duselongdouble. =head2 -Dusemorebits -You can enable both -Duse64bits and -Dlongdouble by -Dusemorebits. +You can enable both -Duse64bitint and -Dlongdouble by -Dusemorebits. See also L<"64-bit support">. =head2 -Duselargefiles @@ -366,20 +390,28 @@ process starts. Run C<Configure -h> to find out the full C<-A> syntax. =head2 Enhanced Installation Directories -The installation structure has been enriched to improve the support for -maintaining multiple versions of perl, to provide locations for -vendor-supplied modules and scripts, and to ease maintenance of -locally-added modules and scripts. See the section on Installation -Directories in the INSTALL file for complete details. For most users -building and installing from source, the defaults should be fine. +The installation structure has been enriched to improve the support +for maintaining multiple versions of perl, to provide locations for +vendor-supplied modules, scripts, and manpages, and to ease maintenance +of locally-added modules, scripts, and manpages. See the section on +Installation Directories in the INSTALL file for complete details. +For most users building and installing from source, the defaults should +be fine. + +If you previously used C<Configure -Dsitelib> or C<-Dsitearch> to set +special values for library directories, you might wish to consider using +the new C<-Dsiteprefix> setting instead. Also, if you wish to re-use a +config.sh file from an earlier version of perl, you should be sure to +check that Configure makes sensible choices for the new directories. +See INSTALL for complete details. =head1 Core Changes =head2 Unicode and UTF-8 support Perl can optionally use UTF-8 as its internal representation for character -strings. The C<utf8> and C<byte> pragmas are used to control this support -in the current lexical scope. See L<perlunicode>, L<utf8> and L<byte> for +strings. The C<utf8> and C<bytes> pragmas are used to control this support +in the current lexical scope. See L<perlunicode>, L<utf8> and L<bytes> for more information. =head2 Interpreter cloning, threads, and concurrency @@ -451,36 +483,49 @@ mostly useful as an alternative to the C<vars> pragma, but also provides the opportunity to introduce typing and other attributes for such variables. See L<perlfunc/our>. -=head2 Support for version tuples +=head2 Support for strings represented as a vector of ordinals -Literals of the form v1.2.3.4 are now parsed as the utf8 string -C<"\x{1}\x{2}\x{3}\x{4}">. This allows comparing version numbers using -regular string comparison operators C<eq>, C<ne>, C<lt>, C<gt> etc. +Literals of the form C<v1.2.3.4> are now parsed as a string composed of +of characters with the specified ordinals. This is an alternative, more +readable way to construct (possibly unicode) strings instead of +interpolating characters, as in C<"\x{1}\x{2}\x{3}\x{4}">. The leading +C<v> may be omitted if there are more than two ordinals, so C<1.2.3> is +parsed the same as C<v1.2.3>. -These "dotted tuples" are dual-valued. They are both strings of utf8 -characters, and floating point numbers. Thus v1.2.3.4 has the string -value C<"\x{1}\x{2}\x{3}\x{4}"> and the numeric value 1.002_003_004. -As another example, v5.5.640 has the string value C<"\x{5}\x{5}\x{280}"> -(remember 280 hexadecimal is 640 decimal) and the numeric value -5.005_64. +Strings written in this form are also useful to represent version "numbers". +It is easy to compare such version "numbers" (which are really just plain +strings) using any of the usual string comparison operators C<eq>, C<ne>, +C<lt>, C<gt>, etc., or perform bitwise string operations on them using C<|>, +C<&>, etc. In conjunction with the new C<$^V> magic variable (which contains -the perl version in this format), such literals can be used to -check if you're running a particular version of Perl. +the perl version as a string), such literals can be used as a readable way +to check if you're running a particular version of Perl: + # this will parse in older versions of Perl also if ($^V and $^V gt v5.5.640) { - # new style version numbers are supported + # new features supported } -C<require> and C<use> also support such literals: +C<require> and C<use> also have some special magic to support such literals. +They will be interpreted as a version rather than as a module name: - require v5.6.0; # croak if $^V lt v5.6.0 - use v5.6.0; # same, but croaks at compile-time + require v5.6.0; # croak if $^V lt v5.6.0 + use v5.6.0; # same, but croaks at compile-time -C<sprintf> and C<printf> support the Perl-specific format type C<%v> -to print arbitrary strings as dotted tuples. +Alternatively, the C<v> may be omitted if there is more than one dot: - printf "v%v", $^V; # prints current version, such as "v5.5.650" + require 5.6.0; + use 5.6.0; + +Also, C<sprintf> and C<printf> support the Perl-specific format flag C<%v> +to print ordinals of characters in arbitrary strings: + + printf "v%vd", $^V; # prints current version, such as "v5.5.650" + printf "%*vX", ":", $addr; # formats IPv6 address + printf "%*vb", " ", $bits; # displays bitstring + +See L<perlop/"Strings of Character"> for additional information. =head2 Weak references @@ -530,10 +575,10 @@ C<oct()>: Perl now allows the arrow to be omitted in many constructs involving subroutine calls through references. For example, -C<$foo[10]->('foo')> may now be written C<$foo[10]('foo')>. +C<$foo[10]-E<gt>('foo')> may now be written C<$foo[10]('foo')>. This is rather similar to how the arrow may be omitted from -C<$foo[10]->{'foo'}>. Note however, that the arrow is still -required for C<foo(10)->('bar')>. +C<$foo[10]-E<gt>{'foo'}>. Note however, that the arrow is still +required for C<foo(10)-E<gt>('bar')>. =head2 exists() is supported on subroutine names @@ -547,15 +592,17 @@ The exists() and delete() builtins now work on simple arrays as well. The behavior is similar to that on hash elements. exists() can be used to check whether an array element has been -initialized without autovivifying it. If the array is tied, the -EXISTS() method in the corresponding tied package will be invoked. +initialized. This avoids autovivifying array elements that don't exist. +If the array is tied, the EXISTS() method in the corresponding tied +package will be invoked. delete() may be used to remove an element from the array and return it. The array element at that position returns to its unintialized state, so that testing for the same element with exists() will return false. If the element happens to be the one at the end, the size of -the array also shrinks by one. If the array is tied, the DELETE() method -in the corresponding tied package will be invoked. +the array also shrinks up to the highest element that tests true for +exists(), or 0 if none such is found. If the array is tied, the DELETE() +method in the corresponding tied package will be invoked. See L<perlfunc/exists> and L<perlfunc/delete> for examples. @@ -565,7 +612,7 @@ The length argument of C<syswrite()> has become optional. =head2 File and directory handles can be autovivified -Similar to how constructs such as C<$x->[0]> autovivify a reference, +Similar to how constructs such as C<$x-E<gt>[0]> autovivify a reference, handle constructors (open(), opendir(), pipe(), socketpair(), sysopen(), socket(), and accept()) now autovivify a file or directory handle if the handle passed to them is an uninitialized scalar variable. This @@ -591,8 +638,11 @@ filehandles that must be passed around, as in the following example: =head2 64-bit support -All platforms that have 64-bit integers either (a) natively as longs -or ints (b) via special compiler flags (c) using long long are able to + NOTE: The Configure flags -Duselonglong and -Duse64bits + have been deprecated. Use -Duse64bitint instead. + +Any platform that has 64-bit integers either (a) natively as longs or +ints (b) via special compiler flags (c) using long long are able to use "quads" (64-integers) as follows: =over 4 @@ -628,11 +678,30 @@ vec() (but see the below note about bit arithmetics) =back Note that unless you have the case (a) you will have to configure -and compile Perl using the -Duse64bits Configure flag. +and compile Perl using the -Duse64bitint Configure flag. Unfortunately bit arithmetics (&, |, ^, ~, <<, >>) for numbers are not -64-bit clean, they are explictly forced to be 32-bit. Bit arithmetics -for bit vectors (created by vec()) are not limited in their width. +64-bit clean, they are explictly forced to be 32-bit because of +tangled backward compatibility issues. This limitation is subject to +change. Bit arithmetics for bit vector scalars (created by vec()) are +not limited in their width, you can use the & | ^ ~ operators on such +scalars. + +There are actually two modes of 64-bitness: the first one is achieved +using Configure -Duse64bitint and the second one using Configure +-Duse64bitall. The difference is that the first one is minimal and +the second one maximal. The first one does only as much as is +required to get 64-bit integers into Perl (this may mean, for example, +using "long longs") while your memory may still be limited to 2 +gigabytes (because your pointers most likely are 32-bit); the second +one goes all the way by attempting to switch also longs (and pointers) +being 64-bit. This may create an even more binary incompatible Perl +than -Duse64bitint: the resulting executable may not run at all in a +CPU-bit box, or you may have to reboot/reconfigure/rebuild your +operating system to be 64-bit aware. + +Natively 64-bit systems like Alpha and Cray need neither -Duse64bitint +nor -Duse64bitall. Last but not least: note that due to Perl's habit of always using floating point numbers the quads are still not true integers. @@ -842,9 +911,12 @@ only during normal running are warranted. See L<perlvar>. =head2 New variable $^V contains Perl version in v5.6.0 format -C<$^V> contains the Perl version number as a version tuple that -can be used in string or numeric comparisons. See -C<Support for version tuples> for an example. +C<$^V> contains the Perl version number as a string composed of +characters whose ordinals match the version numbers, so that it may +be used in string comparisons. + +See C<Support for strings represented as a vector of ordinals> for an +example. =head2 Optional Y2K warnings @@ -853,7 +925,7 @@ it emits optional warnings when concatenating the number 19 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 @@ -960,7 +1032,7 @@ array element in that slot. =head2 Pseudo-hashes work better Dereferencing some types of reference values in a pseudo-hash, -such as C<$ph->{foo}[1]>, was accidentally disallowed. This has +such as C<$ph-E<gt>{foo}[1]>, was accidentally disallowed. This has been corrected. When applied to a pseudo-hash element, exists() now reports whether @@ -1379,6 +1451,11 @@ For other details, see L<Benchmark>. The Devel::Peek module provides access to the internal representation of Perl variables and data. It is a data debugging tool for the XS programmer. +=item English + +$PERL_VERSION now stands for C<$^V> (a string value) rather than for C<$]> +(a numeric value). + =item ExtUtils::MakeMaker change#4135, also needs docs in module pod @@ -1391,8 +1468,11 @@ large file (more than 4GB) access Note that the O_LARGEFILE is automatically/transparently added to sysopen() flags if large file support has been configured), Free/Net/OpenBSD locking behaviour flags F_FLOCK, F_POSIX, Linux F_SHLCK, and O_ACCMODE: the combined mask of -O_RDONLY, O_WRONLY, and O_RDWR. Also SEEK_SET, SEEK_CUR, and SEEK_END -added for one-stop shopping of the seek/sysseek constants. +O_RDONLY, O_WRONLY, and O_RDWR. The seek()/sysseek() constants +SEEK_SET, SEEK_CUR, and SEEK_END are available via the C<:seek> tag. +The chmod()/stat() S_IF* constants and S_IS* functions are available +via the C<:mode> tag. + =item File::Compare @@ -1621,6 +1701,11 @@ fixed. Sys::Syslog now uses XSUBs to access facilities from syslog.h so it no longer requires syslog.ph to exist. +=item Sys::Hostname + +Sys::Hostname now uses XSUBs to call the C library's gethostname() or +uname() if they exist. + =item Time::Local The timelocal() and timegm() functions used to silently return bogus @@ -1892,6 +1977,22 @@ most likely an unexpected right brace '}'. malloc()ed in the first place. Mandatory, but can be disabled by setting environment variable C<PERL_BADFREE> to 1. +=item Bareword found in conditional + +(W) 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: + + open FOO || die; + +It may also indicate a misspelled constant that has been interpreted +as a bareword: + + use constant TYPO => 1; + if (TYOP) { print "foo" } + +The C<strict> pragma is useful in avoiding such errors. + =item Binary number > 0b11111111111111111111111111111111 non-portable (W) The binary number you specified is larger than 2**32-1 @@ -2209,7 +2310,7 @@ when you meant my ($foo, $bar) = @_; -Remember that "my", "our" and "local" bind closer than comma. +Remember that "my", "our", and "local" bind tighter than comma. =item Possible Y2K bug: %s @@ -2351,6 +2452,14 @@ appear in %ENV. This may be a benign occurrence, as some software packages might directly modify logical name tables and introduce nonstandard names, or it may indicate that a logical name table has been corrupted. +=item Probable precedence problem on %s + +(W) 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: + + open FOO || die; + =item regexp too big (F) The current implementation of regular expressions uses shorts as diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 39112035fb..05e57c0761 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -9,15 +9,26 @@ desperation): (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 @@ -33,7 +44,7 @@ C<"%(-?@> sort before the letters, while C<[> and C<\> sort after. =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 @@ -57,7 +68,7 @@ no useful value. See L<perlmod>. =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 @@ -113,31 +124,31 @@ your signed integers. See L<perlfunc/unpack>. =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 @@ -194,17 +205,17 @@ Further error messages would likely be uninformative. =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>. @@ -239,7 +250,7 @@ into Perl yourself. =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 @@ -292,7 +303,7 @@ C<require 'file'>. =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 @@ -301,7 +312,7 @@ the return value of your socket() call? See L<perlfunc/accept>. =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 @@ -314,13 +325,13 @@ L<perlfunc/grep> and L<perlfunc/map> for alternatives. =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. @@ -344,13 +355,13 @@ for example, turn C<-w -U> into C<-wU>. =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 @@ -369,20 +380,20 @@ know which context to supply to the right side. =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 @@ -390,11 +401,11 @@ it. =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 @@ -409,7 +420,7 @@ need to move the join() to some other thread. =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 @@ -418,7 +429,7 @@ avoid this warning. =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>. @@ -437,7 +448,7 @@ did it in another package. =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. @@ -472,7 +483,7 @@ is not the same as =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. @@ -505,10 +516,26 @@ Perhaps you need to predeclare a subroutine? =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 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: + + open FOO || die; + +It may also indicate a misspelled constant that has been interpreted +as a bareword: + + use constant TYPO => 1; + if (TYOP) { print "foo" } + +The C<strict> pragma is useful in avoiding such errors. + =item BEGIN failed--compilation aborted (F) An untrapped exception was raised while executing a BEGIN subroutine. @@ -524,18 +551,18 @@ likely depends on its correct operation, Perl just gave up. =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 @@ -543,7 +570,7 @@ the return value of your socket() call? See L<perlfunc/bind>. =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. @@ -606,7 +633,7 @@ encapsulation of objects. See L<perlobj>. =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. @@ -702,7 +729,7 @@ for other types of variables in future. =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 @@ -712,13 +739,13 @@ such. =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! @@ -756,7 +783,7 @@ For example, it'd be kind of silly to put a B<-x> on the #! line. =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 @@ -847,7 +874,7 @@ L<perlfunc/goto>. =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. @@ -900,7 +927,7 @@ method, nor does any of its base classes. See L<perlobj>. =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 @@ -929,7 +956,7 @@ buffer. =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 @@ -937,7 +964,7 @@ on the command line. =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. @@ -977,13 +1004,13 @@ this, you should write C<sort { &func } @x> instead of C<sort func @x>. =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 @@ -1086,7 +1113,7 @@ test the type of the reference, if need be. =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 @@ -1150,7 +1177,7 @@ See L<perlre>. =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 @@ -1158,7 +1185,7 @@ future extensions. =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 @@ -1166,15 +1193,15 @@ backslash: "\[." and ".\]". =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 @@ -1183,7 +1210,7 @@ to 01411. Octal constants are introduced with a leading 0 in Perl, as in C. =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 @@ -1193,7 +1220,7 @@ were severe enough to halt compilation immediately. =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 @@ -1205,7 +1232,7 @@ for information on I<Mastering Regular Expressions>.) =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 @@ -1218,13 +1245,13 @@ See L<perlsub/"Constant Functions"> and L<constant>. =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. @@ -1258,20 +1285,20 @@ a valid magic number. =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. @@ -1291,7 +1318,7 @@ See Server error. =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 %? @@ -1330,7 +1357,7 @@ See Server error. =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 @@ -1393,35 +1420,40 @@ variable and glob that. =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>. @@ -1440,13 +1472,13 @@ PDP-11 or something? =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 @@ -1454,7 +1486,7 @@ L<perlfunc/open>. =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 @@ -1476,13 +1508,13 @@ the name. =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; @@ -1496,7 +1528,7 @@ to the end of your file without finding such a line. =item Found = in conditional, should be == -(W) You said +(W syntax) You said if ($foo = 123) @@ -1518,7 +1550,7 @@ on the Internet. =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" @@ -1526,6 +1558,20 @@ Did you forget to check the return value of your socket() call? (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 @@ -1547,18 +1593,18 @@ unspecified destination. See L<perlfunc/goto>. =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. @@ -1571,13 +1617,13 @@ versions of Perl are likely to eliminate these arbitrary limitations. =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. @@ -1610,17 +1656,17 @@ don't take to this kindly. =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. @@ -1670,7 +1716,7 @@ known value, using trustworthy data. See L<perlsec>. =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 @@ -1694,20 +1740,6 @@ and execute the specified command. (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. @@ -1729,7 +1761,7 @@ greater than the maximum character. See L<perlre>. =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 @@ -1742,13 +1774,13 @@ too soon. See L<attributes>. =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 @@ -1785,7 +1817,7 @@ effective uids or gids failed. =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 @@ -1811,7 +1843,7 @@ ended earlier on the current line. =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 @@ -1831,7 +1863,7 @@ double-quotish context. =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? @@ -1877,7 +1909,7 @@ be created for some peculiar reason. =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" @@ -1887,7 +1919,7 @@ have a name with which they can be found. =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. @@ -2042,7 +2074,7 @@ an attempt to close an unopened filehandle. =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 @@ -2114,7 +2146,7 @@ function to find out what kind of ref it really was. See L<perlref>. =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 @@ -2130,7 +2162,7 @@ supplied it an uninitialized value. See L<perlform>. =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 @@ -2153,7 +2185,7 @@ try using scientific notation (e.g. "1e6" instead of "1_000_000"). =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. @@ -2167,7 +2199,7 @@ version. =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 @@ -2179,11 +2211,11 @@ will extend the buffer and zero pad the new area. =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 @@ -2195,7 +2227,7 @@ true. See L<overload>. =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 @@ -2238,7 +2270,7 @@ instead of C<$arr[$time]>. =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 @@ -2405,7 +2437,7 @@ was string. =item Parentheses missing around "%s" list -(W) You said something like +(W parenthesis) You said something like my $foo, $bar = @_; @@ -2413,7 +2445,7 @@ when you meant my ($foo, $bar) = @_; -Remember that "my", "our" and "local" bind closer than comma. +Remember that "my", "our", and "local" bind tighter than comma. =item Perl %3.3f required--this is only version %s, stopped @@ -2427,7 +2459,7 @@ anyway? See L<perlfunc/require>. =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. @@ -2438,12 +2470,12 @@ the BSD version, which takes a pid. =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.) @@ -2472,7 +2504,7 @@ old-fashioned way, with quotes and commas: =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.) @@ -2495,7 +2527,7 @@ Perl assumes that memory is now corrupted. See L<perlfunc/ioctl>. =item Precedence problem: open %s should be open(%s) -(S) The old irregular construct +(S precedence) The old irregular construct open FOO || die; @@ -2514,25 +2546,17 @@ See Server error. =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 Probable precedence problem on %s - -(W) 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: - - open FOO || die; - =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 @@ -2544,12 +2568,12 @@ increment by prepending "0" to your numbers. =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 @@ -2558,7 +2582,7 @@ been freed. =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. @@ -2574,7 +2598,7 @@ method. Probably indicates an unintended loop in your inheritance hierarchy. =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>. @@ -2586,12 +2610,12 @@ 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 @@ -2610,7 +2634,7 @@ expression compiler gave it. =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 @@ -2623,7 +2647,7 @@ shifting or popping (for array variables). See L<perlform>. =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 @@ -2637,7 +2661,7 @@ L<perlref>. =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 @@ -2662,7 +2686,7 @@ Missing the leading C<$> from a variable C<$m> may cause this error. =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 @@ -2675,17 +2699,17 @@ was either never opened or has since been closed. =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 @@ -2774,11 +2798,11 @@ because the world might have written on it already. =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 @@ -2805,12 +2829,12 @@ See L<perlfunc/split>. =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 @@ -2818,7 +2842,7 @@ by itself. =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 @@ -2832,7 +2856,7 @@ may break this. =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; @@ -2860,10 +2884,10 @@ Missing the leading C<$> from variable C<$s> may cause this error. =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 @@ -2912,7 +2936,7 @@ unconfigured. Consult your system support. =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 @@ -2922,12 +2946,12 @@ nested for Perl to reach. Perl is doing you a favor by refusing. =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 @@ -2968,7 +2992,7 @@ the symlink to get to the real file. Use an actual filename instead. =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 @@ -3053,7 +3077,7 @@ certain type. Arrays must be @NAME or C<@{EXPR}>. Hashes must be =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 @@ -3067,22 +3091,22 @@ to use it to restrict permissions for yourself (EXPR & 0700). =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 @@ -3117,7 +3141,7 @@ another package? See L<perlform>. =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! @@ -3163,7 +3187,7 @@ See L<perlre>. =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. @@ -3175,7 +3199,7 @@ script, a binary program, or a directory as a Perl program. =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" @@ -3191,7 +3215,7 @@ supplying the bad switch on your behalf.) =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>. @@ -3240,12 +3264,12 @@ too soon. See L<attributes>. =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<$*>. @@ -3257,18 +3281,18 @@ only C. This usually means there's a better way to do it in Perl. =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()>). @@ -3290,7 +3314,7 @@ C<use AutoLoader 'AUTOLOAD';>. =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 @@ -3299,13 +3323,13 @@ e.g. C<&our()>, or C<Foo::our()>. =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. @@ -3315,7 +3339,7 @@ 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 @@ -3346,12 +3370,12 @@ L<perlref> for more on this. =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 @@ -3359,7 +3383,7 @@ expressions, test their values with the C<defined> operator. =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. @@ -3374,7 +3398,7 @@ on the front of your variable. =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: @@ -3396,7 +3420,7 @@ subroutine in between interferes with this feature. =item Variable "%s" will not stay shared -(W) An inner (nested) I<named> subroutine is referencing a lexical +(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 @@ -3461,7 +3485,7 @@ close(). This usually indicates your file system ran out of disk space. =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 @@ -3480,7 +3504,7 @@ So put in parentheses to say what you really mean. =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 @@ -3516,20 +3540,20 @@ the eg directory to put a setuid C wrapper around your script. =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 diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index 3b0a79ffee..51ab6a1e50 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -393,32 +393,29 @@ on them, as do the O'Reilly Perl Resource Kits (in both the Unix flavor and in the proprietary Microsoft flavor); the free Unix distributions also all come with Perl. -Or you can purchase a real support contract. Although Cygnus historically -provided this service, they no longer sell support contracts for Perl. -Instead, the Paul Ingram Group will be taking up the slack through The -Perl Clinic. The following is a commercial from them: - -"Do you need professional support for Perl and/or Oraperl? Do you need -a support contract with defined levels of service? Do you want to pay -only for what you need? - -"The Paul Ingram Group has provided quality software development and -support services to some of the world's largest corporations for ten -years. We are now offering the same quality support services for Perl -at The Perl Clinic. This service is led by Tim Bunce, an active perl -porter since 1994 and well known as the author and maintainer of the -DBI, DBD::Oracle, and Oraperl modules and author/co-maintainer of The -Perl 5 Module List. We also offer Oracle users support for Perl5 -Oraperl and related modules (which Oracle is planning to ship as part -of Oracle Web Server 3). 20% of the profit from our Perl support work -will be donated to The Perl Institute." - -For more information, contact The Perl Clinic: - - Tel: +44 1483 424424 - Fax: +44 1483 419419 - Web: http://www.perl.co.uk/ - Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk +Or you can purchase commercial incidence based support through the Perl +Clinic. The following is a commercial from them: + +"The Perl Clinic is a commercial Perl support service operated by +ActiveState Tool Corp. and The Ingram Group. The operators have many +years of in-depth experience with Perl applications and Perl internals +on a wide range of platforms. + +"Through our group of highly experienced and well-trained support engineers, +we will put our best effort into understanding your problem, providing an +explanation of the situation, and a recommendation on how to proceed." + +Contact The Perl Clinic at: + + www.PerlClinic.com + + North America Pacific Standard Time (GMT-8) + Tel: 1 604 606-4611 hours 8am-6pm + Fax: 1 604 606-4640 + + Europe (GMT) + Tel: 00 44 1483 862814 + Fax: 00 44 1483 862801 See also www.perl.com for updates on tutorials, training, and support. diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index 7fc0cdc3c1..c30ff20479 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -77,7 +77,7 @@ stamp prepended. =head2 How do I remove HTML from a string? The most correct way (albeit not the fastest) is to use HTML::Parser -from CPAN (part of the HTML-Tree package on CPAN). Another correct +from CPAN. Another mostly correct way is to use HTML::FormatText which not only removes HTML but also attempts to do a little simple formatting of the resulting plain text. @@ -219,7 +219,7 @@ all the non-alphanumunder character (C<\W>) into their hex escapes. It's important that characters with special meaning like C</> and C<?> I<not> be translated. Probably the easiest way to get this right is to avoid reinventing the wheel and just use the URI::Escape module, -which is part of the libwww-perl package (LWP) available from CPAN. +available from CPAN. =head2 How do I redirect to another page? diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 88cbb0a6e5..f9b4a6bac3 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -376,6 +376,10 @@ Accepts an incoming socket connect, just as the accept(2) system call does. Returns the packed address if it succeeded, false otherwise. See the example in L<perlipc/"Sockets: Client/Server Communication">. +On systems that support a close-on-exec flag on files, the flag will +be set for the newly opened file descriptor, as determined by the +value of $^F. See L<perlvar/$^F>. + =item alarm SECONDS =item alarm @@ -423,7 +427,7 @@ modulo the caveats given in L<perlipc/"Signals">. Returns the arctangent of Y/X in the range -PI to PI. -For the tangent operation, you may use the C<POSIX::tan()> +For the tangent operation, you may use the C<Math::Trig::tan> function, or use the familiar relation: sub tan { sin($_[0]) / cos($_[0]) } @@ -513,7 +517,7 @@ print a stack trace. The value of EXPR indicates how many call frames 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 @@ -522,9 +526,9 @@ C<require> or C<use> statement, $evaltext contains the text of the 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 @@ -559,6 +563,14 @@ successfully changed. See also L</oct>, if all you have is a string. $mode = '0644'; chmod oct($mode), 'foo'; # this is better $mode = 0644; chmod $mode, 'foo'; # this is best +You can also import the symbolic C<S_I*> constants from the Fcntl +module: + + use Fcntl ':mode'; + + chmod S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, @executables; + # This is identical to the chmod 0755 of the above example. + =item chomp VARIABLE =item chomp LIST @@ -766,7 +778,7 @@ to check the condition at the top of the loop. Returns the cosine of EXPR (expressed in radians). If EXPR is omitted, takes cosine of C<$_>. -For the inverse cosine operation, you may use the C<POSIX::acos()> +For the inverse cosine operation, you may use the C<Math::Trig::acos()> function, or use this relation: sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) } @@ -929,8 +941,9 @@ See also L</undef>, L</exists>, L</ref>. Given an expression that specifies a hash element, array element, hash slice, or array slice, deletes the specified element(s) from the hash or array. -If the array elements happen to be at the end of the array, the size -of the array will shrink by that number of elements. +In the case of an array, if the array elements happen to be at the end, +the size of the array will shrink to the highest element that tests +true for exists() (or 0 if no such element exists). Returns each element so deleted or the undefined value if there was no such element. Deleting from C<$ENV{}> modifies the environment. Deleting from @@ -939,7 +952,9 @@ from a C<tie>d hash or array may not necessarily return anything. Deleting an array element effectively returns that position of the array to its initial, uninitialized state. Subsequently testing for the same -element with exists() will return false. See L</exists>. +element with exists() will return false. Note that deleting array +elements in the middle of an array will not shift the index of the ones +after them down--use splice() for that. See L</exists>. The following (inefficiently) deletes all the values of %HASH and @ARRAY: @@ -1153,9 +1168,7 @@ make your program I<appear> to run faster. When called in list context, returns a 2-element list consisting of the key and value for the next element of a hash, so that you can iterate over it. When called in scalar context, returns the key for only the "next" -element in the hash. (Note: Keys may be C<"0"> or C<"">, which are logically -false; you may wish to avoid constructs like C<while ($k = each %foo) {}> -for this reason.) +element in the hash. Entries are returned in an apparently random order. The actual random order is subject to change in future versions of perl, but it is guaranteed @@ -2316,7 +2329,7 @@ This scalar value is B<not> locale dependent, see L<perllocale>, but instead a Perl builtin. Also see the C<Time::Local> module (to convert the second, minutes, hours, ... back to seconds since the stroke of midnight the 1st of January 1970, the value returned by -time()), and the strftime(3) and mktime(3) function available via the +time()), and the strftime(3) and mktime(3) functions available via the POSIX module. To get somewhat similar but locale dependent date strings, set up your locale environment variables appropriately (please see L<perllocale>) and try for example: @@ -2404,9 +2417,12 @@ the original list for which the BLOCK or EXPR evaluates to true. =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 @@ -3533,9 +3549,18 @@ rename(2) manpage or equivalent system documentation for details. =item require Demands some semantics specified by EXPR, or by C<$_> if EXPR is not -supplied. If a version number or tuple is specified, or if EXPR is -numeric, demands that the current version of Perl -(C<$^V> or C<$]> or $PERL_VERSION) be equal or greater than EXPR. +supplied. + +If a VERSION is specified as a literal of the form v5.6.1, +demands that the current version of Perl (C<$^V> or $PERL_VERSION) be +at least as recent as that version, at run time. (For compatibility +with older versions of Perl, a numeric argument will also be interpreted +as VERSION.) Compare with L</use>, which can do a similar check at +compile time. + + require v5.6.1; # run time version check + require 5.6.1; # ditto + require 5.005_03; # float version allowed for compatibility Otherwise, demands that a library file be included if it hasn't already been included. The file is included via the do-FILE mechanism, which is @@ -3716,9 +3741,8 @@ filehandle. The values for WHENCE are C<0> to set the new position to POSITION, C<1> to set it to the current position plus POSITION, and C<2> to set it to EOF plus POSITION (typically negative). For WHENCE you may use the constants C<SEEK_SET>, C<SEEK_CUR>, and C<SEEK_END> -(start of the file, current position, end of the file) from any of the -modules Fcntl, C<IO::Seekable>, or POSIX. Returns C<1> upon success, -C<0> otherwise. +(start of the file, current position, end of the file) from the Fcntl +module. Returns C<1> upon success, C<0> otherwise. If you want to position file for C<sysread> or C<syswrite>, don't use C<seek>--buffering makes its effect on the file's system position @@ -3967,7 +3991,7 @@ processes. Returns the sine of EXPR (expressed in radians). If EXPR is omitted, returns sine of C<$_>. -For the inverse sine operation, you may use the C<POSIX::asin> +For the inverse sine operation, you may use the C<Math::Trig::asin> function, or use this relation: sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) } @@ -4003,6 +4027,10 @@ the system call of the same name. You should C<use Socket> first to get the proper definitions imported. See the examples in L<perlipc/"Sockets: Client/Server Communication">. +On systems that support a close-on-exec flag on files, the flag will +be set for the newly opened file descriptor, as determined by the +value of $^F. See L<perlvar/$^F>. + =item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL Creates an unnamed pair of sockets in the specified domain, of the @@ -4010,6 +4038,10 @@ specified type. DOMAIN, TYPE, and PROTOCOL are specified the same as for the system call of the same name. If unimplemented, yields a fatal error. Returns true if successful. +On systems that support a close-on-exec flag on files, the flag will +be set for the newly opened file descriptors, as determined by the value +of $^F. See L<perlvar/$^F>. + Some systems defined C<pipe> in terms of C<socketpair>, in which a call to C<pipe(Rdr, Wtr)> is essentially: @@ -4160,6 +4192,8 @@ well-defined. =item splice ARRAY,OFFSET +=item splice ARRAY + Removes the elements designated by OFFSET and LENGTH from an array, and replaces them with the elements of LIST, if any. In list context, returns the elements removed from the array. In scalar context, @@ -4167,7 +4201,9 @@ returns the last element removed, or C<undef> if no elements are removed. The array grows or shrinks as necessary. If OFFSET is negative then it starts that far from the end of the array. If LENGTH is omitted, removes everything from OFFSET onward. -If LENGTH is negative, leave that many elements off the end of the array. +If LENGTH is negative, leaves that many elements off the end of the array. +If both OFFSET and LENGTH are omitted, removes everything. + The following equivalences hold (assuming C<$[ == 0>): push(@a,$x,$y) splice(@a,@a,0,$x,$y) @@ -4310,10 +4346,6 @@ In addition, Perl permits the following widely-supported conversions: %n special: *stores* the number of characters output so far into the next variable in the parameter list -And the following Perl-specific conversion: - - %v a string, output as a tuple of integers ("Perl" is 80.101.114.108) - Finally, for backward (and we do mean "backward") compatibility, Perl permits these unnecessary but widely-supported conversions: @@ -4339,9 +4371,13 @@ and the conversion letter: h interpret integer as C type "short" or "unsigned short" If no flags, interpret integer as C type "int" or "unsigned" -There is also one Perl-specific flag: +There are also two Perl-specific flags: V interpret integer as Perl's standard integer type + v interpret string as a vector of integers, output as + numbers separated either by dots, or by an arbitrary + string received from the argument list when the flag + is preceded by C<*> Where a number would appear in the flags, an asterisk (C<*>) may be used instead, in which case Perl uses the next item in the parameter @@ -4349,13 +4385,20 @@ list as the given number (that is, as the field width or precision). If a field width obtained through C<*> is negative, it has the same effect as the C<-> flag: left-justification. +The C<v> flag is useful for displaying ordinal values of characters +in arbitrary strings: + + printf "version is v%vd\n", $^V; # Perl's version + printf "address is %*vX\n", ":", $addr; # IPv6 address + printf "bits are %*vb\n", " ", $bits; # random bitstring + If C<use locale> is in effect, the character used for the decimal point in formatted real numbers is affected by the LC_NUMERIC locale. See L<perllocale>. If Perl understands "quads" (64-bit integers) (this requires -either that the platform natively supports quads or that Perl -has been specifically compiled to support quads), the characters +either that the platform natively support quads or that Perl +be specifically compiled to support quads), the characters d u o x X b i D U O @@ -4370,11 +4413,11 @@ For example You can find out whether your Perl supports quads via L<Config>: use Config; - ($Config{use64bits} eq 'define' || $Config{longsize} == 8) && + ($Config{use64bitint} eq 'define' || $Config{longsize} == 8) && print "quads\n"; If Perl understands "long doubles" (this requires that the platform -supports long doubles), the flags +support long doubles), the flags e f g E F G @@ -4488,7 +4531,8 @@ last stat or filetest are returned. Example: print "$file is executable NFS file\n"; } -(This works on machines only for which the device number is negative under NFS.) +(This works on machines only for which the device number is negative +under NFS.) Because the mode contains both the file type and its permissions, you should mask off the file type portion and (s)printf using a C<"%o"> @@ -4509,6 +4553,66 @@ The File::stat module provides a convenient, by-name access mechanism: $filename, $sb->size, $sb->mode & 07777, scalar localtime $sb->mtime; +You can import symbolic mode constants (C<S_IF*>) and functions +(C<S_IS*>) from the Fcntl module: + + use Fcntl ':mode'; + + $mode = (stat($filename))[2]; + + $user_rwx = ($mode & S_IRWXU) >> 6; + $group_read = ($mode & S_IRGRP) >> 3; + $other_execute = $mode & S_IXOTH; + + printf "Permissions are %04o\n", S_ISMODE($mode), "\n"; + + $is_setuid = $mode & S_ISUID; + $is_setgid = S_ISDIR($mode); + +You could write the last two using the C<-u> and C<-d> operators. +The commonly available S_IF* constants are + + # Permissions: read, write, execute, for user, group, others. + + S_IRWXU S_IRUSR S_IWUSR S_IXUSR + S_IRWXG S_IRGRP S_IWGRP S_IXGRP + S_IRWXO S_IROTH S_IWOTH S_IXOTH + + # Setuid/Setgid/Stickiness. + + S_ISUID S_ISGID S_ISVTX S_ISTXT + + # File types. Not necessarily all are available on your system. + + S_IFREG S_IFDIR S_IFLNK S_IFBLK S_ISCHR S_IFIFO S_IFSOCK S_IFWHT S_ENFMT + + # The following are compatibility aliases for S_IRUSR, S_IWUSR, S_IXUSR. + + S_IREAD S_IWRITE S_IEXEC + +and the S_IF* functions are + + S_IFMODE($mode) the part of $mode containg the permission bits + and the setuid/setgid/sticky bits + + S_IFMT($mode) the part of $mode containing the file type + which can be bit-anded with e.g. S_IFREG + or with the following functions + + # The operators -f, -d, -l, -b, -c, -p, and -s. + + S_ISREG($mode) S_ISDIR($mode) S_ISLNK($mode) + S_ISBLK($mode) S_ISCHR($mode) S_ISFIFO($mode) S_ISSOCK($mode) + + # No direct -X operator counterpart, but for the first one + # the -g operator is often equivalent. The ENFMT stands for + # record flocking enforcement, a platform-dependent feature. + + S_ISENFMT($mode) S_ISWHT($mode) + +See your native chmod(2) and stat(2) documentation for more details +about the S_* constants. + =item study SCALAR =item study @@ -4748,7 +4852,7 @@ POSITION, C<1> to set the it to the current position plus POSITION, and C<2> to set it to EOF plus POSITION (typically negative). For WHENCE, you may also use the constants C<SEEK_SET>, C<SEEK_CUR>, and C<SEEK_END> (start of the file, current position, end of the file) -from any of the modules Fcntl, C<IO::Seekable>, or POSIX. +from the Fcntl module. Returns the new position, or the undefined value on failure. A position of zero is returned as the string C<"0 but true">; thus C<sysseek> returns @@ -5134,12 +5238,14 @@ Note the LIST is prepended whole, not one element at a time, so the prepended elements stay in the same order. Use C<reverse> to do the reverse. +=item use Module VERSION LIST + +=item use Module VERSION + =item use Module LIST =item use Module -=item use Module VERSION LIST - =item use VERSION Imports some semantics into the current package from the named module, @@ -5150,13 +5256,18 @@ package. It is exactly equivalent to except that Module I<must> be a bareword. -If the first argument to C<use> is a number or a version tuple, it is -treated as a version instead of a module name. If the version -of the Perl interpreter is less than VERSION, then an error message -is printed and Perl exits immediately. +VERSION, which can be specified as a literal of the form v5.6.1, demands +that the current version of Perl (C<$^V> or $PERL_VERSION) be at least +as recent as that version. (For compatibility with older versions of Perl, +a numeric literal will also be interpreted as VERSION.) If the version +of the running Perl interpreter is less than VERSION, then an error +message is printed and Perl exits immediately without attempting to +parse the rest of the file. Compare with L</require>, which can do a +similar check at run time. - use 5.005_03; # version number - use v5.6.0; # version tuple + use v5.6.1; # compile time version check + use 5.6.1; # ditto + use 5.005_03; # float version allowed for compatibility This is often useful if you need to check the current Perl version before C<use>ing library modules that have changed in incompatible ways from @@ -5183,9 +5294,12 @@ That is exactly equivalent to If the VERSION argument is present between Module and LIST, then the C<use> will call the VERSION method in class Module with the given version as an argument. The default VERSION method, inherited from -the Universal class, croaks if the given version is larger than the -value of the variable C<$Module::VERSION>. (Note that there is not a -comma after VERSION!) +the UNIVERSAL class, croaks if the given version is larger than the +value of the variable C<$Module::VERSION>. + +Again, there is a distinction between omitting LIST (C<import> called +with no arguments) and an explicit empty LIST C<()> (C<import> not +called). Note that there is no comma after VERSION! Because this is a wide-open interface, pragmas (compiler directives) are also implemented this way. Currently implemented pragmas are: diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 7a8d1e5879..0e1df8abd3 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -334,6 +334,7 @@ the strings?). 5.005_63 1999-Dec-09 5.5.640 2000-Feb-02 5.5.650 2000-Feb-08 5.6 beta1 + 5.5.660 2000-Feb-22 5.6 beta2 =head2 SELECTED RELEASE SIZES diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 3034197e14..3649e4f883 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -126,7 +126,7 @@ or even the more elaborate: use POSIX ":sys_wait_h"; sub REAPER { my $child; - while ($child = waitpid(-1,WNOHANG)) { + while (($child = waitpid(-1,WNOHANG)) > 0) { $Kid_Status{$child} = $?; } $SIG{CHLD} = \&REAPER; # still loathe sysV diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index 6078aefd96..d370f04412 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -55,13 +55,11 @@ warning about the "2:". 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; @@ -166,8 +164,9 @@ How Lexical Warnings interact with B<-w>/C<$^W>: =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. @@ -185,7 +184,7 @@ disable/enable default warnings. =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. @@ -197,82 +196,109 @@ or B<-X> command line flags. =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 @@ -280,7 +306,7 @@ 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 ... @@ -288,14 +314,16 @@ warnings pragma in a given scope the cumulative effect is additive. ... 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 ; @@ -308,15 +336,54 @@ produce a fatal error. } $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 @@ -330,7 +397,7 @@ The experimental features need bottomed out. =head1 SEE ALSO -L<warnings>. +L<warnings>, L<perldiag>. =head1 AUTHOR diff --git a/pod/perlop.pod b/pod/perlop.pod index d932704666..c5d7f3fc1d 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1802,17 +1802,21 @@ operation you intend by using C<""> or C<0+>, as in the examples below. See L<perlfunc/vec> for information on how to manipulate individual bits in a bit vector. -=head2 Version tuples +=head2 Strings of Character -A literal of the form C<v1.20.300.4000> is parsed as a dual-valued quantity. -It has the string value of C<"\x{1}\x{14}\x{12c}\x{fa0}"> (i.e., a UTF-8 -string) and a numeric value of C<1 + 20/1000 + 300/1000000 + 4000/1000000000>. -This is useful for representing Unicode strings, and for comparing version -numbers using the string comparison operators, C<cmp>, C<gt>, C<lt> etc. +A literal of the form C<v1.20.300.4000> is parsed as a string composed +of characters with the specified ordinals. This provides an alternative, +more readable way to construct strings, rather than use the somewhat less +readable interpolation form C<"\x{1}\x{14}\x{12c}\x{fa0}">. This is useful +for representing Unicode strings, and for comparing version "numbers" +using the string comparison operators, C<cmp>, C<gt>, C<lt> etc. -Such "version tuples" or "vectors" are accepted by both C<require> and -C<use>. The C<$^V> variable contains the running Perl interpreter's -version in this format. See L<perlvar/$^V>. +If there are two or more dots in the literal, the leading C<v> may be +omitted. + +Such literals are accepted by both C<require> and C<use> for doing a version +check. The C<$^V> special variable also contains the running Perl +interpreter's version in this form. See L<perlvar/$^V>. =head2 Integer Arithmetic diff --git a/pod/perlopentut.pod b/pod/perlopentut.pod index fd32bd9f49..cc9cf63ff2 100644 --- a/pod/perlopentut.pod +++ b/pod/perlopentut.pod @@ -303,11 +303,13 @@ from the Fcntl module, which supplies the following standard flags: O_TRUNC Truncate the file O_NONBLOCK Non-blocking access -Less common flags that are sometimes available on some operating systems -include C<O_BINARY>, C<O_TEXT>, C<O_SHLOCK>, C<O_EXLOCK>, C<O_DEFER>, -C<O_SYNC>, C<O_ASYNC>, C<O_DSYNC>, C<O_RSYNC>, C<O_NOCTTY>, C<O_NDELAY> -and C<O_LARGEFILE>. Consult your open(2) manpage or its local equivalent -for details. +Less common flags that are sometimes available on some operating +systems include C<O_BINARY>, C<O_TEXT>, C<O_SHLOCK>, C<O_EXLOCK>, +C<O_DEFER>, C<O_SYNC>, C<O_ASYNC>, C<O_DSYNC>, C<O_RSYNC>, +C<O_NOCTTY>, C<O_NDELAY> and C<O_LARGEFILE>. Consult your open(2) +manpage or its local equivalent for details. (Note: starting from +Perl release 5.6 the O_LARGEFILE flag, if available, is automatically +added to the sysopen() flags because large files are the the default.) Here's how to use C<sysopen> to emulate the simple C<open> calls we had before. We'll omit the C<|| die $!> checks for clarity, but make sure diff --git a/pod/perlpod.pod b/pod/perlpod.pod index 731a0fbd3d..0997c71738 100644 --- a/pod/perlpod.pod +++ b/pod/perlpod.pod @@ -188,6 +188,41 @@ here and in commands: E<html> Some non-numeric HTML entity, such as E<Agrave> +Most of the time, you will only need a single set of angle brackets to +delimit the beginning and end of interior sequences. However, sometimes +you will want to put a right angle bracket (or greater-than sign '>') +inside of a sequence. This is particularly common when using a sequence +to provide a different font-type for a snippet of code. As with all +things in Perl, there is more than one way to do it. One way is to +simply escape the closing bracket using an C<E> sequence: + + C<$a E<lt>=E<gt> $b> + +This will produce: "C<$a E<lt>=E<gt> $b>" + +A more readable, and perhaps more "plain" way is to use an alternate set of +delimiters that doesn't require a ">" to be escaped. As of perl5.5.660, +doubled angle brackets ("<<" and ">>") may be used I<if and only if there +is whitespace immediately following the opening delimiter and immediately +preceding the closing delimiter!> For example, the following will do the +trick: + + C<< $a <=> $b >> + +In fact, you can use as many repeated angle-brackets as you like so +long as you have the same number of them in the opening and closing +delimiters, and make sure that whitespace immediately follows the last +'<' of the opening delimiter, and immediately precedes the first '>' of +the closing delimiter. So the following will also work: + + C<<< $a <=> $b >>> + C<<<< $a <=> $b >>>> + +This is currently supported by pod2text (Pod::Text), pod2man (Pod::Man), +and any other pod2xxx and Pod::Xxxx translator that uses Pod::Parser +1.093 or later. + + =head2 The Intent That's it. The intent is simplicity, not power. I wanted paragraphs diff --git a/pod/perlport.pod b/pod/perlport.pod index 7a500f8838..549a6c29a9 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -90,7 +90,7 @@ Perl uses C<\n> to represent the "logical" newline, where what is logical may depend on the platform in use. In MacPerl, C<\n> always means C<\015>. In DOSish perls, C<\n> usually means C<\012>, but when accessing a file in "text" mode, STDIO translates it to (or -from) C<\015\012>, depending on whether your reading or writing. +from) C<\015\012>, depending on whether you're reading or writing. Unix does the same thing on ttys in canonical mode. C<\015\012> is commonly referred to as CRLF. @@ -648,6 +648,7 @@ DOSish perls are as follows: Windows NT MSWin32 MSWin32-x86 Windows NT MSWin32 MSWin32-ALPHA Windows NT MSWin32 MSWin32-ppc + Cygwin cygwin Also see: @@ -663,8 +664,8 @@ C<ftp://hobbes.nmsu.edu/pub/os2/dev/emx> =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/> @@ -843,7 +844,7 @@ Also see: =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> @@ -908,7 +909,7 @@ Also see: =over 4 -=item L<README.vos> +=item F<README.vos> =item VOS mailing list @@ -998,7 +999,7 @@ Also see: =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 @@ -1137,14 +1138,14 @@ See also: =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 @@ -1153,7 +1154,7 @@ A free perl5-based PERL.NLM for Novell Netware is available in 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 @@ -1675,6 +1676,10 @@ Not useful. (S<RISC OS>) =over 4 +=item v1.46, 12 February 2000 + +Updates for VOS and MPE/iX. (Peter Prymmer) Other small changes. + =item v1.45, 20 December 1999 Small changes from 5.005_63 distribution, more changes to EBCDIC info. @@ -1786,4 +1791,4 @@ E<lt>pudge@pobox.comE<gt>. =head1 VERSION -Version 1.45, last modified 20 December 1999 +Version 1.46, last modified 12 February 2000 diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 8aa06fb2bf..5cc1969c60 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -130,13 +130,12 @@ distribution for more information). =item Win95/NT -The Win95/NT installation, when using the Activeware port of Perl, +The Win95/NT installation, when using the ActiveState installer for Perl, will modify the Registry to associate the F<.pl> extension with the perl -interpreter. If you install another port of Perl, including the one -in the Win32 directory of the Perl distribution, then you'll have to -modify the Registry yourself. Note that this means you can no -longer tell the difference between an executable Perl program -and a Perl library file. +interpreter. If you install Perl by other means (including building from +the sources), you may have to modify the Registry yourself. Note that +this means you can no longer tell the difference between an executable +Perl program and a Perl library file. =item Macintosh @@ -576,10 +575,11 @@ enables rudimentary switch parsing for switches on the command line after the program name but before any filename arguments (or before a B<-->). Any switch found there is removed from @ARGV and sets the corresponding variable in the Perl program. The following program -prints "true" if and only if the program is invoked with a B<-xyz> switch. +prints "1" if the program is invoked with a B<-xyz> switch, and "abc" +if it is invoked with B<-xyz=abc>. #!/usr/bin/perl -s - if ($xyz) { print "true\n" } + if ($xyz) { print "$xyz\n" } =item B<-S> @@ -706,12 +706,12 @@ that. =item B<-W> -Enables all warnings regardless of +Enables all warnings regardless of C<no warnings> or C<$^W>. See L<perllexwarn>. =item B<-X> -Disables all warnings regardless of +Disables all warnings regardless of C<use warnings> or C<$^W>. See L<perllexwarn>. =item B<-x> I<directory> diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index f07bdfeabf..7b9590e4de 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -593,7 +593,7 @@ this, one can control Perl's idea of filenames and line numbers in error or warning messages (especially for strings that are processed with C<eval()>). The syntax for this mechanism is the same as for most C preprocessors: it matches the regular expression -C</^#\s*line\s+(\d+)\s*(?:\s"([^"]*)")?/> with C<$1> being the line +C</^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/> with C<$1> being the line number for the next line, and C<$2> being the optional filename (specified within quotes). diff --git a/pod/perlthrtut.pod b/pod/perlthrtut.pod index fc88561da7..88849dd662 100644 --- a/pod/perlthrtut.pod +++ b/pod/perlthrtut.pod @@ -722,8 +722,7 @@ subroutine's behavior while your program is actually running. The basic subroutine lock looks like this: - sub test_sub { - use attrs qw(locked); + sub test_sub :locked { } This ensures that only one thread will be executing this subroutine at @@ -738,8 +737,7 @@ it. A more elaborate example looks like this: new Thread \&thread_sub, 3; new Thread \&thread_sub, 4; - sub sync_sub { - use attrs qw(locked); + sub sync_sub :locked { my $CallingThread = shift @_; print "In sync_sub for thread $CallingThread\n"; yield; @@ -754,8 +752,8 @@ it. A more elaborate example looks like this: print "$ThreadID is done with sync_sub\n"; } -The use attrs qw(locked) locks sync_sub(), and if you run this, you -can see that only one thread is in it at any one time. +The C<locked> attribute tells perl to lock sync_sub(), and if you run +this, you can see that only one thread is in it at any one time. =head2 Methods @@ -793,8 +791,7 @@ method attribute indicates whether the subroutine is really a method. return bless [@_], $class; } - sub per_object { - use attrs qw(locked method); + sub per_object :locked :method { my ($class, $thrnum) = @_; print "In per_object for thread $thrnum\n"; yield; @@ -802,8 +799,7 @@ method attribute indicates whether the subroutine is really a method. print "Exiting per_object for thread $thrnum\n"; } - sub one_at_a_time { - use attrs qw(locked); + sub one_at_a_time :locked { my ($class, $thrnum) = @_; print "In one_at_a_time for thread $thrnum\n"; yield; @@ -817,8 +813,8 @@ thread is ever in one_at_a_time() at once. =head2 Locking A Subroutine -You can lock a subroutine as you would lock a variable. Subroutine -locks work the same as a C<use attrs qw(locked)> in the subroutine, +You can lock a subroutine as you would lock a variable. Subroutine locks +work the same as specifying a C<locked> attribute for the subroutine, and block all access to the subroutine for other threads until the lock goes out of scope. When the subroutine isn't locked, any number of threads can be in it at once, and getting a lock on a subroutine @@ -827,10 +823,10 @@ subroutine looks like this: lock(\&sub_to_lock); -Simple enough. Unlike use attrs, which is a compile time option, -locking and unlocking a subroutine can be done at runtime at your +Simple enough. Unlike the C<locked> attribute, which is a compile time +option, locking and unlocking a subroutine can be done at runtime at your discretion. There is some runtime penalty to using lock(\&sub) instead -of use attrs qw(locked), so make sure you're choosing the proper +of the C<locked> attribute, so make sure you're choosing the proper method to do the locking. You'd choose lock(\&sub) when writing modules and code to run on both diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 2f8f3a27af..461982a1fe 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -3878,7 +3878,7 @@ method, locked =back -=head2 byte - Perl pragma to turn force treating strings as bytes not +=head2 bytes - Perl pragma to turn force treating strings as bytes not UNICODE =over diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 55a29bd3be..63997be0e1 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -30,21 +30,21 @@ several, like gnats and the Debian system, but at the time we investigated them, none met our needs. Since then, Jitterbug has matured, and may be worth reinvestigation. -The system we've developed will eventually be recipient of perlbug -mail. New bugs are entered into a mysql database, and sent on to +The system we've developed is the recipient of perlbug mail, and any +followups it generates from perl5-porters. New bugs are entered +into a mysql database, and sent on to perl5-porters with the subject line rewritten to include a "ticket number" (unique ID for the new bug). If the incoming message already had a ticket number in the subject line, then the message is logged against that bug. There is a separate email interface (not forwarding to p5p) that permits porters to claim, categorize, and close tickets. -The next desire is a web interface. It is hoped that code can be -reused between the mail and the web interfaces. +There is also a web interface to the system at http://bugs.perl.org. The current delay in implementation is caused by perl.org lockups. One suspect is the mail handling system, possibly going into loops. -We're probably going to need a bugmaster, someone who will look at +We still desperately need a bugmaster, someone who will look at every new "bug" and kill those that we already know about, those that are not bugs at all, etc. diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index bc880364d3..c5ffbaf0e4 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -36,8 +36,8 @@ global flag is set to C<1>), all system calls will use the corresponding wide character APIs. This is currently only implemented on Windows. -Regardless of the above, the C<byte> pragma can always be used to force -byte semantics in a particular lexical scope. See L<byte>. +Regardless of the above, the C<bytes> pragma can always be used to force +byte semantics in a particular lexical scope. See L<bytes>. The C<utf8> pragma is primarily a compatibility device that enables recognition of UTF-8 in literals encountered by the parser. It is also @@ -53,7 +53,7 @@ the input data came from a Unicode source (for example, by adding a character encoding discipline to the filehandle whence it came, or a literal UTF-8 string constant in the program), character semantics apply; otherwise, byte semantics are in effect. To force byte semantics -on Unicode data, the C<byte> pragma should be used. +on Unicode data, the C<bytes> pragma should be used. Under character semantics, many operations that formerly operated on bytes change to operating on characters. For ASCII data this makes @@ -227,6 +227,6 @@ tend to run slower. Avoidance of locales is strongly encouraged. =head1 SEE ALSO -L<byte>, L<utf8>, L<perlvar/"${^WIDE_SYSTEM_CALLS}"> +L<bytes>, L<utf8>, L<perlvar/"${^WIDE_SYSTEM_CALLS}"> =cut diff --git a/pod/perlvar.pod b/pod/perlvar.pod index f0cb109005..6b4c659d3d 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -176,16 +176,16 @@ This variable is read-only and dynamically scoped to the current BLOCK. =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 @@ -426,6 +426,33 @@ matched subgroup in the last successful match. Contrast with 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 @@ -672,8 +699,6 @@ As of release 5 of Perl, assignment to C<$[> is treated as a compiler directive, and cannot influence the behavior of any other file. Its use is highly discouraged. -=item $PERL_VERSION - =item $] The version + patchlevel / 1000 of the Perl interpreter. This variable @@ -686,7 +711,10 @@ of perl in the right bracket?) Example: See also the documentation of C<use VERSION> and C<require VERSION> for a convenient way to fail if the running Perl interpreter is too old. -See C<$^V> for a more modern representation of the Perl version. +The use of this variable is deprecated. The floating point representation +can sometimes lead to inaccurate numeric comparisons. See C<$^V> for a +more modern representation of the Perl version that allows accurate string +comparisons. =item $COMPILING @@ -715,7 +743,8 @@ descriptors are not. Also, during an open(), system file descriptors are preserved even if the open() fails. (Ordinary file descriptors are closed before the open() is attempted.) The close-on-exec status of a file descriptor will be decided according to the value of -C<$^F> when the open() or pipe() was called, not the time of the exec(). +C<$^F> when the corresponding file, pipe, or socket was opened, not the +time of the exec(). =item $^H @@ -854,11 +883,15 @@ were compiled. Some bits may be relevant at compile-time only, some at run-time only. This is a new mechanism and the details may change. +=item $LAST_REGEXP_CODE_RESULT + =item $^R The result of evaluation of the last successful C<(?{ code })> regular expression assertion (see L<perlre>). May be written to. +=item $EXCEPTIONS_BEING_CAUGHT + =item $^S Current state of the interpreter. Undefined if parsing of the current @@ -873,24 +906,23 @@ The time at which the program began running, in seconds since the epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, and B<-C> filetests are based on this value. -=item $PERL_VERSION_TUPLE +=item $PERL_VERSION =item $^V The revision, version, and subversion of the Perl interpreter, represented -as a "version tuple". Version tuples have both a numeric value and a -string value. The numeric value is a floating point number that amounts -to revision + version/1000 + subversion/1000000, and the string value -is made of characters possibly in the UTF-8 range: -C<chr($revision) . chr($version) . chr($subversion)>. +as a string composed of characters with those ordinals. Thus in Perl v5.6.0 +it equals C<chr(5) . chr(6) . chr(0)> and will return true for +C<$^V eq v5.6.0>. Note that the characters in this string value can +potentially be in Unicode range. This can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: use ^V for Version -control.) Example: +Control.) Example: - warn "No "our" declarations!\n" if $^V and $^V lt v5.6; + warn "No "our" declarations!\n" if $^V and $^V lt v5.6.0; -See also the documentation of C<use VERSION> and C<require VERSION> +See the documentation of C<use VERSION> and C<require VERSION> for a convenient way to fail if the running Perl interpreter is too old. See also C<$]> for an older representation of the Perl version. @@ -920,8 +952,8 @@ The initial value is typically C<0> for compatibility with Perl versions earlier than 5.6, but may be automatically set to C<1> by Perl if the system provides a user-settable default (e.g., C<$ENV{LC_CTYPE}>). -The C<byte> pragma always overrides the effect of this flag in the current -lexical scope. See L<byte>. +The C<bytes> pragma always overrides the effect of this flag in the current +lexical scope. See L<bytes>. =item $EXECUTABLE_NAME diff --git a/pod/perlxs.pod b/pod/perlxs.pod index a2755b8f2d..7359d34818 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -502,9 +502,9 @@ C<ST(1)>. =head2 Default Parameter Values -Default values for XSUB arguments can be specified by -placing an assignment statement in the parameter list. The -default value may be a number or a string. Defaults should +Default values for XSUB arguments can be specified by placing an +assignment statement in the parameter list. The default value may +be a number, a string or the special string C<NO_INIT>. Defaults should always be used on the right-most parameters only. To allow the XSUB for rpcb_gettime() to have a default host @@ -1314,6 +1314,19 @@ methods will be called as this: THIS->set_blue( val ); +You could also write a single get/set method using an optional argument: + + int + color::blue( val = NO_INIT ) + int val + PROTOTYPE $;$ + CODE: + if (items > 1) + THIS->set_blue( val ); + RETVAL = THIS->blue(); + OUTPUT: + RETVAL + If the function's name is B<DESTROY> then the C++ C<delete> function will be called and C<THIS> will be given as its parameter. The generated C++ code for diff --git a/pod/podchecker.PL b/pod/podchecker.PL index f7a820d0f7..a7f96434ca 100644 --- a/pod/podchecker.PL +++ b/pod/podchecker.PL @@ -18,6 +18,7 @@ chdir(dirname($0)); ($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: $!"; @@ -585,8 +585,8 @@ PP(pp_bless) 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); } @@ -832,8 +832,8 @@ PP(pp_undef) 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: @@ -2012,7 +2012,9 @@ PP(pp_substr) 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; } @@ -2202,13 +2204,13 @@ PP(pp_chr) (void)SvUPGRADE(TARG,SVt_PV); if (value > 255 && !IN_BYTE) { - SvGROW(TARG,8); + SvGROW(TARG, UTF8_MAXLEN+1); tmps = SvPVX(TARG); tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value); SvCUR_set(TARG, tmps - SvPVX(TARG)); *tmps = '\0'; - SvUTF8_on(TARG); (void)SvPOK_only(TARG); + SvUTF8_on(TARG); XPUSHs(TARG); RETURN; } @@ -2252,7 +2254,7 @@ PP(pp_ucfirst) if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { I32 ulen; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tend; UV uv = utf8_to_uv(s, &ulen); @@ -2311,7 +2313,7 @@ PP(pp_lcfirst) if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { I32 ulen; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tend; UV uv = utf8_to_uv(s, &ulen); @@ -2881,8 +2883,8 @@ PP(pp_anonhash) 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; @@ -3392,8 +3394,8 @@ PP(pp_unpack) 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 '%': @@ -4455,8 +4457,8 @@ PP(pp_pack) 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 '%': @@ -4643,7 +4645,7 @@ PP(pp_pack) while (len-- > 0) { fromstr = NEXTFROM; auint = SvUV(fromstr); - SvGROW(cat, SvCUR(cat) + 10); + SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN); SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint) - SvPVX(cat)); } @@ -4908,11 +4910,11 @@ PP(pp_pack) * 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)) @@ -302,8 +302,13 @@ PP(pp_formline) bool item_is_utf = FALSE; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { - SvREADONLY_off(tmpForm); - doparseform(tmpForm); + if (SvREADONLY(tmpForm)) { + SvREADONLY_off(tmpForm); + doparseform(tmpForm); + SvREADONLY_on(tmpForm); + } + else + doparseform(tmpForm); } SvPV_force(PL_formtarget, len); @@ -1070,28 +1075,28 @@ S_dopoptolabel(pTHX_ char *label) 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: @@ -1196,28 +1201,28 @@ S_dopoptoloop(pTHX_ I32 startingblock) 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: @@ -1342,9 +1347,9 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) 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); } } } @@ -1451,7 +1456,7 @@ PP(pp_caller) 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) { @@ -1521,10 +1526,10 @@ PP(pp_caller) if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); PUSHs(&PL_sv_no); - } - else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */ - /* Require, put the name. */ - PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0))); + } + /* try blocks have old_namesv == 0 */ + else if (cx->blk_eval.old_namesv) { + PUSHs(sv_2mortal(newSVsv(cx->blk_eval.old_namesv))); PUSHs(&PL_sv_yes); } } @@ -1556,6 +1561,17 @@ PP(pp_caller) * 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; } @@ -1808,9 +1824,9 @@ PP(pp_return) (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { /* Unassume the success we assumed earlier. */ - char *name = cx->blk_eval.old_name; - (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); - DIE(aTHX_ "%s did not return a true value", name); + SV *nsv = cx->blk_eval.old_namesv; + (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD); + DIE(aTHX_ "%s did not return a true value", SvPVX(nsv)); } break; case CXt_FORMAT: @@ -1967,17 +1983,14 @@ PP(pp_next) if (cxix < cxstack_ix) dounwind(cxix); - cx = &cxstack[cxstack_ix]; - { - OP *nextop = cx->blk_loop.next_op; - /* clean scope, but only if there's no continue block */ - if (nextop == cUNOPx(cx->blk_loop.last_op)->op_first->op_next) { - TOPBLOCK(cx); - oldsave = PL_scopestack[PL_scopestack_ix - 1]; - LEAVE_SCOPE(oldsave); - } - return nextop; + TOPBLOCK(cx); + + /* clean scope, but only if there's no continue block */ + if (!(cx->blk_loop.last_op->op_private & OPpLOOP_CONTINUE)) { + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); } + return cx->blk_loop.next_op; } PP(pp_redo) @@ -2516,9 +2529,17 @@ S_save_lines(pTHX_ AV *array, SV *sv) } } +#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; } @@ -2536,10 +2557,18 @@ S_docatch(pTHX_ OP *o) 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) { @@ -2549,10 +2578,12 @@ S_docatch(pTHX_ OP *o) } /* FALL THROUGH */ default: + JMPENV_POP; PL_op = oldop; JMPENV_JUMP(ret); /* NOTREACHED */ } + JMPENV_POP; PL_op = oldop; return Nullop; } @@ -2897,15 +2928,17 @@ PP(pp_require) } } else if (!SvPOKp(sv)) { /* require 5.005_03 */ - NV n = SvNV(sv); - rev = (UV)n; - ver = (UV)((n-rev)*1000); - sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000); - if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000) + ((NV)PERL_SUBVERSION/(NV)1000000) + 0.00000099 < SvNV(sv)) { + NV nrev = SvNV(sv); + UV rev = (UV)nrev; + NV nver = (nrev - rev) * 1000; + UV ver = (UV)(nver + 0.0009); + NV nsver = (nver - ver) * 1000; + UV sver = (UV)(nsver + 0.0009); + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version " "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION, PERL_VERSION, PERL_SUBVERSION); @@ -3289,9 +3322,9 @@ PP(pp_leaveeval) !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp)) { /* Unassume the success we assumed earlier. */ - char *name = cx->blk_eval.old_name; - (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); - retop = Perl_die(aTHX_ "%s did not return a true value", name); + SV *nsv = cx->blk_eval.old_namesv; + (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD); + retop = Perl_die(aTHX_ "%s did not return a true value", SvPVX(nsv)); /* die_where() did LEAVE, or we won't be here */ } else { @@ -22,13 +22,6 @@ #ifdef I_UNISTD #include <unistd.h> #endif -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif - /* Hot code. */ @@ -173,18 +166,27 @@ PP(pp_concat) 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'"); } } #endif + if (DO_UTF8(right)) + sv_utf8_upgrade(TARG); sv_catpvn(TARG,s,len); + if (!IN_BYTE) { + if (SvUTF8(right)) + SvUTF8_on(TARG); + } + else if (!SvUTF8(right)) { + SvUTF8_off(TARG); + } } else sv_setpvn(TARG,s,len); /* suppress warning */ @@ -715,14 +717,14 @@ PP(pp_aassign) 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); @@ -1254,9 +1256,9 @@ Perl_do_readline(pTHX) } } 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 @@ -1305,8 +1307,8 @@ Perl_do_readline(pTHX) (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" : ""); @@ -112,27 +112,12 @@ extern int h_errno; # include <utime.h> # endif #endif -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif /* Put this after #includes because fork and vfork prototypes may conflict. */ #ifndef HAS_VFORK # define vfork fork #endif -/* Put this after #includes because <unistd.h> defines _XOPEN_*. */ -#ifndef Sock_size_t -# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) -# define Sock_size_t Size_t -# else -# define Sock_size_t int -# endif -#endif - #ifdef HAS_CHSIZE # ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */ # undef my_chsize @@ -943,7 +928,7 @@ PP(pp_sselect) /* If SELECT_MIN_BITS is greater than one we most probably will want * to align the sizes with SELECT_MIN_BITS/8 because for example * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital - * UNIX, Solaris, NeXT, Rhapsody) the smallest quantum select() operates + * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates * on (sets/tests/clears bits) is 32 bits. */ growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8))); # else @@ -2042,6 +2027,9 @@ PP(pp_socket) if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); RETPUSHUNDEF; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ +#endif RETPUSHYES; #else @@ -2092,6 +2080,10 @@ PP(pp_sockpair) if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); RETPUSHUNDEF; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ + fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ +#endif RETPUSHYES; #else @@ -2254,6 +2246,9 @@ PP(pp_accept) if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); goto badexit; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ +#endif PUSHp((char *)&saddr, len); RETURN; @@ -3372,12 +3367,19 @@ S_dooneliner(pTHX_ char *cmd, char *filename) 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 @@ -4712,7 +4714,7 @@ PP(pp_gpwuid) PP(pp_gpwent) { djSP; -#if defined(HAS_PASSWD) && defined(HAS_GETPWENT) +#ifdef HAS_PASSWD I32 which = PL_op->op_type; register SV *sv; struct passwd *pwent; @@ -4726,7 +4728,11 @@ PP(pp_gpwent) else if (which == OP_GPWUID) pwent = getpwuid(POPi); else +#ifdef HAS_GETPWENT pwent = (struct passwd *)getpwent(); +#else + DIE(aTHX_ PL_no_func, "getpwent"); +#endif #ifdef HAS_GETSPNAM if (which == OP_GPWNAM) { @@ -4878,7 +4884,7 @@ PP(pp_ggrgid) PP(pp_ggrent) { djSP; -#if defined(HAS_GROUP) && defined(HAS_GETGRENT) +#ifdef HAS_GROUP I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -4890,7 +4896,11 @@ PP(pp_ggrent) else if (which == OP_GGRGID) grent = (struct group *)getgrgid(POPi); else +#ifdef HAS_GETGRENT grent = (struct group *)getgrent(); +#else + DIE(aTHX_ PL_no_func, "getgrent"); +#endif EXTEND(SP, 4); if (GIMME != G_ARRAY) { @@ -10,9 +10,8 @@ START_EXTERN_C #if defined(PERL_IMPLICIT_SYS) PERL_CALLCONV PerlInterpreter* perl_alloc_using(struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p); -#else -PERL_CALLCONV PerlInterpreter* perl_alloc(void); #endif +PERL_CALLCONV PerlInterpreter* perl_alloc(void); PERL_CALLCONV void perl_construct(PerlInterpreter* interp); PERL_CALLCONV void perl_destruct(PerlInterpreter* interp); PERL_CALLCONV void perl_free(PerlInterpreter* interp); @@ -769,6 +768,7 @@ PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt); PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len); PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); PERL_CALLCONV void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); +PERL_CALLCONV NV Perl_str_to_version(pTHX_ SV *sv); PERL_CALLCONV SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none); PERL_CALLCONV UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr); PERL_CALLCONV void Perl_taint_env(pTHX); @@ -820,6 +820,7 @@ PERL_CALLCONV int Perl_yyparse(pTHX); PERL_CALLCONV int Perl_yywarn(pTHX_ char* s); #if defined(MYMALLOC) PERL_CALLCONV void Perl_dump_mstats(pTHX_ char* s); +PERL_CALLCONV int Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level); #endif PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes); PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size); @@ -875,8 +876,10 @@ PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); 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); @@ -884,6 +887,10 @@ PERL_CALLCONV char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv); PERL_CALLCONV char* Perl_sv_pv(pTHX_ SV *sv); PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv); PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_utf8_upgrade(pTHX_ SV *sv); +PERL_CALLCONV bool Perl_sv_utf8_downgrade(pTHX_ SV *sv, bool fail_ok); +PERL_CALLCONV void Perl_sv_utf8_encode(pTHX_ SV *sv); +PERL_CALLCONV bool Perl_sv_utf8_decode(pTHX_ SV *sv); PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv); PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n); PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *sv); @@ -1006,11 +1013,16 @@ STATIC void S_validate_suid(pTHX_ char *, char*, int); # 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 @@ -1027,7 +1039,10 @@ STATIC int S_div128(pTHX_ SV *pnum, bool *done); #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); @@ -1154,12 +1169,6 @@ STATIC void S_del_xrv(pTHX_ XRV* p); STATIC void S_sv_unglob(pTHX_ SV* sv); STATIC void S_not_a_number(pTHX_ SV *sv); STATIC void S_visit(pTHX_ SVFUNC_t f); -# if defined(PURIFY) -STATIC void S_reg_add(pTHX_ SV *sv); -STATIC void S_reg_remove(pTHX_ SV *sv); -# else -STATIC void* S_my_safemalloc(MEM_SIZE size); -# endif STATIC void S_sv_add_backref(pTHX_ SV *tsv, SV *sv); STATIC void S_sv_del_backref(pTHX_ SV *sv); # if defined(DEBUGGING) @@ -277,6 +277,7 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl) STATIC void S_cl_init(pTHX_ struct regnode_charclass_class *cl) { + Zero(cl, 1, struct regnode_charclass_class); cl->type = ANYOF; cl_anything(cl); } @@ -284,10 +285,9 @@ S_cl_init(pTHX_ struct regnode_charclass_class *cl) STATIC void S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl) { + Zero(cl, 1, struct regnode_charclass_class); cl->type = ANYOF; cl_anything(cl); - ANYOF_CLASS_ZERO(cl); - ANYOF_BITMAP_ZERO(cl); if (LOC) cl->flags |= ANYOF_LOCALE; } @@ -765,10 +765,10 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da } 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 @@ -1388,6 +1388,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) char, regexp); if (r == NULL) FAIL("regexp out of space"); +#ifdef DEBUGGING + /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */ + Zero(r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode), char); +#endif r->refcnt = 1; r->prelen = xend - exp; r->precomp = PL_regprecomp; @@ -2202,8 +2206,8 @@ S_regpiece(pTHX_ I32 *flagp) 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); } @@ -2630,8 +2634,8 @@ tryagain: 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); @@ -2822,9 +2826,9 @@ S_regpposixcc(pTHX_ I32 value) 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: @@ -2840,7 +2844,7 @@ S_regpposixcc(pTHX_ I32 value) 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 == '.')) { @@ -2850,10 +2854,10 @@ S_checkposixcc(pTHX) 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); } } @@ -2892,7 +2896,7 @@ S_regclass(pTHX) 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 == '-') @@ -2940,8 +2944,8 @@ S_regclass(pTHX) 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); @@ -2954,8 +2958,8 @@ S_regclass(pTHX) 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, @@ -3239,8 +3243,8 @@ S_regclass(pTHX) 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, @@ -3333,7 +3337,7 @@ S_regclassutf8(pTHX) 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 == '-') @@ -3418,8 +3422,8 @@ S_regclassutf8(pTHX) 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); @@ -3429,8 +3433,8 @@ S_regclassutf8(pTHX) 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, @@ -3517,8 +3521,8 @@ S_regclassutf8(pTHX) 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, @@ -3642,7 +3646,7 @@ S_reguni(pTHX_ UV uv, char* s, I32* lenp) { dTHR; if (SIZE_ONLY) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; *lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf; } else @@ -688,7 +688,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, ? 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) { @@ -1670,7 +1670,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) SAVEDESTRUCTOR_X(restore_pos, 0); } if (!PL_reg_curpm) - New(22,PL_reg_curpm, 1, PMOP); + Newz(22,PL_reg_curpm, 1, PMOP); PL_reg_curpm->op_pmregexp = prog; PL_reg_oldcurpm = PL_curpm; PL_curpm = PL_reg_curpm; @@ -2084,7 +2084,7 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case SPACE: - if (!nextchr && locinput >= PL_regeol) + if (!nextchr) sayNO; if (!(OP(scan) == SPACE ? isSPACE(nextchr) : isSPACE_LC(nextchr))) @@ -2095,11 +2095,11 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case SPACEUTF8: - if (!nextchr && locinput >= PL_regeol) + if (!nextchr) sayNO; if (nextchr & 0x80) { if (!(OP(scan) == SPACEUTF8 - ? swash_fetch(PL_utf8_space,(U8*)locinput) + ? swash_fetch(PL_utf8_space, (U8*)locinput) : isSPACE_LC_utf8((U8*)locinput))) { sayNO; @@ -2117,9 +2117,9 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case NSPACE: - if (!nextchr) + if (!nextchr && locinput >= PL_regeol) sayNO; - if (OP(scan) == SPACE + if (OP(scan) == NSPACE ? isSPACE(nextchr) : isSPACE_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); @@ -2128,11 +2128,11 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case NSPACEUTF8: - if (!nextchr) + if (!nextchr && locinput >= PL_regeol) sayNO; if (nextchr & 0x80) { if (OP(scan) == NSPACEUTF8 - ? swash_fetch(PL_utf8_space,(U8*)locinput) + ? swash_fetch(PL_utf8_space, (U8*)locinput) : isSPACE_LC_utf8((U8*)locinput)) { sayNO; @@ -2150,7 +2150,7 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case DIGIT: - if (!nextchr && locinput >= PL_regeol) + if (!nextchr) sayNO; if (!(OP(scan) == DIGIT ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))) @@ -2164,9 +2164,9 @@ S_regmatch(pTHX_ regnode *prog) if (!nextchr) sayNO; if (nextchr & 0x80) { - if (OP(scan) == NDIGITUTF8 - ? swash_fetch(PL_utf8_digit,(U8*)locinput) - : isDIGIT_LC_utf8((U8*)locinput)) + if (!(OP(scan) == DIGITUTF8 + ? swash_fetch(PL_utf8_digit, (U8*)locinput) + : isDIGIT_LC_utf8((U8*)locinput))) { sayNO; } @@ -2174,7 +2174,8 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; } - if (!isDIGIT(nextchr)) + if (!(OP(scan) == DIGITUTF8 + ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; @@ -2182,9 +2183,9 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case NDIGIT: - if (!nextchr) + if (!nextchr && locinput >= PL_regeol) sayNO; - if (OP(scan) == DIGIT + if (OP(scan) == NDIGIT ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); @@ -2196,13 +2197,18 @@ S_regmatch(pTHX_ regnode *prog) if (!nextchr && locinput >= PL_regeol) sayNO; if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_digit,(U8*)locinput)) + if (OP(scan) == NDIGITUTF8 + ? swash_fetch(PL_utf8_digit, (U8*)locinput) + : isDIGIT_LC_utf8((U8*)locinput)) + { sayNO; + } locinput += PL_utf8skip[nextchr]; nextchr = UCHARAT(locinput); break; } - if (isDIGIT(nextchr)) + if (OP(scan) == NDIGITUTF8 + ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; @@ -2657,10 +2663,10 @@ S_regmatch(pTHX_ regnode *prog) 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); } @@ -2709,10 +2715,10 @@ S_regmatch(pTHX_ regnode *prog) 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); } @@ -3039,8 +3045,14 @@ S_regmatch(pTHX_ regnode *prog) n = regrepeat(scan, n); locinput = PL_reginput; if (ln < n && PL_regkind[(U8)OP(next)] == EOL && - (!PL_multiline || OP(next) == SEOL)) + (!PL_multiline || OP(next) == SEOL || OP(next) == EOS)) { ln = n; /* why back off? */ + /* ...because $ and \Z can match before *and* after + newline at the end. Consider "\n\n" =~ /\n+\Z\n/. + We should back off by one in this case. */ + if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS) + ln--; + } REGCP_SET; if (paren) { while (n >= ln) { @@ -3598,7 +3610,7 @@ S_reginclassutf8(pTHX_ regnode *f, U8 *p) match = TRUE; else if (flags & ANYOF_FOLD) { I32 cf; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; if (flags & ANYOF_LOCALE) { PL_reg_flags |= RF_tainted; uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p)); @@ -16,6 +16,7 @@ #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, ...) @@ -36,8 +37,6 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, 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; @@ -47,6 +46,7 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, JMPENV_POP; return ret; } +#endif SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) @@ -994,8 +994,9 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", PL_op_name[cx->blk_eval.old_op_type], PL_op_desc[cx->blk_eval.old_op_type]); - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", - cx->blk_eval.old_name); + if (cx->blk_eval.old_namesv) + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", + SvPVX(cx->blk_eval.old_namesv)); PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n", PTR2UV(cx->blk_eval.old_eval_root)); break; @@ -193,19 +193,21 @@ struct jmpenv { 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. @@ -219,21 +221,13 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, #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 @@ -265,6 +259,14 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, * 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) @@ -288,10 +290,11 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_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; \ @@ -305,7 +308,10 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, #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) @@ -329,5 +335,38 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile 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)) @@ -25,105 +25,6 @@ static void do_clean_named_objs(pTHXo_ SV *sv); #endif static void do_clean_all(pTHXo_ SV *sv); - -#ifdef PURIFY - -#define new_SV(p) \ - STMT_START { \ - LOCK_SV_MUTEX; \ - (p) = (SV*)safemalloc(sizeof(SV)); \ - reg_add(p); \ - UNLOCK_SV_MUTEX; \ - SvANY(p) = 0; \ - SvREFCNT(p) = 1; \ - SvFLAGS(p) = 0; \ - } STMT_END - -#define del_SV(p) \ - STMT_START { \ - LOCK_SV_MUTEX; \ - reg_remove(p); \ - Safefree((char*)(p)); \ - UNLOCK_SV_MUTEX; \ - } STMT_END - -static SV **registry; -static I32 registry_size; - -#define REGHASH(sv,size) ((((U32)(sv)) >> 2) % (size)) - -#define REG_REPLACE(sv,a,b) \ - STMT_START { \ - void* p = sv->sv_any; \ - I32 h = REGHASH(sv, registry_size); \ - I32 i = h; \ - while (registry[i] != (a)) { \ - if (++i >= registry_size) \ - i = 0; \ - if (i == h) \ - Perl_die(aTHX_ "SV registry bug"); \ - } \ - registry[i] = (b); \ - } STMT_END - -#define REG_ADD(sv) REG_REPLACE(sv,Nullsv,sv) -#define REG_REMOVE(sv) REG_REPLACE(sv,sv,Nullsv) - -STATIC void -S_reg_add(pTHX_ SV *sv) -{ - if (PL_sv_count >= (registry_size >> 1)) - { - SV **oldreg = registry; - I32 oldsize = registry_size; - - registry_size = registry_size ? ((registry_size << 2) + 1) : 2037; - Newz(707, registry, registry_size, SV*); - - if (oldreg) { - I32 i; - - for (i = 0; i < oldsize; ++i) { - SV* oldsv = oldreg[i]; - if (oldsv) - REG_ADD(oldsv); - } - Safefree(oldreg); - } - } - - REG_ADD(sv); - ++PL_sv_count; -} - -STATIC void -S_reg_remove(pTHX_ SV *sv) -{ - REG_REMOVE(sv); - --PL_sv_count; -} - -STATIC void -S_visit(pTHX_ SVFUNC_t f) -{ - I32 i; - - for (i = 0; i < registry_size; ++i) { - SV* sv = registry[i]; - if (sv && SvTYPE(sv) != SVTYPEMASK) - (*f)(sv); - } -} - -void -Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) -{ - if (!(flags & SVf_FAKE)) - Safefree(ptr); -} - -#else /* ! PURIFY */ - /* * "A time to plant, and a time to uproot what was planted..." */ @@ -206,7 +107,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) 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 */ @@ -262,8 +163,6 @@ S_visit(pTHX_ SVFUNC_t f) } } -#endif /* PURIFY */ - void Perl_sv_report_used(pTHX) { @@ -801,125 +700,100 @@ S_more_xpvbm(pTHX) xpvbm->xpv_pv = 0; } -#ifdef PURIFY -#define new_XIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XIV(p) Safefree((char*)p) +#ifdef LEAKTEST +# define my_safemalloc(s) (void*)safexmalloc(717,s) +# define my_safefree(p) safexfree((char*)p) #else -#define new_XIV() (void*)new_xiv() -#define del_XIV(p) del_xiv((XPVIV*) p) +# define my_safemalloc(s) (void*)safemalloc(s) +# define my_safefree(p) safefree((char*)p) #endif #ifdef PURIFY -#define new_XNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XNV(p) Safefree((char*)p) -#else -#define new_XNV() (void*)new_xnv() -#define del_XNV(p) del_xnv((XPVNV*) p) -#endif -#ifdef PURIFY -#define new_XRV() (void*)safemalloc(sizeof(XRV)) -#define del_XRV(p) Safefree((char*)p) -#else -#define new_XRV() (void*)new_xrv() -#define del_XRV(p) del_xrv((XRV*) p) -#endif +#define new_XIV() my_safemalloc(sizeof(XPVIV)) +#define del_XIV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPV() (void*)safemalloc(sizeof(XPV)) -#define del_XPV(p) Safefree((char*)p) -#else -#define new_XPV() (void*)new_xpv() -#define del_XPV(p) del_xpv((XPV *)p) -#endif +#define new_XNV() my_safemalloc(sizeof(XPVNV)) +#define del_XNV(p) my_safefree(p) -#ifdef PURIFY -# define my_safemalloc(s) safemalloc(s) -# define my_safefree(s) safefree(s) -#else -STATIC void* -S_my_safemalloc(MEM_SIZE size) -{ - char *p; - New(717, p, size, char); - return (void*)p; -} -# define my_safefree(s) Safefree(s) -#endif +#define new_XRV() my_safemalloc(sizeof(XRV)) +#define del_XRV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XPVIV(p) Safefree((char*)p) -#else -#define new_XPVIV() (void*)new_xpviv() -#define del_XPVIV(p) del_xpviv((XPVIV *)p) -#endif - -#ifdef PURIFY -#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XPVNV(p) Safefree((char*)p) -#else -#define new_XPVNV() (void*)new_xpvnv() -#define del_XPVNV(p) del_xpvnv((XPVNV *)p) -#endif +#define new_XPV() my_safemalloc(sizeof(XPV)) +#define del_XPV(p) my_safefree(p) +#define new_XPVIV() my_safemalloc(sizeof(XPVIV)) +#define del_XPVIV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV)) -#define del_XPVCV(p) Safefree((char*)p) -#else -#define new_XPVCV() (void*)new_xpvcv() -#define del_XPVCV(p) del_xpvcv((XPVCV *)p) -#endif +#define new_XPVNV() my_safemalloc(sizeof(XPVNV)) +#define del_XPVNV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV)) -#define del_XPVAV(p) Safefree((char*)p) -#else -#define new_XPVAV() (void*)new_xpvav() -#define del_XPVAV(p) del_xpvav((XPVAV *)p) -#endif +#define new_XPVCV() my_safemalloc(sizeof(XPVCV)) +#define del_XPVCV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV)) -#define del_XPVHV(p) Safefree((char*)p) -#else -#define new_XPVHV() (void*)new_xpvhv() -#define del_XPVHV(p) del_xpvhv((XPVHV *)p) -#endif - -#ifdef PURIFY -#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG)) -#define del_XPVMG(p) Safefree((char*)p) -#else -#define new_XPVMG() (void*)new_xpvmg() -#define del_XPVMG(p) del_xpvmg((XPVMG *)p) -#endif - -#ifdef PURIFY -#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV)) -#define del_XPVLV(p) Safefree((char*)p) -#else -#define new_XPVLV() (void*)new_xpvlv() -#define del_XPVLV(p) del_xpvlv((XPVLV *)p) -#endif - -#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV)) -#define del_XPVGV(p) my_safefree((char*)p) +#define new_XPVAV() my_safemalloc(sizeof(XPVAV)) +#define del_XPVAV(p) my_safefree(p) + +#define new_XPVHV() my_safemalloc(sizeof(XPVHV)) +#define del_XPVHV(p) my_safefree(p) -#ifdef PURIFY -#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM)) -#define del_XPVBM(p) Safefree((char*)p) -#else -#define new_XPVBM() (void*)new_xpvbm() -#define del_XPVBM(p) del_xpvbm((XPVBM *)p) -#endif +#define new_XPVMG() my_safemalloc(sizeof(XPVMG)) +#define del_XPVMG(p) my_safefree(p) + +#define new_XPVLV() my_safemalloc(sizeof(XPVLV)) +#define del_XPVLV(p) my_safefree(p) + +#define new_XPVBM() my_safemalloc(sizeof(XPVBM)) +#define del_XPVBM(p) my_safefree(p) + +#else /* !PURIFY */ + +#define new_XIV() (void*)new_xiv() +#define del_XIV(p) del_xiv((XPVIV*) p) + +#define new_XNV() (void*)new_xnv() +#define del_XNV(p) del_xnv((XPVNV*) p) + +#define new_XRV() (void*)new_xrv() +#define del_XRV(p) del_xrv((XRV*) p) + +#define new_XPV() (void*)new_xpv() +#define del_XPV(p) del_xpv((XPV *)p) + +#define new_XPVIV() (void*)new_xpviv() +#define del_XPVIV(p) del_xpviv((XPVIV *)p) + +#define new_XPVNV() (void*)new_xpvnv() +#define del_XPVNV(p) del_xpvnv((XPVNV *)p) + +#define new_XPVCV() (void*)new_xpvcv() +#define del_XPVCV(p) del_xpvcv((XPVCV *)p) + +#define new_XPVAV() (void*)new_xpvav() +#define del_XPVAV(p) del_xpvav((XPVAV *)p) + +#define new_XPVHV() (void*)new_xpvhv() +#define del_XPVHV(p) del_xpvhv((XPVHV *)p) -#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM)) -#define del_XPVFM(p) my_safefree((char*)p) +#define new_XPVMG() (void*)new_xpvmg() +#define del_XPVMG(p) del_xpvmg((XPVMG *)p) + +#define new_XPVLV() (void*)new_xpvlv() +#define del_XPVLV(p) del_xpvlv((XPVLV *)p) + +#define new_XPVBM() (void*)new_xpvbm() +#define del_XPVBM(p) del_xpvbm((XPVBM *)p) + +#endif /* PURIFY */ + +#define new_XPVGV() my_safemalloc(sizeof(XPVGV)) +#define del_XPVGV(p) my_safefree(p) + +#define new_XPVFM() my_safemalloc(sizeof(XPVFM)) +#define del_XPVFM(p) my_safefree(p) -#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO)) -#define del_XPVIO(p) my_safefree((char*)p) +#define new_XPVIO() my_safemalloc(sizeof(XPVIO)) +#define del_XPVIO(p) my_safefree(p) /* =for apidoc sv_upgrade @@ -1261,7 +1135,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen) s = SvPVX(sv); if (newlen > SvLEN(sv)) { /* need more room? */ if (SvLEN(sv) && s) { -#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) +#if defined(MYMALLOC) && !defined(LEAKTEST) STRLEN l = malloced_size((void*)SvPVX(sv)); if (newlen <= l) { SvLEN_set(sv, l); @@ -2340,7 +2214,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv) { - return sv_2pv_nolen(sv); + STRLEN n_a; + return sv_2pvbyte(sv, &n_a); } char * @@ -2352,12 +2227,14 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv) { - return sv_2pv_nolen(sv); + STRLEN n_a; + return sv_2pvutf8(sv, &n_a); } char * Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp) { + sv_utf8_upgrade(sv); return sv_2pv(sv,lp); } @@ -2399,6 +2276,139 @@ Perl_sv_2bool(pTHX_ register SV *sv) } } +void +Perl_sv_utf8_upgrade(pTHX_ register SV *sv) +{ + int hicount; + char *c; + + if (!sv || !SvPOK(sv) || SvUTF8(sv)) + return; + + /* This function could be much more efficient if we had a FLAG + * to signal if there are any hibit chars in the string + */ + hicount = 0; + for (c = SvPVX(sv); c < SvEND(sv); c++) { + if (*c & 0x80) + hicount++; + } + + if (hicount) { + char *src, *dst; + SvGROW(sv, SvCUR(sv) + hicount + 1); + + src = SvEND(sv) - 1; + SvCUR_set(sv, SvCUR(sv) + hicount); + dst = SvEND(sv) - 1; + + while (src < dst) { + if (*src & 0x80) { + dst--; + uv_to_utf8((U8*)dst, (U8)*src--); + dst--; + } + else { + *dst-- = *src--; + } + } + + SvUTF8_on(sv); + } +} + +bool +Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) +{ + if (SvPOK(sv) && SvUTF8(sv)) { + char *c = SvPVX(sv); + char *first_hi = 0; + /* need to figure out if this is possible at all first */ + while (c < SvEND(sv)) { + if (*c & 0x80) { + I32 len; + UV uv = utf8_to_uv((U8*)c, &len); + if (uv >= 256) { + if (fail_ok) + return FALSE; + else { + /* XXX might want to make a callback here instead */ + Perl_croak(aTHX_ "Big byte"); + } + } + if (!first_hi) + first_hi = c; + c += len; + } + else { + c++; + } + } + + if (first_hi) { + char *src = first_hi; + char *dst = first_hi; + while (src < SvEND(sv)) { + if (*src & 0x80) { + I32 len; + U8 u = (U8)utf8_to_uv((U8*)src, &len); + *dst++ = u; + src += len; + } + else { + *dst++ = *src++; + } + } + SvCUR_set(sv, dst - SvPVX(sv)); + } + SvUTF8_off(sv); + } + return TRUE; +} + +void +Perl_sv_utf8_encode(pTHX_ register SV *sv) +{ + sv_utf8_upgrade(sv); + SvUTF8_off(sv); +} + +bool +Perl_sv_utf8_decode(pTHX_ register SV *sv) +{ + if (SvPOK(sv)) { + char *c; + bool has_utf = FALSE; + if (!sv_utf8_downgrade(sv, TRUE)) + return FALSE; + + /* it is actually just a matter of turning the utf8 flag on, but + * we want to make sure everything inside is valid utf8 first. + */ + c = SvPVX(sv); + while (c < SvEND(sv)) { + if (*c & 0x80) { + I32 len; + (void)utf8_to_uv((U8*)c, &len); + if (len == 1) { + /* bad utf8 */ + return FALSE; + } + c += len; + has_utf = TRUE; + } + else { + c++; + } + } + + if (has_utf) + SvUTF8_on(sv); + } + return TRUE; +} + + /* Note: sv_setsv() should not be called with a source string that needs * to be reused, since it may destroy the source string if it is marked * as temporary. @@ -2652,16 +2662,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) 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); @@ -2802,8 +2807,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) } 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); @@ -3081,10 +3086,13 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) STRLEN len; if (!sstr) return; - if (s = SvPV(sstr, len)) + if (s = SvPV(sstr, len)) { + if (SvUTF8(sstr)) + sv_utf8_upgrade(dstr); sv_catpvn(dstr,s,len); - if (SvUTF8(sstr)) - SvUTF8_on(dstr); + if (SvUTF8(sstr)) + SvUTF8_on(dstr); + } } /* @@ -3933,11 +3941,42 @@ C<sv2>. I32 Perl_sv_cmp(pTHX_ register SV *str1, register SV *str2) { - STRLEN cur1 = 0; - char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL; - STRLEN cur2 = 0; - char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL; + STRLEN cur1, cur2; + char *pv1, *pv2; I32 retval; + bool utf1; + + if (str1) { + pv1 = SvPV(str1, cur1); + } + else { + cur1 = 0; + } + + if (str2) { + if (SvPOK(str2)) { + if (SvPOK(str1) && SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) { + /* must upgrade other to UTF8 first */ + if (SvUTF8(str1)) { + sv_utf8_upgrade(str2); + } + else { + sv_utf8_upgrade(str1); + /* refresh pointer and length */ + pv1 = SvPVX(str1); + cur1 = SvCUR(str1); + } + } + pv2 = SvPVX(str2); + cur2 = SvCUR(str2); + } + else { + pv2 = sv_2pv(str2, &cur2); + } + } + else { + cur2 = 0; + } if (!cur1) return cur2 ? -1 : 0; @@ -5083,18 +5122,21 @@ Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp) char * Perl_sv_pvutf8(pTHX_ SV *sv) { + sv_utf8_upgrade(sv); return sv_pv(sv); } char * Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) { + sv_utf8_upgrade(sv); return sv_pvn(sv,lp); } char * Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp) { + sv_utf8_upgrade(sv); return sv_pvn_force(sv,lp); } @@ -5350,6 +5392,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash) STATIC void S_sv_unglob(pTHX_ SV *sv) { + void *xpvmg; + assert(SvTYPE(sv) == SVt_PVGV); SvFAKE_off(sv); if (GvGP(sv)) @@ -5361,6 +5405,13 @@ S_sv_unglob(pTHX_ SV *sv) sv_unmagic(sv, '*'); Safefree(GvNAME(sv)); GvMULTI_off(sv); + + /* need to keep SvANY(sv) in the right arena */ + xpvmg = new_XPVMG(); + StructCopy(SvANY(sv), xpvmg, XPVMG); + del_XPVGV(SvANY(sv)); + SvANY(sv) = xpvmg; + SvFLAGS(sv) &= ~SVTYPEMASK; SvFLAGS(sv) |= SVt_PVMG; } @@ -5678,6 +5729,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV for (p = (char*)pat; p < patend; p = q) { bool alt = FALSE; bool left = FALSE; + bool vectorize = FALSE; + bool utf = FALSE; char fill = ' '; char plus = 0; char intsize = 0; @@ -5688,7 +5741,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV bool is_utf = FALSE; char esignbuf[4]; - U8 utf8buf[10]; + U8 utf8buf[UTF8_MAXLEN]; STRLEN esignlen = 0; char *eptr = Nullch; @@ -5699,6 +5752,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV char ebuf[IV_DIG * 4 + NV_DIG + 32]; /* large enough for "%#.#f" --chip */ /* what about long double NVs? --jhi */ + + SV *vecsv; + U8 *vecstr = Null(U8*); + STRLEN veclen = 0; char c; int i; unsigned base; @@ -5708,6 +5765,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STRLEN have; STRLEN need; STRLEN gap; + char *dotstr = "."; + STRLEN dotstrlen = 1; for (q = p; q < patend && *q != '%'; ++q) ; if (q > p) { @@ -5740,6 +5799,30 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV q++; continue; + case '*': /* printf("%*vX",":",$ipv6addr) */ + if (q[1] != 'v') + break; + q++; + if (args) + vecsv = va_arg(*args, SV*); + else if (svix < svmax) + vecsv = svargs[svix++]; + dotstr = SvPVx(vecsv,dotstrlen); + if (DO_UTF8(vecsv)) + is_utf = TRUE; + /* FALL THROUGH */ + + case 'v': + vectorize = TRUE; + q++; + if (args) + vecsv = va_arg(*args, SV*); + else if (svix < svmax) + vecsv = svargs[svix++]; + vecstr = (U8*)SvPVx(vecsv,veclen); + utf = DO_UTF8(vecsv); + continue; + default: break; } @@ -5875,63 +5958,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } goto string; - case 'v': - if (args) - argsv = va_arg(*args, SV*); - else if (svix < svmax) - argsv = svargs[svix++]; - { - STRLEN len; - U8 *str = (U8*)SvPVx(argsv,len); - I32 vlen = len*3+1; - SV *vsv = NEWSV(73,vlen); - I32 ulen; - I32 vfree = vlen; - U8 *vptr = (U8*)SvPVX(vsv); - STRLEN vcur = 0; - bool utf = DO_UTF8(argsv); - - if (utf) - is_utf = TRUE; - while (len) { - UV uv; - - if (utf) - uv = utf8_to_uv(str, &ulen); - else { - uv = *str; - ulen = 1; - } - str += ulen; - len -= ulen; - eptr = ebuf + sizeof ebuf; - do { - *--eptr = '0' + uv % 10; - } while (uv /= 10); - elen = (ebuf + sizeof ebuf) - eptr; - while (elen >= vfree-1) { - STRLEN off = vptr - (U8*)SvPVX(vsv); - vfree += vlen; - vlen *= 2; - SvGROW(vsv, vlen); - vptr = (U8*)SvPVX(vsv) + off; - } - memcpy(vptr, eptr, elen); - vptr += elen; - *vptr++ = '.'; - vfree -= elen + 1; - vcur += elen + 1; - } - if (vcur) { - vcur--; - vptr[-1] = '\0'; - } - SvCUR_set(vsv,vcur); - eptr = SvPVX(vsv); - elen = vcur; - } - goto string; - case '_': /* * The "%_" hack might have to be changed someday, @@ -5946,6 +5972,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV is_utf = TRUE; string: + vectorize = FALSE; if (has_precis && elen > precis) elen = precis; break; @@ -5969,7 +5996,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* FALL THROUGH */ case 'd': case 'i': - if (args) { + if (vectorize) { + I32 ulen; + if (!veclen) { + vectorize = FALSE; + break; + } + if (utf) + iv = (IV)utf8_to_uv(vecstr, &ulen); + else { + iv = *vecstr; + ulen = 1; + } + vecstr += ulen; + veclen -= ulen; + } + else if (args) { switch (intsize) { case 'h': iv = (short)va_arg(*args, int); break; default: iv = va_arg(*args, int); break; @@ -6035,7 +6077,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV base = 16; uns_integer: - if (args) { + if (vectorize) { + I32 ulen; + vector: + if (!veclen) { + vectorize = FALSE; + break; + } + if (utf) + uv = utf8_to_uv(vecstr, &ulen); + else { + uv = *vecstr; + ulen = 1; + } + vecstr += ulen; + veclen -= ulen; + } + else if (args) { switch (intsize) { case 'h': uv = (unsigned short)va_arg(*args, unsigned); break; default: uv = va_arg(*args, unsigned); break; @@ -6097,13 +6155,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV 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'"); } @@ -6135,6 +6193,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* This is evil, but floating point is even more evil */ + vectorize = FALSE; if (args) nv = va_arg(*args, NV); else @@ -6202,6 +6261,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* SPECIAL */ case 'n': + vectorize = FALSE; i = SvCUR(sv) - origlen; if (args) { switch (intsize) { @@ -6222,6 +6282,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: unknown: + vectorize = FALSE; if (!args && ckWARN(WARN_PRINTF) && (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) { SV *msg = sv_newmortal(); @@ -6260,7 +6321,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV need = (have > width ? have : width); gap = need - have; - SvGROW(sv, SvCUR(sv) + need + 1); + SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1); p = SvEND(sv); if (esignlen && fill == '0') { for (i = 0; i < esignlen; i++) @@ -6286,10 +6347,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV memset(p, ' ', gap); p += gap; } + if (vectorize) { + if (veclen) { + memcpy(p, dotstr, dotstrlen); + p += dotstrlen; + } + else + vectorize = FALSE; /* done iterating over vecstr */ + } if (is_utf) SvUTF8_on(sv); *p = '\0'; SvCUR(sv) = p - SvPVX(sv); + if (vectorize) { + esignlen = 0; + goto vector; + } } } @@ -6884,7 +6957,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max) case CXt_EVAL: ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval; ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type; - ncx->blk_eval.old_name = SAVEPV(cx->blk_eval.old_name); + ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv); ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root; ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text); break; @@ -7797,7 +7870,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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; diff --git a/t/cmd/while.t b/t/cmd/while.t index 46bbdea15a..ecc15eda53 100755 --- a/t/cmd/while.t +++ b/t/cmd/while.t @@ -1,6 +1,6 @@ #!./perl -print "1..19\n"; +print "1..22\n"; open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp."; print tmp "tvi925\n"; @@ -160,3 +160,20 @@ print "ok $i\n"; print "ok $l\n" } } + +$i = 20; +{ + while (1) { + my $x; + print $x if defined $x; + $x = "not "; + print "ok $i\n"; ++$i; + if ($i == 21) { + next; + } + last; + } + continue { + print "ok $i\n"; ++$i; + } +} diff --git a/t/comp/require.t b/t/comp/require.t index d4c9d8ca61..efce899edc 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -7,7 +7,7 @@ BEGIN { # don't make this lexical $i = 1; -print "1..16\n"; +print "1..19\n"; sub do_require { %INC = (); @@ -23,13 +23,31 @@ sub write_file { close REQ; } +eval {require 5.005}; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require 5.005 }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require 5.005; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { + require 5.005 +}; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + # new style version numbers eval { require v5.5.630; }; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; -eval { require v10.0.2; }; +eval { require 10.0.2; }; print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; print "ok ",$i++,"\n"; @@ -37,27 +55,27 @@ eval q{ use v5.5.630; }; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; -eval q{ use v10.0.2; }; +eval q{ use 10.0.2; }; print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; print "ok ",$i++,"\n"; -my $ver = v5.5.630; +my $ver = 5.005_63; eval { require $ver; }; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; -$ver = v10.0.2; +# check inaccurate fp +$ver = 10.2; eval { require $ver; }; -print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; -print "ok ",$i++,"\n"; - -print "not " unless v5.5.1 gt v5.5; +print "# $@\nnot " unless $@ =~ /^Perl v10\.200\.0 required/; print "ok ",$i++,"\n"; -print "not " unless 5.005_01 > v5.5; +$ver = 10.000_02; +eval { require $ver; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; print "ok ",$i++,"\n"; -print "not " unless 5.005_64 - v5.5.640 < 0.0000001; +print "not " unless 5.5.1 gt v5.5; print "ok ",$i++,"\n"; { diff --git a/t/comp/use.t b/t/comp/use.t index 2594f0a547..c3cdb70709 100755 --- a/t/comp/use.t +++ b/t/comp/use.t @@ -5,9 +5,15 @@ BEGIN { unshift @INC, '../lib'; } -print "1..14\n"; +print "1..27\n"; my $i = 1; +eval "use 5.000"; # implicit semicolon +if ($@) { + print STDERR $@,"\n"; + print "not "; +} +print "ok ",$i++,"\n"; eval "use 5.000;"; if ($@) { @@ -97,3 +103,68 @@ print "ok ",$i++,"\n"; print "not " if $INC[0] eq "freda"; print "ok ",$i++,"\n"; + +{ + local $lib::VERSION = 35.36; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + local $lib::VERSION = '35.36'; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + local $lib::VERSION = v35.36; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib version v100\.105 required--this is only version v35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.036/) { + print "not "; + } + print "ok ",$i++,"\n"; +} diff --git a/t/io/pipe.t b/t/io/pipe.t index 826cf7434a..ae890c0402 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -132,22 +132,27 @@ else { print "ok 10\n"; } -# check that status for the correct process is collected -my $zombie = fork or exit 37; -my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; -$SIG{ALRM} = sub { return }; -alarm(1); -my $close = close FH; -if ($? == 13*256 && ! length $close && ! $!) { - print "ok 11\n"; -} else { - print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n"; -}; -my $wait = wait; -if ($? == 37*256 && $wait == $zombie && ! $!) { - print "ok 12\n"; +if ($^O eq 'mpeix') { + print "ok 11 # skipped\n"; + print "ok 12 # skipped\n"; } else { - print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n"; + # check that status for the correct process is collected + my $zombie = fork or exit 37; + my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; + $SIG{ALRM} = sub { return }; + alarm(1); + my $close = close FH; + if ($? == 13*256 && ! length $close && ! $!) { + print "ok 11\n"; + } else { + print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n"; + }; + my $wait = wait; + if ($? == 37*256 && $wait == $zombie && ! $!) { + print "ok 12\n"; + } else { + print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n"; + } } # Test new semantics for missing command in piped open diff --git a/t/lib/charnames.t b/t/lib/charnames.t index 84949896ac..f4d95771c0 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -16,7 +16,7 @@ print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?"; print "ok 1\n"; { - use byte; # UTEST can switch utf8 on + use bytes; # UTEST can switch utf8 on print "# \$res=$res \$\@='$@'\nnot " if $res = eval <<'EOE' diff --git a/t/lib/fields.t b/t/lib/fields.t index 74be2c2a4f..01f93892b0 100755 --- a/t/lib/fields.t +++ b/t/lib/fields.t @@ -90,7 +90,7 @@ my %expect = ( 'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6', ); -print "1..", int(keys %expect)+5, "\n"; +print "1..", int(keys %expect)+7, "\n"; my $testno = 0; while (my($class, $exp) = each %expect) { no strict 'refs'; @@ -117,6 +117,14 @@ eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = ""); print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/; print "ok ", ++$testno, "\n"; +# Slices +@$obj1{"_b1", "b1"} = (17, 29); +print "not " unless "@$obj1[1,2]" eq "17 29"; +print "ok ", ++$testno, "\n"; +@$obj1[1,2] = (44,28); +print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28"; +print "ok ", ++$testno, "\n"; + #fields::_dump(); # check if diff --git a/t/lib/filefind.t b/t/lib/filefind.t index f958b19cad..8e57aec673 100755 --- a/t/lib/filefind.t +++ b/t/lib/filefind.t @@ -21,14 +21,14 @@ finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, "."); my $case = 2; END { - unlink 'FA/FA_ord','FA/FSL','FA/FAA/FAA_ord', - 'FA/FAB/FAB_ord','FA/FAB/FABA/FABA_ord','FB/FB_ord','FB/FBA/FBA_ord'; - rmdir 'FA/FAA'; - rmdir 'FA/FAB/FABA'; - rmdir 'FA/FAB'; - rmdir 'FA'; - rmdir 'FB/FBA'; - rmdir 'FB'; + unlink 'fa/fa_ord','fa/fsl','fa/faa/faa_ord', + 'fa/fab/fab_ord','fa/fab/faba/faba_ord','fb/fb_ord','fb/fba/fba_ord'; + rmdir 'fa/faa'; + rmdir 'fa/fab/faba'; + rmdir 'fa/fab'; + rmdir 'fa'; + rmdir 'fb/fba'; + rmdir 'fb'; } sub Check($) { @@ -55,50 +55,50 @@ sub wanted { print "# '$_' => 1\n"; Check( $Expect{$_} ); delete $Expect{$_}; - $File::Find::prune=1 if $_ eq 'FABA'; + $File::Find::prune=1 if $_ eq 'faba'; } -MkDir( 'FA',0770 ); -MkDir( 'FB',0770 ); -touch('FB/FB_ord'); -MkDir( 'FB/FBA',0770 ); -touch('FB/FBA/FBA_ord'); -CheckDie( symlink('../FB','FA/FSL') ) if $symlink_exists; -touch('FA/FA_ord'); - -MkDir( 'FA/FAA',0770 ); -touch('FA/FAA/FAA_ord'); -MkDir( 'FA/FAB',0770 ); -touch('FA/FAB/FAB_ord'); -MkDir( 'FA/FAB/FABA',0770 ); -touch('FA/FAB/FABA/FABA_ord'); - -%Expect = ('.' => 1, 'FSL' => 1, 'FA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, - 'FABA' => 1, 'FAA' => 1, 'FAA_ord' => 1); -delete $Expect{'FSL'} unless $symlink_exists; -File::Find::find( {wanted => \&wanted, },'FA' ); +MkDir( 'fa',0770 ); +MkDir( 'fb',0770 ); +touch('fb/fb_ord'); +MkDir( 'fb/fba',0770 ); +touch('fb/fba/fba_ord'); +CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists; +touch('fa/fa_ord'); + +MkDir( 'fa/faa',0770 ); +touch('fa/faa/faa_ord'); +MkDir( 'fa/fab',0770 ); +touch('fa/fab/fab_ord'); +MkDir( 'fa/fab/faba',0770 ); +touch('fa/fab/faba/faba_ord'); + +%Expect = ('.' => 1, 'fsl' => 1, 'fa_ord' => 1, 'fab' => 1, 'fab_ord' => 1, + 'faba' => 1, 'faa' => 1, 'faa_ord' => 1); +delete $Expect{'fsl'} unless $symlink_exists; +File::Find::find( {wanted => \&wanted, },'fa' ); Check( scalar(keys %Expect) == 0 ); -%Expect=('FA' => 1, 'FA/FSL' => 1, 'FA/FA_ord' => 1, 'FA/FAB' => 1, - 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, - 'FA/FAB/FABA/FABA_ord' => 1, 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); -delete $Expect{'FA/FSL'} unless $symlink_exists; -File::Find::find( {wanted => \&wanted, no_chdir => 1},'FA' ); +%Expect=('fa' => 1, 'fa/fsl' => 1, 'fa/fa_ord' => 1, 'fa/fab' => 1, + 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, + 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); +delete $Expect{'fa/fsl'} unless $symlink_exists; +File::Find::find( {wanted => \&wanted, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); if ( $symlink_exists ) { - %Expect=('.' => 1, 'FA_ord' => 1, 'FSL' => 1, 'FB_ord' => 1, 'FBA' => 1, - 'FBA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, 'FABA' => 1, 'FAA' => 1, - 'FAA_ord' => 1); + %Expect=('.' => 1, 'fa_ord' => 1, 'fsl' => 1, 'fb_ord' => 1, 'fba' => 1, + 'fba_ord' => 1, 'fab' => 1, 'fab_ord' => 1, 'faba' => 1, 'faa' => 1, + 'faa_ord' => 1); - File::Find::find( {wanted => \&wanted, follow_fast => 1},'FA' ); + File::Find::find( {wanted => \&wanted, follow_fast => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); - %Expect=('FA' => 1, 'FA/FA_ord' => 1, 'FA/FSL' => 1, 'FA/FSL/FB_ord' => 1, - 'FA/FSL/FBA' => 1, 'FA/FSL/FBA/FBA_ord' => 1, 'FA/FAB' => 1, - 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, 'FA/FAB/FABA/FABA_ord' => 1, - 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); - File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'FA' ); + %Expect=('fa' => 1, 'fa/fa_ord' => 1, 'fa/fsl' => 1, 'fa/fsl/fb_ord' => 1, + 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, + 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, + 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); } diff --git a/t/lib/filespec.t b/t/lib/filespec.t index 3aeed17958..9c273d2f26 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -6,38 +6,378 @@ BEGIN { unshift @INC, '../lib'; } -print "1..4\n"; +# Each element in this array is a single test. Storing them this way makes +# maintenance easy, and should be OK since perl should be pretty functional +# before these tests are run. -use File::Spec; +@tests = ( +# Function Expected +[ "Unix->catfile('a','b','c')", 'a/b/c' ], +[ "Unix->splitpath('file')", ',,file' ], +[ "Unix->splitpath('/d1/d2/d3/')", ',/d1/d2/d3/,' ], +[ "Unix->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ], +[ "Unix->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ], +[ "Unix->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ], +[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ], +[ "Unix->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], +[ "Unix->splitpath('/../../d1/')", ',/../../d1/,' ], +[ "Unix->splitpath('/././d1/')", ',/././d1/,' ], -if (File::Spec->catfile('a','b','c') eq 'a/b/c') { - print "ok 1\n"; -} else { - print "not ok 1\n"; -} +[ "Unix->catpath('','','file')", 'file' ], +[ "Unix->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ], +[ "Unix->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ], +[ "Unix->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ], +[ "Unix->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ], +[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ], +[ "Unix->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ], +[ "Unix->catpath('','/../../d1/','')", '/../../d1/' ], +[ "Unix->catpath('','/././d1/','')", '/././d1/' ], +[ "Unix->catpath('d1','d2/d3/','')", 'd2/d3/' ], +[ "Unix->catpath('d1','d2','d3/')", 'd2/d3/' ], -use File::Spec::OS2; +[ "Unix->splitdir('')", '' ], +[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ], +[ "Unix->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ], +[ "Unix->splitdir('/d1/d2/d3')", ',d1,d2,d3' ], +[ "Unix->splitdir('d1/d2/d3')", 'd1,d2,d3' ], -if (File::Spec::OS2->catfile('a','b','c') eq 'a/b/c') { - print "ok 2\n"; -} else { - print "not ok 2\n"; -} +[ "Unix->catdir()", '' ], +[ "Unix->catdir('/')", '/' ], +[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ], +[ "Unix->catdir('d1','d2','d3','')", 'd1/d2/d3' ], +[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ], +[ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ], + +[ "Unix->catfile('a','b','c')", 'a/b/c' ], + +[ "Unix->canonpath('')", '' ], +[ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], +[ "Unix->canonpath('/.')", '/.' ], + +[ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ], +[ "Unix->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], +[ "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], +[ "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ], +#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], +[ "Unix->abs2rel('/','/t1/t2/t3')", '../../..' ], +[ "Unix->abs2rel('///','/t1/t2/t3')", '../../..' ], +[ "Unix->abs2rel('/.','/t1/t2/t3')", '../../../.' ], +[ "Unix->abs2rel('/./','/t1/t2/t3')", '../../..' ], +#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], + +[ "Unix->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ], +[ "Unix->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ], +[ "Unix->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ], +[ "Unix->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ], +[ "Unix->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ], +[ "Unix->rel2abs('/t1','/t1/t2/t3')", '/t1' ], + +[ "Win32->splitpath('file')", ',,file' ], +[ "Win32->splitpath('\\d1/d2\\d3/')", ',\\d1/d2\\d3/,' ], +[ "Win32->splitpath('d1/d2\\d3/')", ',d1/d2\\d3/,' ], +[ "Win32->splitpath('\\d1/d2\\d3/.')", ',\\d1/d2\\d3/.,' ], +[ "Win32->splitpath('\\d1/d2\\d3/..')", ',\\d1/d2\\d3/..,' ], +[ "Win32->splitpath('\\d1/d2\\d3/.file')", ',\\d1/d2\\d3/,.file' ], +[ "Win32->splitpath('\\d1/d2\\d3/file')", ',\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('d1/d2\\d3/file')", ',d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:\\d1/d2\\d3/')", 'C:,\\d1/d2\\d3/,' ], +[ "Win32->splitpath('C:d1/d2\\d3/')", 'C:,d1/d2\\d3/,' ], +[ "Win32->splitpath('C:\\d1/d2\\d3/file')", 'C:,\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:d1/d2\\d3/file')", 'C:,d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:\\../d2\\d3/file')", 'C:,\\../d2\\d3/,file' ], +[ "Win32->splitpath('C:../d2\\d3/file')", 'C:,../d2\\d3/,file' ], +[ "Win32->splitpath('\\../..\\d1/')", ',\\../..\\d1/,' ], +[ "Win32->splitpath('\\./.\\d1/')", ',\\./.\\d1/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')", '\\\\node\\share,\\d1/d2\\d3/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')", '\\\\node\\share,\\d1/d2\\,file' ], +[ "Win32->splitpath('file',1)", ',file,' ], +[ "Win32->splitpath('\\d1/d2\\d3/',1)", ',\\d1/d2\\d3/,' ], +[ "Win32->splitpath('d1/d2\\d3/',1)", ',d1/d2\\d3/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)", '\\\\node\\share,\\d1/d2\\d3/,' ], + +[ "Win32->catpath('','','file')", 'file' ], +[ "Win32->catpath('','\\d1/d2\\d3/','')", '\\d1/d2\\d3/' ], +[ "Win32->catpath('','d1/d2\\d3/','')", 'd1/d2\\d3/' ], +[ "Win32->catpath('','\\d1/d2\\d3/.','')", '\\d1/d2\\d3/.' ], +[ "Win32->catpath('','\\d1/d2\\d3/..','')", '\\d1/d2\\d3/..' ], +[ "Win32->catpath('','\\d1/d2\\d3/','.file')", '\\d1/d2\\d3/.file' ], +[ "Win32->catpath('','\\d1/d2\\d3/','file')", '\\d1/d2\\d3/file' ], +[ "Win32->catpath('','d1/d2\\d3/','file')", 'd1/d2\\d3/file' ], +[ "Win32->catpath('C:','\\d1/d2\\d3/','')", 'C:\\d1/d2\\d3/' ], +[ "Win32->catpath('C:','d1/d2\\d3/','')", 'C:d1/d2\\d3/' ], +[ "Win32->catpath('C:','\\d1/d2\\d3/','file')", 'C:\\d1/d2\\d3/file' ], +[ "Win32->catpath('C:','d1/d2\\d3/','file')", 'C:d1/d2\\d3/file' ], +[ "Win32->catpath('C:','\\../d2\\d3/','file')", 'C:\\../d2\\d3/file' ], +[ "Win32->catpath('C:','../d2\\d3/','file')", 'C:../d2\\d3/file' ], +[ "Win32->catpath('','\\../..\\d1/','')", '\\../..\\d1/' ], +[ "Win32->catpath('','\\./.\\d1/','')", '\\./.\\d1/' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')", '\\\\node\\share\\d1/d2\\d3/' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')", '\\\\node\\share\\d1/d2\\file' ], + +[ "Win32->splitdir('')", '' ], +[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ], +[ "Win32->splitdir('d1/d2\\d3/')", 'd1,d2,d3,' ], +[ "Win32->splitdir('\\d1/d2\\d3')", ',d1,d2,d3' ], +[ "Win32->splitdir('d1/d2\\d3')", 'd1,d2,d3' ], + +[ "Win32->catdir()", '' ], +[ "Win32->catdir('')", '\\' ], +[ "Win32->catdir('/')", '\\' ], +[ "Win32->catdir('//d1','d2')", '\\\\d1\\d2' ], +[ "Win32->catdir('','/d1','d2')", '\\\\d1\\d2' ], +[ "Win32->catdir('','','/d1','d2')", '\\\\\\d1\\d2' ], +[ "Win32->catdir('','//d1','d2')", '\\\\\\d1\\d2' ], +[ "Win32->catdir('','','//d1','d2')", '\\\\\\\\d1\\d2' ], +[ "Win32->catdir('','d1','','d2','')", '\\d1\\d2' ], +[ "Win32->catdir('','d1','d2','d3','')", '\\d1\\d2\\d3' ], +[ "Win32->catdir('d1','d2','d3','')", 'd1\\d2\\d3' ], +[ "Win32->catdir('','d1','d2','d3')", '\\d1\\d2\\d3' ], +[ "Win32->catdir('d1','d2','d3')", 'd1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','d2','d3')", 'A:\\d1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','d2','d3','')", 'A:\\d1\\d2\\d3' ], +#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ], +[ "Win32->catdir('A:/')", 'A:\\' ], + +[ "Win32->catfile('a','b','c')", 'a\\b\\c' ], + +[ "Win32->canonpath('')", '' ], +[ "Win32->canonpath('a:')", 'A:' ], +[ "Win32->canonpath('A:f')", 'A:f' ], +[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ], +[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ], +[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ], +[ "Win32->canonpath('////')", '\\\\\\' ], +[ "Win32->canonpath('//')", '\\' ], +[ "Win32->canonpath('/.')", '\\.' ], +[ "Win32->canonpath('//a/b/../../c')", '\\\\a\\b\\..\\..\\c' ], +[ "Win32->canonpath('//a/../../c')", '\\\\a\\..\\..\\c' ], + +[ "Win32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "Win32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ], +[ "Win32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], +[ "Win32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], +[ "Win32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ], +#[ "Win32->abs2rel('../t4','/t1/t2/t3')", '\\t1\\t2\\t3\\..\\t4' ], +[ "Win32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..\\.' ], +[ "Win32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '..\\t4' ], +[ "Win32->abs2rel('//a/t1/t2/t4','/t2/t3')", '..\\t4' ], + +[ "Win32->rel2abs('temp','C:/')", 'C:\\temp' ], +[ "Win32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ], +[ "Win32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ], +[ "Win32->rel2abs('../','C:/')", 'C:\\..' ], +[ "Win32->rel2abs('../','C:/a')", 'C:\\a\\..' ], +[ "Win32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], +[ "Win32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\..\\temp' ], +[ "Win32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ], +[ "Win32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work\\..' ], + +[ "VMS->splitpath('file')", ',,file' ], +[ "VMS->splitpath('[d1.d2.d3]')", ',d1.d2.d3,' ], +[ "VMS->splitpath('[.d1.d2.d3]')", ',.d1.d2.d3,' ], +[ "VMS->splitpath('[d1.d2.d3]file')", ',d1.d2.d3,file' ], +[ "VMS->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], +[ "VMS->splitpath('/d1/d2/d3/file')", '/d1,/d2/d3/,file' ], +[ "VMS->splitpath('[.d1.d2.d3]file')", ',.d1.d2.d3,file' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,d1.d2.d3,' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,d1.d2.d3,file' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,d1.d2.d3,' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,d1.d2.d3,file' ], + +[ "VMS->catpath('','','file')", 'file' ], +[ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ], +[ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ], +[ "VMS->catpath('','[d1.d2.d3]','file')", '[d1.d2.d3]file' ], +[ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ], +[ "VMS->catpath('','d1/d2/d3','file')", 'd1/d2/d3/file' ], +[ "VMS->catpath('v','d1/d2/d3','file')", 'd1/d2/d3/file' ], +[ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ], +[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ], +[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ], +[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ], + +[ "VMS->canonpath('')", '' ], +# There's no VMS specific canonpath +#[ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], +#[ "VMS->canonpath('LOGICAL:[LOGICAL]LOGICAL')", 'LOGICAL:[VULCAN]LOGICAL' ], +#[ "VMS->canonpath('volume:[d1]d2.dir')", 'volume:[d1.d2]' ], +#[ "VMS->canonpath('volume:[d1]d2.dir;1')", 'volume:[d1.d2]' ], +#[ "VMS->canonpath('volume:[d1.d2.--]file')", 'volume:[d1.d2.-.-]file' ], +[ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], + +[ "VMS->splitdir('')", '' ], +[ "VMS->splitdir('[]')", '' ], +[ "VMS->splitdir('d1.d2.d3')", 'd1,d2,d3' ], +[ "VMS->splitdir('[d1.d2.d3]')", 'd1,d2,d3' ], +[ "VMS->splitdir('.d1.d2.d3')", ',d1,d2,d3' ], +[ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ], +[ "VMS->splitdir('.-.d2.d3')", ',-,d2,d3' ], +[ "VMS->splitdir('[.-.d2.d3]')", ',-,d2,d3' ], + +[ "VMS->catdir('')", '[]' ], +[ "VMS->catdir('d1','d2','d3')", '[d1.d2.d3]' ], +[ "VMS->catdir('d1','d2/','d3')", '[d1.d2.d3]' ], +[ "VMS->catdir('','d1','d2','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], +[ "VMS->catdir('','-','','d3')", '[.-.d3]' ], +[ "VMS->catdir('[]','<->','[]','[d3]')", '[.-.d3]' ], +[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[dir.d2.d3]' ], +[ "VMS->catdir('[.name]')", '[.name]' ], +[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], +[ "VMS->catdir('a:[.name]','b:[.name]')", '[.name.name]'], +[ "VMS->catdir('LOGICAL:[.LOGICAL]LOGICAL','LOGICAL:[.LOGICAL]LOGICAL')", '[.LOGICAL.LOGICAL]'], +[ "VMS->catdir('LOGICAL','LOGICAL')", '[VULCAN.VULCAN]'], + +[ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], +[ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", '[-]file' ], +[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[t4]' ], +[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[-.-.-.t4.t5.t6]' ], +#[ "VMS->abs2rel('[]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[.]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +#[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[-.-.-.b]' ], -use File::Spec::Win32; +[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", '[t1.t2.t3.t4]' ], +[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')", '[t1.t2.t3.t4.t5]' ], +[ "VMS->rel2abs('[]','[t1.t2.t3]')", '[t1.t2.t3]' ], +[ "VMS->rel2abs('[-]','[t1.t2.t3]')", '[t1.t2.t3.-]' ], +[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", '[t1.t2.t3.-.t4]' ], +[ "VMS->rel2abs('[t1]','[t1.t2.t3]')", '[t1]' ], -if (File::Spec::Win32->catfile('a','b','c') eq 'a\b\c') { - print "ok 3\n"; -} else { - print "not ok 3\n"; +[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ], +[ "OS2->catfile('a','b','c')", 'a/b/c' ], + +[ "Mac->splitpath('file')", ',,file' ], +[ "Mac->splitpath(':file')", ',:,file' ], +[ "Mac->splitpath(':d1',1)", ',:d1:,' ], +[ "Mac->splitpath('d1',1)", 'd1:,,' ], +[ "Mac->splitpath('d1:d2:d3:')", 'd1:,d2:d3:,' ], +[ "Mac->splitpath('d1:d2:d3',1)", 'd1:,d2:d3:,' ], +[ "Mac->splitpath(':d1:d2:d3:')", ',:d1:d2:d3:,' ], +[ "Mac->splitpath(':d1:d2:d3:',1)", ',:d1:d2:d3:,' ], +[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ], +[ "Mac->splitpath('d1:d2:d3',1)", 'd1:,d2:d3:,' ], + +[ "Mac->catdir('')", ':' ], +[ "Mac->catdir('d1','d2','d3')", 'd1:d2:d3:' ], +[ "Mac->catdir('d1','d2/','d3')", 'd1:d2/:d3:' ], +[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:' ], +[ "Mac->catdir('','','d2','d3')", '::d2:d3:' ], +[ "Mac->catdir('','','','d3')", ':::d3:' ], +[ "Mac->catdir(':name')", ':name:' ], +[ "Mac->catdir(':name',':name')", ':name:name:' ], + +[ "Mac->catfile('a','b','c')", 'a:b:c' ], + +[ "Mac->canonpath('')", '' ], +[ "Mac->canonpath(':')", ':' ], +[ "Mac->canonpath('::')", '::' ], +[ "Mac->canonpath('a::')", 'a::' ], +[ "Mac->canonpath(':a::')", ':a::' ], + +[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')", ':' ], +[ "Mac->abs2rel('t1:t2','t1:t2:t3')", '::' ], +[ "Mac->abs2rel('t1:t4','t1:t2:t3')", ':::t4' ], +[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')", '::t4' ], +[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4' ], +[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')", '::::t4:t5:t6' ], +[ "Mac->abs2rel('t1','t1:t2:t3')", ':::' ], + +[ "Mac->rel2abs(':t4','t1:t2:t3')", 't1:t2:t3:t4' ], +[ "Mac->rel2abs(':t4:t5','t1:t2:t3')", 't1:t2:t3:t4:t5' ], +[ "Mac->rel2abs('','t1:t2:t3')", '' ], +[ "Mac->rel2abs('::','t1:t2:t3')", 't1:t2:t3::' ], +[ "Mac->rel2abs('::t4','t1:t2:t3')", 't1:t2:t3::t4' ], +[ "Mac->rel2abs('t1','t1:t2:t3')", 't1' ], +) ; + +# Grab all of the plain routines from File::Spec +use File::Spec @File::Spec::EXPORT_OK ; + +require File::Spec::Unix ; +require File::Spec::Win32 ; + +eval { + require VMS::Filespec ; +} ; + +if ( $@ ) { + # Not pretty, but it allows testing of things not implemented soley + # on VMS. It might be better to change File::Spec::VMS to do this, + # making it more usable when running on (say) Unix but working with + # VMS paths. + eval { + sub File::Spec::VMS::unixify { die "unixify() only provided on VMS" } ; + sub File::Spec::VMS::vmspath { die "vmspath() only provided on VMS" } ; + } ; + $INC{"VMS/Filespec.pm"} = 1 ; } +require File::Spec::VMS ; -use File::Spec::Mac; +require File::Spec::OS2 ; +require File::Spec::Mac ; -if (File::Spec::Mac->catfile('a','b','c') eq 'a:b:c') { - print "ok 4\n"; -} else { - print "not ok 4\n"; +print "1..", scalar( @tests ), "\n" ; + +my $current_test= 1 ; + +# Set up for logical interpolation in ::VMS->canonpath() and ::VMS->catdir() +%ENV = ( 'LOGICAL' => 'VULCAN' ) ; + +# Test out the class methods +for ( @tests ) { + tryfunc( @$_ ) ; } + + +# +# Tries a named function with the given args and compares the result against +# an expected result. Works with functions that return scalars or arrays. +# +sub tryfunc { + my $function = shift ; + my $expected = shift ; + + $function =~ s#\\#\\\\#g ; + + my $got ; + if ( $function =~ /^[^\$].*->/ ) { + $got = eval( "join( ',', File::Spec::$function )" ) ; + } + else { + $got = eval( "join( ',', $function )" ) ; + } + + if ( $@ ) { + if ( $@ =~ /only provided on VMS/ ) { + print "ok $current_test # skip $function \n" ; + } + else { + chomp $@ ; + print "not ok $current_test # $function: $@\n" ; + } + } + elsif ( !defined( $got ) || $got ne $expected ) { + print "not ok $current_test # $function: got '$got', expected '$expected'\n" ; + } + else { + print "ok $current_test # $function\n" ; + } + ++$current_test ; +} diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t index dde87730c0..ac3abf56e4 100755 --- a/t/lib/glob-basic.t +++ b/t/lib/glob-basic.t @@ -3,7 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; - + require Config; import Config; + if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { + print "1..0\n"; + exit 0; + } print "1..9\n"; } END { @@ -68,7 +72,7 @@ print "ok 5\n"; # check bad protections # should return an empty list, and set ERROR -if ($^O eq 'MSWin32' or $^O eq 'os2' or not $>) { +if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or not $>) { print "ok 6 # skipped\n"; } else { diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t index 2e65a0fc8b..32719b2d9a 100755 --- a/t/lib/glob-case.t +++ b/t/lib/glob-case.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { + print "1..0\n"; + exit 0; + } print "1..7\n"; } END { diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t index 44d7e8b5c3..9d273bd1ed 100755 --- a/t/lib/glob-global.t +++ b/t/lib/glob-global.t @@ -3,7 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; - + require Config; import Config; + if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { + print "1..0\n"; + exit 0; + } print "1..10\n"; } END { diff --git a/t/lib/glob-taint.t b/t/lib/glob-taint.t index 1b9c053bf7..a8dc213853 100755 --- a/t/lib/glob-taint.t +++ b/t/lib/glob-taint.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { + print "1..0\n"; + exit 0; + } print "1..2\n"; } END { diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 30dcf0f0b7..6f61fb9dad 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -15,5 +15,6 @@ if ($@) { print "1..0\n" if $@ =~ /Cannot get host name/; } else { print "1..1\n"; + print "# \$host = `$host'\n"; print "ok 1\n"; } diff --git a/t/lib/io_poll.t b/t/lib/io_poll.t index c179ce96fb..68ad7b74cb 100755 --- a/t/lib/io_poll.t +++ b/t/lib/io_poll.t @@ -7,6 +7,11 @@ BEGIN { } } +if ($^O eq 'mpeix') { + print "1..0 # Skip: broken on MPE/iX\n"; + exit 0; +} + select(STDERR); $| = 1; select(STDOUT); $| = 1; diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t index 782f2554c8..e03e2235ba 100755 --- a/t/lib/io_sock.t +++ b/t/lib/io_sock.t @@ -169,20 +169,24 @@ $server = IO::Socket->new(Domain => AF_INET, LocalAddr => 'localhost'); $port = $server->sockport; -if ($pid = fork()) { - my $buf; - $server->recv($buf, 100); - print $buf; -} elsif (defined($pid)) { - #child - $sock = IO::Socket::INET->new(Proto => 'udp', - PeerAddr => "localhost:$port"); - $sock->send("ok 12\n"); - sleep(1); - $sock->send("ok 12\n"); # send another one to be sure - exit; +if ($^O eq 'mpeix') { + print("ok 12 # skipped\n") } else { - die; + if ($pid = fork()) { + my $buf; + $server->recv($buf, 100); + print $buf; + } elsif (defined($pid)) { + #child + $sock = IO::Socket::INET->new(Proto => 'udp', + PeerAddr => "localhost:$port"); + $sock->send("ok 12\n"); + sleep(1); + $sock->send("ok 12\n"); # send another one to be sure + exit; + } else { + die; + } } print "not " unless $server->blocking; diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t index 0e559e0d90..62569a5844 100644 --- a/t/lib/io_unix.t +++ b/t/lib/io_unix.t @@ -8,6 +8,7 @@ BEGIN { # ``use IO::Socket'' executes too early below in the os2 block if ($^O eq 'dos') { print "1..0 # Skip: no fork\n"; + exit 0; } } diff --git a/t/lib/posix.t b/t/lib/posix.t index 10c06becbf..abc4563e12 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -14,7 +14,7 @@ use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write); use strict subs; $| = 1; -print "1..26\n"; +print "1..27\n"; $Is_W32 = $^O eq 'MSWin32'; @@ -121,6 +121,7 @@ try_strftime(23, "Mon Mar 01 00:00:00 1999 060", 0,0,24, 28,1,99); try_strftime(24, "Mon Feb 28 00:00:00 2000 059", 0,0,0, 28,1,100); try_strftime(25, "Tue Feb 29 00:00:00 2000 060", 0,0,0, 0,2,100); try_strftime(26, "Wed Mar 01 00:00:00 2000 061", 0,0,0, 1,2,100); +try_strftime(27, "Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100); &POSIX::setlocale(&POSIX::LC_TIME, $lc) if $Config{d_setlocale}; $| = 0; diff --git a/t/lib/safe2.t b/t/lib/safe2.t index 876e7a37db..293b515692 100755 --- a/t/lib/safe2.t +++ b/t/lib/safe2.t @@ -124,7 +124,7 @@ print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n"; my $t = 30; $cpt->rdo('/non/existant/file.name'); # The regexp is getting rather baroque. -print $! =~ /No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found|File or directory doesn't exist/i ? "ok $t\n" : "not ok $t # $!\n"; $t++; +print $! =~ /cannot find|No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found|File or directory doesn't exist/i ? "ok $t\n" : "not ok $t # $!\n"; $t++; # test #31 is gone. print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++; diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 942bb4dad6..3b040dc6ac 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -11,7 +11,7 @@ BEGIN { print "1..0\n# no 64-bit file offsets\n"; exit(0); } - require Fcntl; import Fcntl; + require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/); } sub bye { diff --git a/t/op/64bit.t b/t/op/64bit.t index 09419f8790..f7103af73e 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -145,27 +145,27 @@ print "ok 26\n"; $a = 9223372036854775807; $c = ++$a; -print "not " unless $a == 9223372036854775808; +print "not " unless $a == 9223372036854775808 && $c == $a; print "ok 27\n"; $a = 9223372036854775807; $c = $a + 1; -print "not " unless $a == 9223372036854775808; +print "not " unless $a == 9223372036854775807 && $c == 9223372036854775808; print "ok 28\n"; $a = -9223372036854775808; $c = $a--; -print "not " unless $a == -9223372036854775809; +print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808; print "ok 29\n"; $a = -9223372036854775808; $c = --$a; -print "not " unless $a == -9223372036854775809; +print "not " unless $a == -9223372036854775809 && $c == $a; print "ok 30\n"; $a = -9223372036854775808; $c = $a - 1; -print "not " unless $a == -9223372036854775809; +print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809; print "ok 31\n"; diff --git a/t/op/die_exit.t b/t/op/die_exit.t index 7808d9d7c5..cb0478b9b2 100755 --- a/t/op/die_exit.t +++ b/t/op/die_exit.t @@ -9,6 +9,12 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -e '../lib'; } + +if ($^O eq 'mpeix') { + print "1..0 # Skip: broken on MPE/iX\n"; + exit 0; +} + my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl'; use strict; diff --git a/t/op/exec.t b/t/op/exec.t index 5d014369ba..23e9ec1cec 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -25,8 +25,12 @@ print "not ok 3\n" if system "echo", "ok", "3"; # directly called # these should probably be rewritten to match the examples in perlfunc.pod if (system "true") {print "not ok 4\n";} else {print "ok 4\n";} -if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; } -print "ok 5\n"; +if ($^O eq 'mpeix') { + print "ok 5 # skipped: status broken on MPE/iX\n"; +} else { + if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; } + print "ok 5\n"; +} $rc = system "lskdfj"; if ($rc == 255 << 8 or $rc == -1 and diff --git a/t/op/fork.t b/t/op/fork.t index d82c04ff79..80c0b723b6 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -16,6 +16,11 @@ BEGIN { $ENV{PERL5LIB} = "../lib"; } +if ($^O eq 'mpeix') { + print "1..0 # Skip: fork/status problems on MPE/iX\n"; + exit 0; +} + $|=1; undef $/; diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index 56ddfff866..2fb059d8d8 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -24,7 +24,7 @@ sub subb {"in s"} @INPUT = <DATA>; @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; -print "1..", (9 + @INPUT + @simple_input), "\n"; +print "1..", (10 + @INPUT + @simple_input), "\n"; $ord = 0; sub wrn {"@_"} @@ -96,6 +96,18 @@ print "ok $ord\n"; } +# Chains of assignments + +my ($l1, $l2, $l3, $l4); +my $zzzz = 12; +$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz; + +$ord++; +print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot " + unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13 + and $l2 == 13 and $l3 == 13 and $l4 == 13; +print "ok $ord\n"; + for (@INPUT) { $ord++; ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; diff --git a/t/op/mkdir.t b/t/op/mkdir.t index 4bd1b21c80..cf8e55d75e 100755 --- a/t/op/mkdir.t +++ b/t/op/mkdir.t @@ -1,26 +1,25 @@ #!./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 (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); -print ($! =~ /exist|denied/ ? "ok 3\n" : "# $!\nnot ok 3\n"); +print ($! =~ /cannot move|exist|denied/ ? "ok 3\n" : "# $!\nnot ok 3\n"); print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n"); -print ($! =~ /such|exist|not found/i ? "ok 7\n" : "not ok 7\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"); diff --git a/t/op/numconvert.t b/t/op/numconvert.t index f71fd6c141..1de8ede9fd 100755 --- a/t/op/numconvert.t +++ b/t/op/numconvert.t @@ -50,6 +50,7 @@ my $max_uv2 = sprintf "%u", $max_uv1 ** 6; # 6 is an arbitrary number here my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) { + # see perldelta.pod section 64-bit support print "1..0\n# Unsigned arithmetic is not sane\n"; exit 0; } diff --git a/t/op/ord.t b/t/op/ord.t index bc6d924554..22ff3af4ed 100755 --- a/t/op/ord.t +++ b/t/op/ord.t @@ -1,6 +1,6 @@ #!./perl -print "1..3\n"; +print "1..5\n"; # compile time evaluation @@ -8,9 +8,16 @@ print "1..3\n"; # 193 EBCDIC if (ord('A') == 65 || ord('A') == 193) {print "ok 1\n";} else {print "not ok 1\n";} +print "not " unless ord(chr(500)) == 500; +print "ok 2\n"; + # run time evaluation $x = 'ABC'; -if (ord($x) == 65 || ord($x) == 193) {print "ok 2\n";} else {print "not ok 2\n";} +if (ord($x) == 65 || ord($x) == 193) {print "ok 3\n";} else {print "not ok 3\n";} + +if (chr 65 eq 'A' || chr 193 eq 'A') {print "ok 4\n";} else {print "not ok 4\n";} -if (chr 65 == 'A' || chr 193 == 'A') {print "ok 3\n";} else {print "not ok 3\n";} +$x = 500; +print "not " unless ord(chr($x)) == $x; +print "ok 5\n"; diff --git a/t/op/pat.t b/t/op/pat.t index 9f685502f2..142b82e2ad 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..195\n"; +print "1..210\n"; BEGIN { chdir 't' if -d 't'; @@ -905,3 +905,89 @@ $text = "abc dbf"; print "ok $test\n"; $test++; +@a = map chr,0..255; + +@b = grep(/\S/,@a); +@c = grep(/[^\s]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\S/,@a); +@c = grep(/[\S]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\s/,@a); +@c = grep(/[^\S]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\s/,@a); +@c = grep(/[\s]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\D/,@a); +@c = grep(/[^\d]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\D/,@a); +@c = grep(/[\D]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\d/,@a); +@c = grep(/[^\D]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\d/,@a); +@c = grep(/[\d]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\W/,@a); +@c = grep(/[^\w]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\W/,@a); +@c = grep(/[\W]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\w/,@a); +@c = grep(/[^\W]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +@b = grep(/\w/,@a); +@c = grep(/[\w]/,@a); +print "not " if "@b" ne "@c"; +print "ok $test\n"; +$test++; + +# see if backtracking optimization works correctly +"\n\n" =~ /\n $ \n/x or print "not "; +print "ok $test\n"; +$test++; + +"\n\n" =~ /\n* $ \n/x or print "not "; +print "ok $test\n"; +$test++; + +"\n\n" =~ /\n+ $ \n/x or print "not "; +print "ok $test\n"; +$test++; diff --git a/t/op/split.t b/t/op/split.t index 7f0accea5e..042f151f33 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -52,7 +52,7 @@ else { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` } if ($foo =~ /DCL-W-NOCOMD/) { $foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`; } -print $foo =~ /DEBUGGING/ || $foo =~ /SV = IV\(3\)/ ? "ok 11\n" : "not ok 11\n"; +print $foo =~ /DEBUGGING/ || $foo =~ /SV = (VOID|IV\(3\))/ ? "ok 11\n" : "not ok 11\n"; # Can we say how many fields to split to when assigning to a list? ($a,$b) = split(' ','1 2 3 4 5 6', 2); diff --git a/t/op/stat.t b/t/op/stat.t index 37237f0bdf..af4920cd43 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -32,17 +32,22 @@ if (open(FOO, ">Op.stat.tmp")) { else { print "# res=$res, nlink=$nlink.\nnot ok 1\n"; } - if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) { + if ($Is_MSWin32 or $Is_Cygwin || ($mtime && $mtime == $ctime)) { print "ok 2\n"; } else { print "# |$mtime| vs |$ctime|\nnot ok 2\n"; } + my $funky_FAT_timestamps = $Is_Cygwin; + + sleep 3 if $funky_FAT_timestamps; + print FOO "Now is the time for all good men to come to.\n"; close(FOO); - sleep 2; + sleep 2 unless $funky_FAT_timestamps; + } else { print "# open failed: $!\nnot ok 1\nnot ok 2\n"; } @@ -62,7 +67,8 @@ elsif ($nlink == 2) else {print "# \$nlink is |$nlink|\nnot ok 3\n";} if ( $Is_Dosish - || ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime) # Solaris tmpfs bug + # Solaris tmpfs bug + || ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime && $^O eq 'solaris') || $cwd =~ m#/afs/# || $^O eq 'amigaos') { print "ok 4 # skipped: different semantic of mtime/ctime\n"; @@ -164,7 +170,7 @@ else {print "not ok 33\n";} if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} -if ($^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) { +if ($^O eq 'mpeix' or $^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) { print "ok 35 # skipped: no -u\n"; goto tty_test; } diff --git a/t/op/substr.t b/t/op/substr.t index 8d31a9ae61..5764e67e7a 100755 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -1,12 +1,14 @@ -#!./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++; @@ -19,139 +21,198 @@ $SIG{__WARN__} = sub { } }; -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) @@ -160,58 +221,50 @@ for (0,1) { 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'; diff --git a/t/op/ver.t b/t/op/ver.t index e05264682c..b08849f53a 100755 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -5,7 +5,7 @@ BEGIN { unshift @INC, "../lib"; } -print "1..6\n"; +print "1..22\n"; my $test = 1; @@ -13,21 +13,84 @@ use v5.5.640; require v5.5.640; print "ok $test\n"; ++$test; +# printing characters should work +print v111; +print v107.32; +print "$test\n"; ++$test; + +# hash keys too +$h{v111.107} = "ok"; +print "$h{ok} $test\n"; ++$test; + +# poetry optimization should also +sub v77 { "ok" } +$x = v77; +print "$x $test\n"; ++$test; + +# but not when dots are involved +$x = v77.78.79; +print "not " unless $x eq "MNO"; +print "ok $test\n"; ++$test; + print "not " unless v1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}"; print "ok $test\n"; ++$test; -print "not " unless v1.20.300.4000 > 1.0203039 and v1.20.300.4000 < 1.0203041; +# +# now do the same without the "v" +use 5.5.640; +require 5.5.640; +print "ok $test\n"; ++$test; + +# hash keys too +$h{111.107.32} = "ok"; +print "$h{ok } $test\n"; ++$test; + +$x = 77.78.79; +print "not " unless $x eq "MNO"; +print "ok $test\n"; ++$test; + +print "not " unless 1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}"; +print "ok $test\n"; ++$test; + +# test sprintf("%vd"...) etc +print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108'; +print "ok $test\n"; ++$test; + +print "not " unless sprintf("%vd", v1.22.333.4444) eq '1.22.333.4444'; print "ok $test\n"; ++$test; -print "not " unless sprintf("%v", "Perl") eq '80.101.114.108'; +print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c'; print "ok $test\n"; ++$test; -print "not " unless sprintf("%v", v1.22.333.4444) eq '1.22.333.4444'; +print "not " unless sprintf("%vX", 1.22.333.4444) eq '1.16.14D.115C'; +print "ok $test\n"; ++$test; + +print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154'; +print "ok $test\n"; ++$test; + +print "not " unless sprintf("%*vb", "##", v1.22.333.4444) + eq '1##10110##101001101##1000101011100'; print "ok $test\n"; ++$test; { - use byte; + use bytes; + print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108'; + print "ok $test\n"; ++$test; + print "not " unless - sprintf("%v", v1.22.333.4444) eq '1.22.197.141.225.133.156'; + sprintf("%vd", 1.22.333.4444) eq '1.22.197.141.225.133.156'; + print "ok $test\n"; ++$test; + + print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c'; + print "ok $test\n"; ++$test; + + print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.C5.8D.E1.85.9C'; + print "ok $test\n"; ++$test; + + print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154'; + print "ok $test\n"; ++$test; + + print "not " unless sprintf("%*vb", "##", v1.22.333.4444) + eq '1##10110##11000101##10001101##11100001##10000101##10011100'; print "ok $test\n"; ++$test; } diff --git a/t/op/write.t b/t/op/write.t index 9918b2f57f..87d50429f4 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $ - -print "1..6\n"; +print "1..8\n"; my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; @@ -190,3 +188,16 @@ if (`$CAT Op_write.tmp` eq $right) else { print "not ok 6\n"; } +# test lexicals and globals +{ + my $this = "ok"; + our $that = 7; + format LEX = +@<<@| +$this,$that +. + open(LEX, ">&STDOUT") or die; + write LEX; + $that = 8; + write LEX; +} diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t index e27130ce39..bec2a198b6 100755 --- a/t/pod/poderrs.t +++ b/t/pod/poderrs.t @@ -36,6 +36,11 @@ Camps is very, entertaining. And they say we'll have some fun if it stops raining! +Okay, now use a non-empty blank line to terminate a paragraph and make +sure we get a warning. + +The above blank line contains tabs and spaces only + =head1 Additional tests =head2 item without over diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr index 157d1306ba..2848faa46a 100644 --- a/t/pod/poderrs.xr +++ b/t/pod/poderrs.xr @@ -1,32 +1,33 @@ -*** ERROR: Unknown command "unknown1" at line 21 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "Q" at line 25 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "A" at line 26 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "Y" at line 27 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t -** Unterminated B<...> at pod/poderrs.t line 31 -** Unterminated I<...> at pod/poderrs.t line 30 -** Unterminated C<...> at pod/poderrs.t line 33 -*** ERROR: =item without previous =over at line 43 in file pod/poderrs.t -*** ERROR: =over on line 43 without closing =back (at head2) at line 45 in file pod/poderrs.t -*** ERROR: =back without previous =over at line 47 in file pod/poderrs.t -*** ERROR: =over on line 51 without closing =back (at head2) at line 55 in file pod/poderrs.t -*** ERROR: =end without =begin at line 57 in file pod/poderrs.t -*** ERROR: Nested =begin's (first at line 61:html) at line 63 in file pod/poderrs.t -*** ERROR: =end without =begin at line 67 in file pod/poderrs.t -*** ERROR: nested commands C<...C<...>...> at line 71 in file pod/poderrs.t -*** ERROR: garbled entity E<alea iacta est> at line 75 in file pod/poderrs.t -*** ERROR: garbled entity E<C<auml>> at line 76 in file pod/poderrs.t -*** ERROR: garbled entity E<abcI<bla>> at line 77 in file pod/poderrs.t -*** WARNING: collapsing newlines to blanks at line 87 in file pod/poderrs.t -*** ERROR: malformed link L<> : empty link at line 89 in file pod/poderrs.t -*** WARNING: section in `passwd(5)' deprecated at line 94 in file pod/poderrs.t -*** WARNING: ignoring leading whitespace in link at line 95 in file pod/poderrs.t -*** WARNING: ignoring trailing whitespace in link at line 95 in file pod/poderrs.t -*** WARNING: Spurious character(s) after =back at line 101 in file pod/poderrs.t -*** WARNING: No items in =over (at line 109) / =back list at line 111 in file pod/poderrs.t -*** WARNING: 2 unescaped <> in paragraph at line 113 in file pod/poderrs.t -*** ERROR: unresolved internal link `begin or begin' at line 81 in file pod/poderrs.t -*** ERROR: unresolved internal link `end with begin' at line 82 in file pod/poderrs.t -*** ERROR: unresolved internal link `OoPs' at line 83 in file pod/poderrs.t -*** ERROR: unresolved internal link `abc def' at line 87 in file pod/poderrs.t -pod/poderrs.t has 24 pod syntax errors. +*** ERROR: Unknown command 'unknown1' at line 21 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'Q' at line 25 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'A' at line 26 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'Y' at line 27 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'V' at line 27 in file pod/poderrs.t +*** WARNING: unterminated B<...> at line 31 in file pod/poderrs.t +*** WARNING: unterminated I<...> at line 30 in file pod/poderrs.t +*** WARNING: unterminated C<...> at line 33 in file pod/poderrs.t +*** WARNING: line containing nothing but whitespace in paragraph at line 41 in file pod/poderrs.t +*** ERROR: =item without previous =over at line 48 in file pod/poderrs.t +*** ERROR: =back without previous =over at line 52 in file pod/poderrs.t +*** ERROR: =over on line 56 without closing =back (at head2) at line 60 in file pod/poderrs.t +*** ERROR: =end without =begin at line 62 in file pod/poderrs.t +*** ERROR: Nested =begin's (first at line 66:html) at line 68 in file pod/poderrs.t +*** ERROR: =end without =begin at line 72 in file pod/poderrs.t +*** ERROR: nested commands C<...C<...>...> at line 76 in file pod/poderrs.t +*** ERROR: garbled entity E<alea iacta est> at line 80 in file pod/poderrs.t +*** ERROR: garbled entity E<C<auml>> at line 81 in file pod/poderrs.t +*** ERROR: garbled entity E<abcI<bla>> at line 82 in file pod/poderrs.t +*** WARNING: collapsing newlines to blanks at line 92 in file pod/poderrs.t +*** ERROR: malformed link L<> : empty link at line 94 in file pod/poderrs.t +*** WARNING: ignoring leading whitespace in link at line 100 in file pod/poderrs.t +*** WARNING: ignoring trailing whitespace in link at line 100 in file pod/poderrs.t +*** ERROR: Spurious character(s) after =back at line 106 in file pod/poderrs.t +*** WARNING: No items in =over (at line 114) / =back list at line 116 in file pod/poderrs.t +*** WARNING: 2 unescaped <> in paragraph at line 118 in file pod/poderrs.t +*** ERROR: unresolved internal link 'begin or begin' at line 86 in file pod/poderrs.t +*** ERROR: unresolved internal link 'end with begin' at line 87 in file pod/poderrs.t +*** ERROR: unresolved internal link 'OoPs' at line 88 in file pod/poderrs.t +*** ERROR: unresolved internal link 'abc def' at line 92 in file pod/poderrs.t +*** ERROR: unresolved internal link 'passwd(5)' at line 99 in file pod/poderrs.t +*** WARNING: multiple occurence of link target 'oops' at line - in file pod/poderrs.t +pod/poderrs.t has 22 pod syntax errors. diff --git a/t/pod/special_seqs.t b/t/pod/special_seqs.t index 572fb8c061..b8af57ee05 100755 --- a/t/pod/special_seqs.t +++ b/t/pod/special_seqs.t @@ -17,10 +17,16 @@ __END__ =pod This is a test to see if I can do not only C<$self> and C<method()>, but -also C<$self->method()> and C<$self->{FIELDNAME}> and C<{FOO=>BAR}> without -resorting to escape sequences. +also C<< $self->method() >> and C<< $self->{FIELDNAME} >> and +C<< $Foo <=> $Bar >> without resorting to escape sequences. If +I want to refer to the right-shift operator I can do something +like C<<< $x >> 3 >>> or even C<<<< $y >> 5 >>>>. -Now for the grand finale of C<$self->method()->{FIELDNAME} = {FOO=>BAR}>. +Now for the grand finale of C<< $self->method()->{FIELDNAME} = {FOO=>BAR} >>. +And I also want to make sure that newlines work like this +C<<< +$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b] +>>> Of course I should still be able to do all this I<with> escape sequences too: C<$self-E<gt>method()> and C<$self-E<gt>{FIELDNAME}> and C<{FOO=E<gt>BAR}>. @@ -29,4 +35,9 @@ Dont forget C<$self-E<gt>method()-E<gt>{FIELDNAME} = {FOO=E<gt>BAR}>. And make sure that C<0> works too! +Now, if I use << or >> as my delimiters, then I have to use whitespace. +So things like C<<$self->method()>> and C<<$self->{FIELDNAME}>> wont end +up doing what you might expect since the first > will still terminate +the first < seen. + =cut diff --git a/t/pod/special_seqs.xr b/t/pod/special_seqs.xr index fc06593d9d..a07f4cf417 100644 --- a/t/pod/special_seqs.xr +++ b/t/pod/special_seqs.xr @@ -1,8 +1,12 @@ This is a test to see if I can do not only `$self' and `method()', but - also `$self->method()' and `$self->{FIELDNAME}' and `{FOO=>BAR}' without - resorting to escape sequences. + also `$self->method()' and `$self->{FIELDNAME}' and `$Foo <=> $Bar' + without resorting to escape sequences. If I want to refer to the + right-shift operator I can do something like `$x >> 3' or even `$y >> + 5'. Now for the grand finale of `$self->method()->{FIELDNAME} = {FOO=>BAR}'. + And I also want to make sure that newlines work like this + `$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]' Of course I should still be able to do all this *with* escape sequences too: `$self->method()' and `$self->{FIELDNAME}' and `{FOO=>BAR}'. @@ -11,3 +15,8 @@ And make sure that `0' works too! + Now, if I use << or >> as my delimiters, then I have to use whitespace. + So things like `<$self-'method()>> and `<$self-'{FIELDNAME}>> wont end + up doing what you might expect since the first > will still terminate + the first < seen. + diff --git a/t/pragma/warn/9enabled b/t/pragma/warn/9enabled new file mode 100755 index 0000000000..1ecf24a0c0 --- /dev/null +++ b/t/pragma/warn/9enabled @@ -0,0 +1,390 @@ +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 +]] diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop index c16e24f919..5803b44581 100644 --- a/t/pragma/warn/doop +++ b/t/pragma/warn/doop @@ -1,29 +1,6 @@ - doop.c AOK - - \x%s will produce malformed UTF-8 character; use \x{%s} for that - - -__END__ # doop.c use utf8 ; $_ = "\x80 \xff" ; chop ; EXPECT ######## -# doop.c -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# Character codes differ on ebcdic machines."; - exit 0; - } -} -use warnings 'utf8' ; -use utf8 ; -$_ = "\x80 \xff" ; -chop ; -no warnings 'utf8' ; -$_ = "\x80 \xff" ; -chop ; -EXPECT -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 10. -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 9a278effe9..d70a333bbc 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -58,8 +58,8 @@ Parentheses missing around "local" list at -e line 1. local $a, $b = (1,2); - Probable precedence problem on logical or at -e line 1. - use warnings 'syntax'; my $x = print(ABC || 1); + Bareword found in conditional at -e line 1. + use warnings 'bareword'; my $x = print(ABC || 1); Value of %s may be \"0\"; use \"defined\" $x = 1 if $x = <FH> ; @@ -117,16 +117,16 @@ __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 { @@ -137,7 +137,7 @@ EXPECT Variable "$x" will not stay shared at - line 7. ######## # op.c -no warnings 'unsafe' ; +no warnings 'closure' ; sub x { my $x; sub y { @@ -148,7 +148,7 @@ EXPECT ######## # op.c -use warnings 'unsafe' ; +use warnings 'closure' ; sub x { my $x; sub y { @@ -159,7 +159,7 @@ EXPECT Variable "$x" may be unavailable at - line 6. ######## # op.c -no warnings 'unsafe' ; +no warnings 'closure' ; sub x { my $x; sub y { @@ -559,7 +559,7 @@ Useless use of a constant in void context at - line 4. ######## # 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/ ; @@ -574,7 +574,7 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; %$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/ ; @@ -622,65 +622,65 @@ EXPECT 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 -Probable precedence problem on logical or (||) at - line 3. +Bareword found in conditional at - line 3. ######## --FILE-- abc --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 @@ -717,17 +717,17 @@ 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. @@ -779,10 +779,10 @@ $^W = 0 ; sub fred() ; sub fred($) {} { - no warnings 'unsafe' ; + no warnings 'prototype' ; sub Fred() ; sub Fred($) {} - use warnings 'unsafe' ; + use warnings 'prototype' ; sub freD() ; sub freD($) {} } @@ -800,10 +800,10 @@ EXPECT /---/ 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 diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp index 4c70fd5d6f..8f42ba64ec 100644 --- a/t/pragma/warn/pp +++ b/t/pragma/warn/pp @@ -1,7 +1,7 @@ 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 @@ -28,19 +28,14 @@ Constant subroutine %s undefined <<<TODO Constant subroutine (anonymous) undefined <<<TODO - Mandatory Warnings - ------------------ - Malformed UTF-8 character (not tested: difficult to produce with - perl now) - __END__ # 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. ######## @@ -61,23 +56,25 @@ EXPECT ######## # 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' ; @@ -89,18 +86,18 @@ EXPECT 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. @@ -111,20 +108,3 @@ $_ = "\x80 \xff" ; reverse ; EXPECT ######## -# pp.c -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# Character codes differ on ebcdic machines."; - exit 0; - } -} -use warnings 'utf8' ; -use utf8 ; -$_ = "\x80 \xff" ; -reverse ; -no warnings 'utf8' ; -$_ = "\x80 \xff" ; -reverse ; -EXPECT -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 10. -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl index f61da1a8e1..0deccd35e2 100644 --- a/t/pragma/warn/pp_ctl +++ b/t/pragma/warn/pp_ctl @@ -81,14 +81,14 @@ EXPECT 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 ; @@ -97,10 +97,10 @@ EXPECT 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 @@ -108,35 +108,35 @@ Exiting subroutine via last at - line 3. ######## # 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 ; @@ -145,10 +145,10 @@ EXPECT 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 @@ -156,19 +156,19 @@ Exiting subroutine via last at - line 3. ######## # 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. @@ -198,7 +198,7 @@ fred() EXPECT ######## # pp_ctl.c -use warnings 'unsafe' ; +use warnings 'misc' ; package Foo; DESTROY { die "@{$_[0]} foo bar" } { bless ['A'], 'Foo' for 1..10 } @@ -208,7 +208,7 @@ EXPECT (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 } diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 312f7da9b2..0cbbc439ad 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -114,17 +114,17 @@ EXPECT 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. @@ -205,7 +205,7 @@ $b = sub EXPECT ######## # pp_hot.c [pp_concat] -use warnings 'misc'; +use warnings 'y2k'; use Config; BEGIN { unless ($Config{ccflags} =~ /Y2KWARN/) { @@ -219,7 +219,7 @@ $x = "19$yy\n"; $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 diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index bb208db6bd..7d485f2efd 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -7,7 +7,7 @@ $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] @@ -25,33 +25,34 @@ __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.]/; @@ -60,7 +61,7 @@ $_ = "" ; /[[.foo.]]/; /[[=bar=]]/; /[:zog:]/; -no warnings 'unsafe' ; +no warnings 'regexp' ; /[:alpha:]/; /[.foo.]/; /[=bar=]/; @@ -83,7 +84,7 @@ Character class [:zog:] unknown at - line 20. ######## # regcomp.c [S_regclass] $_ = ""; -use warnings 'unsafe' ; +use warnings 'regexp' ; /[a-b]/; /[a-\d]/; /[\d-b]/; @@ -93,7 +94,7 @@ use warnings 'unsafe' ; /[[:digit:]-b]/; /[[:alpha:]-[:digit:]]/; /[[:digit:]-[:alpha:]]/; -no warnings 'unsafe' ; +no warnings 'regexp' ; /[a-b]/; /[a-\d]/; /[\d-b]/; @@ -122,7 +123,7 @@ BEGIN { } use utf8; $_ = ""; -use warnings 'unsafe' ; +use warnings 'regexp' ; /[a-b]/; /[a-\d]/; /[\d-b]/; @@ -132,7 +133,7 @@ use warnings 'unsafe' ; /[[:digit:]-b]/; /[[:alpha:]-[:digit:]]/; /[[:digit:]-[:alpha:]]/; -no warnings 'unsafe' ; +no warnings 'regexp' ; /[a-b]/; /[a-\d]/; /[\d-b]/; @@ -153,9 +154,9 @@ EXPECT /[[: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. diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec index b9ba790832..73696dfb1d 100644 --- a/t/pragma/warn/regexec +++ b/t/pragma/warn/regexec @@ -16,7 +16,7 @@ __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}; @@ -42,7 +42,7 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. ######## # 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}; @@ -68,7 +68,7 @@ EXPECT ######## # 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}; @@ -94,7 +94,7 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. ######## # 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}; diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index cdec48e2c2..758137f2e8 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -261,34 +261,15 @@ Invalid conversion in printf: end of string at - line 6. 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. ######## # sv.c -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# ebcdic \\x characters differ."; - exit 0; - } -} -use utf8 ; -$^W =0 ; -{ - use warnings 'utf8' ; - my $a = rindex "a\xff bc ", "bc" ; - no warnings 'utf8' ; - $a = rindex "a\xff bc ", "bc" ; -} -my $a = rindex "a\xff bc ", "bc" ; -EXPECT -\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/) { @@ -305,7 +286,7 @@ $x = printf " 19%02d\n", 78; $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; diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index 48f97dd10c..cfdea78d3c 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -52,7 +52,7 @@ toke.c AOK 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 @@ -89,10 +89,6 @@ toke.c AOK sub time {} my $a = time() - \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that - use utf8 ; - $_ = "\xffe" - Unrecognized escape \\%c passed through $a = "\m" ; @@ -300,33 +296,33 @@ EXPECT 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. @@ -417,10 +413,10 @@ Misplaced _ in number at - line 4. 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 @@ -447,21 +443,6 @@ EXPECT ######## # toke.c -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; - exit 0; - } -} -use warnings 'utf8' ; -use utf8 ; -$_ = " \xffe " ; -no warnings 'utf8' ; -$_ = " \xffe " ; -EXPECT -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. -######## -# toke.c my $a = rand + 4 ; EXPECT Warning: Use of "rand" without parens is ambiguous at - line 2. @@ -512,9 +493,9 @@ Precedence problem: open FOO should be open(FOO) at - line 2. $^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; @@ -542,9 +523,9 @@ Operator or semicolon missing before *foo at - line 10. 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. diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8 index cb1f202b8d..6a2fe5446c 100644 --- a/t/pragma/warn/utf8 +++ b/t/pragma/warn/utf8 @@ -14,48 +14,16 @@ <<<<<< Add a test when somethig actually calls utf16_to_utf8 __END__ -# utf8.c [utf8_to_uv] +# utf8.c [utf8_to_uv] -W use utf8 ; -my $a = ord "\x80" ; -EXPECT -######## -# utf8.c [utf8_to_uv] -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; - exit 0; - } -} -use utf8 ; -my $a = ord "\x80" ; +my $a = "snøstorm" ; { - use warnings 'utf8' ; - my $a = ord "\x80" ; no warnings 'utf8' ; - my $a = ord "\x80" ; -} -EXPECT -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 12. -######## -# utf8.c [utf8_to_uv] -use utf8 ; -my $a = ord "\xf080" ; -EXPECT -######## -# utf8.c [utf8_to_uv] -BEGIN { - if (ord("\t") == 5) { - print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; - exit 0; - } -} -use utf8 ; -my $a = ord "\xf080" ; -{ + my $a = "snøstorm"; use warnings 'utf8' ; - my $a = ord "\xf080" ; - no warnings 'utf8' ; - my $a = ord "\xf080" ; + my $a = "snøstorm"; } EXPECT -\xf0 will produce malformed UTF-8 character; use \x{f0} for that at - line 12. +Malformed UTF-8 character at - line 3. +Malformed UTF-8 character at - line 8. +######## diff --git a/t/pragma/warnings.t b/t/pragma/warnings.t index 73e4c8d1a8..41324e68cc 100644 --- a/t/pragma/warnings.t +++ b/t/pragma/warnings.t @@ -88,6 +88,8 @@ for (@prgs){ # bison says 'parse error' instead of 'syntax error', # various yaccs may or may not capitalize 'syntax'. $results =~ s/^(syntax|parse) error/syntax error/mig; + # allow all tests to run when there are leaks + $results =~ s/Scalars leaked: \d+\n//g; $expected =~ s/\n+$//; my $prefix = ($results =~ s/^PREFIX\n//) ; # any special options? (OPTIONS foo bar zap) @@ -10,10 +10,7 @@ * * 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) */ @@ -112,7 +109,9 @@ PERLVAR(Tmainstack, AV *) /* the stack when nothing funny is happening */ 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 */ @@ -58,13 +58,6 @@ static void restore_rsfp(pTHXo_ void *f); #define LEX_FORMLINE 1 #define LEX_KNOWNEXT 0 -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif - /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD # include <unistd.h> /* Needed for execv() */ @@ -464,17 +457,22 @@ S_incline(pTHX_ char *s) dTHR; char *t; char *n; + char *e; char ch; - int sawline = 0; CopLINE_inc(PL_curcop); if (*s++ != '#') return; while (*s == ' ' || *s == '\t') s++; - if (strnEQ(s, "line ", 5)) { - s += 5; - sawline = 1; - } + if (strnEQ(s, "line", 4)) + s += 4; + else + return; + if (*s == ' ' || *s == '\t') + s++; + else + return; + while (*s == ' ' || *s == '\t') s++; if (!isDIGIT(*s)) return; n = s; @@ -482,13 +480,19 @@ S_incline(pTHX_ char *s) s++; while (*s == ' ' || *s == '\t') s++; - if (*s == '"' && (t = strchr(s+1, '"'))) + if (*s == '"' && (t = strchr(s+1, '"'))) { s++; + e = t + 1; + } else { - if (!sawline) - return; /* false alarm */ for (t = s; !isSPACE(*t); t++) ; + e = t; } + while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f') + e++; + if (*e != '\n' && *e != '\0') + return; /* false alarm */ + ch = *t; *t = '\0'; if (t - s > 0) @@ -808,6 +812,31 @@ S_force_ident(pTHX_ register char *s, int kind) } } +NV +Perl_str_to_version(pTHX_ SV *sv) +{ + NV retval = 0.0; + NV nshift = 1.0; + STRLEN len; + char *start = SvPVx(sv,len); + bool utf = SvUTF8(sv); + char *end = start + len; + while (start < end) { + I32 skip; + UV n; + if (utf) + n = utf8_to_uv((U8*)start, &skip); + else { + n = *(U8*)start; + skip = 1; + } + retval += ((NV)n)/nshift; + start += skip; + nshift *= 1000; + } + return retval; +} + /* * S_force_version * Forces the next token to be a version number. @@ -817,18 +846,25 @@ STATIC char * S_force_version(pTHX_ char *s) { OP *version = Nullop; + char *d; s = skipspace(s); - if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { - char *d = s; - if (*d == 'v') - d++; + d = s; + if (*d == 'v') + d++; + if (isDIGIT(*d)) { for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++); - if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') { + if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) { + SV *ver; s = scan_num(s); - /* real VERSION number -- GBARR */ version = yylval.opval; + ver = cSVOPx(version)->op_sv; + if (SvPOK(ver) && !SvNIOK(ver)) { + SvUPGRADE(ver, SVt_PVNV); + SvNVX(ver) = str_to_version(ver); + SvNOK_on(ver); /* hint that it is a version */ + } } } @@ -1159,6 +1195,8 @@ S_scan_const(pTHX_ char *start) bool dorange = FALSE; /* are we in a translit range? */ bool has_utf = FALSE; /* embedded \x{} */ I32 len; /* ? */ + UV uv; + I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) ? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) : UTF; @@ -1280,18 +1318,20 @@ S_scan_const(pTHX_ char *start) /* (now in tr/// code again) */ if (*s & 0x80 && thisutf) { - dTHR; /* only for ckWARN */ - if (ckWARN(WARN_UTF8)) { - (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */ - if (len) { - has_utf = TRUE; - while (len--) - *d++ = *s++; - continue; - } - } - else - has_utf = TRUE; /* assume valid utf8 */ + (void)utf8_to_uv((U8*)s, &len); + if (len == 1) { + /* illegal UTF8, make it valid */ + char *old_pvx = SvPVX(sv); + /* need space for one extra char (NOTE: SvCUR() not set here) */ + d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx); + d = (char*)uv_to_utf8((U8*)d, (U8)*s++); + } + else { + while (len--) + *d++ = *s++; + } + has_utf = TRUE; + continue; } /* backslashes */ @@ -1335,8 +1375,8 @@ S_scan_const(pTHX_ char *start) 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 */ @@ -1347,51 +1387,75 @@ S_scan_const(pTHX_ char *start) /* \132 indicates an octal constant */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': - *d++ = (char)scan_oct(s, 3, &len); + uv = (UV)scan_oct(s, 3, &len); s += len; - continue; + goto NUM_ESCAPE_INSERT; /* \x24 indicates a hex constant */ case 'x': ++s; if (*s == '{') { char* e = strchr(s, '}'); - UV uv; - if (!e) { yyerror("Missing right brace on \\x{}"); e = s; } - /* note: utf always shorter than hex */ - uv = (UV)scan_hex(s + 1, e - s - 1, &len); - if (uv > 127) { - d = (char*)uv_to_utf8((U8*)d, uv); - has_utf = TRUE; - } - else - *d++ = (char)uv; - s = e + 1; + uv = (UV)scan_hex(s + 1, e - s - 1, &len); + s = e + 1; } else { - /* XXX collapse this branch into the one above */ - UV uv = (UV)scan_hex(s, 2, &len); - if (utf && PL_lex_inwhat == OP_TRANS && - utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) - { - d = (char*)uv_to_utf8((U8*)d, uv); /* doing a CU or UC */ + uv = (UV)scan_hex(s, 2, &len); + s += len; + } + + NUM_ESCAPE_INSERT: + /* Insert oct or hex escaped character. + * There will always enough room in sv since such escapes will + * be longer than any utf8 sequence they can end up as + */ + if (uv > 127) { + if (!thisutf && !has_utf && uv > 255) { + /* might need to recode whatever we have accumulated so far + * if it contains any hibit chars + */ + int hicount = 0; + char *c; + for (c = SvPVX(sv); c < d; c++) { + if (*c & 0x80) + hicount++; + } + if (hicount) { + char *old_pvx = SvPVX(sv); + char *src, *dst; + d = SvGROW(sv, SvCUR(sv) + hicount + 1) + (d - old_pvx); + + src = d - 1; + d += hicount; + dst = d - 1; + + while (src < dst) { + if (*src & 0x80) { + dst--; + uv_to_utf8((U8*)dst, (U8)*src--); + dst--; + } + else { + *dst-- = *src--; + } + } + } + } + + if (thisutf || uv > 255) { + d = (char*)uv_to_utf8((U8*)d, uv); has_utf = TRUE; - } + } else { - if (uv >= 127 && UTF) { - dTHR; - if (ckWARN(WARN_UTF8)) - Perl_warner(aTHX_ WARN_UTF8, - "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that", - (int)len,s,(int)len,s); - } - *d++ = (char)uv; + *d++ = (char)uv; } - s += len; + } + else { + *d++ = (char)uv; } continue; @@ -3454,16 +3518,28 @@ Perl_yylex(pTHX) OPERATOR(REFGEN); case 'v': - if (isDIGIT(s[1]) && PL_expect == XTERM) { + if (isDIGIT(s[1]) && PL_expect != XOPERATOR) { char *start = s; start++; start++; - while (isDIGIT(*start)) + while (isDIGIT(*start) || *start == '_') start++; if (*start == '.' && isDIGIT(start[1])) { s = scan_num(s); TERM(THING); } + /* avoid v123abc() or $h{v1}, allow C<print v10;> */ + else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF)) { + char c = *start; + GV *gv; + *start = '\0'; + gv = gv_fetchpv(s, FALSE, SVt_PVCV); + *start = c; + if (!gv) { + s = scan_num(s); + TERM(THING); + } + } } goto keylookup; case 'x': @@ -3623,8 +3699,8 @@ Perl_yylex(pTHX) 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; @@ -3947,11 +4023,11 @@ Perl_yylex(pTHX) 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); @@ -4321,8 +4397,8 @@ Perl_yylex(pTHX) 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); } @@ -4394,15 +4470,15 @@ Perl_yylex(pTHX) 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; } @@ -4809,10 +4885,10 @@ Perl_yylex(pTHX) 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); @@ -6833,6 +6909,11 @@ Perl_scan_num(pTHX_ char *start) if (*s != '_') *d++ = *s; } + if (*s == '.' && isDIGIT(s[1])) { + /* oops, it's really a v-string, but without the "v" */ + s = start - 1; + goto vstring; + } } /* read exponent part, if present */ @@ -6886,62 +6967,61 @@ Perl_scan_num(pTHX_ char *start) break; /* if it starts with a v, it could be a version number */ case 'v': +vstring: { char *pos = s; pos++; - while (isDIGIT(*pos)) + while (isDIGIT(*pos) || *pos == '_') pos++; - if (*pos == '.' && isDIGIT(pos[1])) { + if (!isALPHA(*pos)) { UV rev; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tmpend; - NV nshift = 1.0; bool utf8 = FALSE; s++; /* get past 'v' */ sv = NEWSV(92,5); - SvUPGRADE(sv, SVt_PVNV); sv_setpvn(sv, "", 0); - do { + for (;;) { if (*s == '0' && isDIGIT(s[1])) yyerror("Octal number in vector unsupported"); - rev = atoi(s); - s = ++pos; - while (isDIGIT(*pos)) - pos++; - - if (rev > 127) { - tmpend = uv_to_utf8(tmpbuf, rev); - utf8 = TRUE; + rev = 0; + { + /* this is atoi() that tolerates underscores */ + char *end = pos; + UV mult = 1; + while (--end >= s) { + UV orev; + if (*end == '_') + continue; + orev = rev; + rev += (*end - '0') * mult; + mult *= 10; + if (orev > rev && ckWARN_d(WARN_OVERFLOW)) + Perl_warner(aTHX_ WARN_OVERFLOW, + "Integer overflow in decimal number"); + } } + tmpend = uv_to_utf8(tmpbuf, rev); + utf8 = utf8 || rev > 127; + sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); + if (*pos == '.' && isDIGIT(pos[1])) + s = ++pos; else { - tmpbuf[0] = (U8)rev; - tmpend = &tmpbuf[1]; + s = pos; + break; } - *tmpend = '\0'; - sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); - if (rev > 0) - SvNVX(sv) += (NV)rev/nshift; - nshift *= 1000; - } while (*pos == '.' && isDIGIT(pos[1])); - - if (*s == '0' && isDIGIT(s[1])) - yyerror("Octal number in vector unsupported"); - rev = atoi(s); - s = pos; - tmpend = uv_to_utf8(tmpbuf, rev); - utf8 = utf8 || rev > 127; - *tmpend = '\0'; - sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); - if (rev > 0) - SvNVX(sv) += (NV)rev/nshift; + while (isDIGIT(*pos) || *pos == '_') + pos++; + } SvPOK_on(sv); - SvNOK_on(sv); SvREADONLY_on(sv); - if (utf8) + if (utf8) { SvUTF8_on(sv); + sv_utf8_downgrade(sv, TRUE); + } } } break; @@ -7141,7 +7221,12 @@ Perl_yyerror(pTHX_ char *s) } else if (yychar > 255) where = "next token ???"; +#ifdef USE_PURE_BISON +/* GNU Bison sets the value -2 */ + else if (yychar == -2) { +#else else if ((yychar & 127) == 127) { +#endif if (PL_lex_state == LEX_NORMAL || (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL)) where = "at end of line"; diff --git a/universal.c b/universal.c index 1e5a1a0efe..0e5a89b2c0 100644 --- a/universal.c +++ b/universal.c @@ -140,6 +140,10 @@ XS(XS_UNIVERSAL_isa) Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)"); sv = ST(0); + + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) + XSRETURN_UNDEF; + name = (char *)SvPV(ST(1),n_a); ST(0) = boolSV(sv_derived_from(sv, name)); @@ -159,6 +163,10 @@ XS(XS_UNIVERSAL_can) Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)"); sv = ST(0); + + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) + XSRETURN_UNDEF; + name = (char *)SvPV(ST(1),n_a); rv = &PL_sv_undef; @@ -189,11 +197,10 @@ XS(XS_UNIVERSAL_VERSION) GV *gv; SV *sv; char *undef; - NV req; - if(SvROK(ST(0))) { + if (SvROK(ST(0))) { sv = (SV*)SvRV(ST(0)); - if(!SvOBJECT(sv)) + if (!SvOBJECT(sv)) Perl_croak(aTHX_ "Cannot find version of an unblessed reference"); pkg = SvSTASH(sv); } @@ -214,12 +221,56 @@ XS(XS_UNIVERSAL_VERSION) undef = "(undef)"; } - if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) { - STRLEN n_a; - Perl_croak(aTHX_ "%s version %s required--this is only version %s", - HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a)); + if (items > 1) { + STRLEN len; + SV *req = ST(1); + + if (undef) + Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed", + HvNAME(pkg), HvNAME(pkg)); + + if (!SvNIOK(sv) && SvPOK(sv)) { + char *str = SvPVx(sv,len); + while (len) { + --len; + /* XXX could DWIM "1.2.3" here */ + if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_') + break; + } + if (len) { + if (SvNIOKp(req) && SvPOK(req)) { + /* they said C<use Foo v1.2.3> and $Foo::VERSION + * doesn't look like a float: do string compare */ + if (sv_cmp(req,sv) == 1) { + Perl_croak(aTHX_ "%s version v%vd required--" + "this is only version v%vd", + HvNAME(pkg), req, sv); + } + goto finish; + } + /* they said C<use Foo 1.002_003> and $Foo::VERSION + * doesn't look like a float: force numeric compare */ + SvUPGRADE(sv, SVt_PVNV); + SvNVX(sv) = str_to_version(sv); + SvPOK_off(sv); + SvNOK_on(sv); + } + } + /* if we get here, we're looking for a numeric comparison, + * so force the required version into a float, even if they + * said C<use Foo v1.2.3> */ + if (SvNIOKp(req) && SvPOK(req)) { + NV n = SvNV(req); + req = sv_newmortal(); + sv_setnv(req, n); + } + + if (SvNV(req) > SvNV(sv)) + Perl_croak(aTHX_ "%s version %s required--this is only version %s", + HvNAME(pkg), SvPV(req,len), SvPV(sv,len)); } +finish: ST(0) = sv; XSRETURN(1); @@ -116,7 +116,7 @@ /* these should be set in a hint file, not here */ #ifndef PERL_SYS_INIT -#ifdef PERL_SCO5 +#if defined(PERL_SCO5) || defined(__FreeBSD__) # define PERL_SYS_INIT(c,v) fpsetmask(0); MALLOC_INIT #else # ifdef POSIX_BC @@ -260,7 +260,7 @@ Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8* d, I32 bytelen) bool Perl_is_uni_alnum(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_alnum(tmpbuf); } @@ -268,7 +268,7 @@ Perl_is_uni_alnum(pTHX_ U32 c) bool Perl_is_uni_alnumc(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_alnumc(tmpbuf); } @@ -276,7 +276,7 @@ Perl_is_uni_alnumc(pTHX_ U32 c) bool Perl_is_uni_idfirst(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_idfirst(tmpbuf); } @@ -284,7 +284,7 @@ Perl_is_uni_idfirst(pTHX_ U32 c) bool Perl_is_uni_alpha(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_alpha(tmpbuf); } @@ -292,7 +292,7 @@ Perl_is_uni_alpha(pTHX_ U32 c) bool Perl_is_uni_ascii(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_ascii(tmpbuf); } @@ -300,7 +300,7 @@ Perl_is_uni_ascii(pTHX_ U32 c) bool Perl_is_uni_space(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_space(tmpbuf); } @@ -308,7 +308,7 @@ Perl_is_uni_space(pTHX_ U32 c) bool Perl_is_uni_digit(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_digit(tmpbuf); } @@ -316,7 +316,7 @@ Perl_is_uni_digit(pTHX_ U32 c) bool Perl_is_uni_upper(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_upper(tmpbuf); } @@ -324,7 +324,7 @@ Perl_is_uni_upper(pTHX_ U32 c) bool Perl_is_uni_lower(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_lower(tmpbuf); } @@ -332,7 +332,7 @@ Perl_is_uni_lower(pTHX_ U32 c) bool Perl_is_uni_cntrl(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_cntrl(tmpbuf); } @@ -340,7 +340,7 @@ Perl_is_uni_cntrl(pTHX_ U32 c) bool Perl_is_uni_graph(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_graph(tmpbuf); } @@ -348,7 +348,7 @@ Perl_is_uni_graph(pTHX_ U32 c) bool Perl_is_uni_print(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_print(tmpbuf); } @@ -356,7 +356,7 @@ Perl_is_uni_print(pTHX_ U32 c) bool Perl_is_uni_punct(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_punct(tmpbuf); } @@ -364,7 +364,7 @@ Perl_is_uni_punct(pTHX_ U32 c) bool Perl_is_uni_xdigit(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return is_utf8_xdigit(tmpbuf); } @@ -372,7 +372,7 @@ Perl_is_uni_xdigit(pTHX_ U32 c) U32 Perl_to_uni_upper(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return to_utf8_upper(tmpbuf); } @@ -380,7 +380,7 @@ Perl_to_uni_upper(pTHX_ U32 c) U32 Perl_to_uni_title(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return to_utf8_title(tmpbuf); } @@ -388,7 +388,7 @@ Perl_to_uni_title(pTHX_ U32 c) U32 Perl_to_uni_lower(pTHX_ U32 c) { - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; uv_to_utf8(tmpbuf, (UV)c); return to_utf8_lower(tmpbuf); } @@ -27,6 +27,8 @@ EXTCONST unsigned char PL_utf8skip[]; END_EXTERN_C +#define UTF8_MAXLEN 13 /* how wide can a single UTF8 encoded character become */ + /*#define IN_UTF8 (PL_curcop->op_private & HINT_UTF8)*/ #define IN_BYTE (PL_curcop->op_private & HINT_BYTE) #define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTE) @@ -40,13 +40,6 @@ # define vfork fork #endif -#ifdef I_FCNTL -# include <fcntl.h> -#endif -#ifdef I_SYS_FILE -# include <sys/file.h> -#endif - #ifdef I_SYS_WAIT # include <sys/wait.h> #endif @@ -116,7 +109,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) { dTHX; Malloc_t ptr; -#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) +#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) && !defined(PERL_MICRO) Malloc_t PerlMem_realloc(); #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */ @@ -1504,6 +1497,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) } else { message = Nullch; + msglen = 0; } DEBUG_S(PerlIO_printf(Perl_debug_log, @@ -3494,7 +3488,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) /* 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 */ diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 76e2d65e8b..c47418e824 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -634,18 +634,11 @@ require 5.005_62; use strict; END -if( $opt_X || $opt_c || $opt_A ){ - # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD - print PM <<'END'; -our @EXPORT_OK; -END -} -else{ +unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and # will want Carp. print PM <<'END'; use Carp; -our @EXPORT_OK; END } diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 97f8d867da..f46564ea5f 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -57,7 +57,7 @@ print "Extracting $file (with variable substitutions)\n"; # In this section, perl variables will be expanded during extraction. # You can use $Config{...} to use Configure variables. -my $extract_version = sprintf("v%v", $^V); +my $extract_version = sprintf("v%vd", $^V); print OUT <<"!GROK!THIS!"; $Config{startperl} @@ -133,7 +133,7 @@ my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok); -my $perl_version = $^V ? sprintf("v%v", $^V) : $]; +my $perl_version = $^V ? sprintf("v%vd", $^V) : $]; my $config_tag2 = "$perl_version - $Config{cf_time}"; diff --git a/utils/perlcc.PL b/utils/perlcc.PL index 6c1fa45879..971923b68e 100644 --- a/utils/perlcc.PL +++ b/utils/perlcc.PL @@ -254,9 +254,14 @@ sub _createCode my ( $backend, $generated_file, $file, $final_output ) = @_; my $return; my $output_switch = "o"; + my $max_line_len = ''; local($") = " -I"; + if ($^O eq 'MSWin32' && $backend =~ /^CC?$/ && $Config{cc} =~ /^cl/i) { + $max_line_len = '-l2000,'; + } + if ($backend eq "Bytecode") { require ByteLoader; @@ -279,16 +284,16 @@ sub _createCode my $stash=$stash[-1]; chomp $stash; - _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36); - $return = _run("$^X -I@INC -MO=$backend,$stash,-$output_switch$generated_file $file", 9); + _print( "$^X -I@INC -MO=$backend,$max_line_len$stash $file\n", 36); + $return = _run("$^X -I@INC -MO=$backend,$max_line_len$stash,-$output_switch$generated_file $file", 9); $return; } else # compiling a shared object { _print( - "$^X -I@INC -MO=$backend,-m$final_output $file\n", 36); + "$^X -I@INC -MO=$backend,$max_line_len-m$final_output $file\n", 36); $return = - _run("$^X -I@INC -MO=$backend,-m$final_output,-$output_switch$generated_file $file ", 9); + _run("$^X -I@INC -MO=$backend,$max_line_len-m$final_output,-$output_switch$generated_file $file ", 9); $return; } } @@ -344,18 +349,21 @@ sub _ccharness my $sourceprog = shift(@args); my ($libdir, $incdir); + my $L = '-L'; + $L = '-libpath:' if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i; + if (-d "$Config{installarchlib}/CORE") { - $libdir = "-L$Config{installarchlib}/CORE"; + $libdir = "$L$Config{installarchlib}/CORE"; $incdir = "-I$Config{installarchlib}/CORE"; } else { - $libdir = "-L.. -L."; + $libdir = "$L.. $L."; $incdir = "-I.. -I."; } - $libdir .= " -L$options->{L}" if (defined($options->{L})); + $libdir .= " $L$options->{L}" if (defined($options->{L})); $incdir .= " -I$options->{L}" if (defined($options->{L})); my $linkargs = ''; @@ -366,7 +374,7 @@ sub _ccharness if (!grep(/^-[cS]$/, @args)) { my $lperl = $^O eq 'os2' ? '-llibperl' - : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\perl.lib" + : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\$Config{libperl}" : '-lperl'; ($lperl = $Config{libperl}) =~ s/lib(.*)\Q$Config{_a}\E/-l$1/ if($^O eq 'cygwin'); @@ -375,6 +383,7 @@ sub _ccharness $flags = $type eq 'dynamic' ? $Config{lddlflags} : $Config{ldflags}; $linkargs = "$flags $libdir $lperl @Config{libs}"; + $linkargs = "/link $linkargs" if $^O eq 'MSWin32' && $Config{cc} =~ /^cl/i; } my $libs = _getSharedObjects($sourceprog); diff --git a/utils/perldoc.PL b/utils/perldoc.PL index c4a9113b4a..7147607f60 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -56,7 +56,7 @@ Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageNa $me -q FAQKeywords The -h option prints more help. Also try "perldoc perldoc" to get -aquainted with the system. +acquainted with the system. EOF } diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index d8b49c7cea..c07c6d98f6 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -6,8 +6,7 @@ #: 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. @@ -360,21 +359,23 @@ libmods : $(LIBPREREQ) @ $(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 @@ -575,6 +576,11 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) $(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] @@ -584,6 +590,18 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -600,10 +618,18 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -624,6 +650,54 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -636,7 +710,15 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -644,6 +726,14 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -652,6 +742,14 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -660,10 +758,18 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -672,6 +778,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -692,6 +802,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -700,11 +814,15 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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) @@ -716,6 +834,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +[.lib.pod]perlunicode.pod : [.pod]perlunicode.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + [.lib.pod]perlxs.pod : [.pod]perlxs.pod @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) @@ -728,6 +850,14 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM) @ 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)" diff --git a/vms/subconfigure.com b/vms/subconfigure.com index b5d89bfaf1..dae2bdaf07 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -37,19 +37,14 @@ $ Vms_Ver := "''f$extract(1,3, f$getsyi(""version""))'" $ perl_extensions := "''extensions'" $ if f$length(Mcc) .eq. 0 then Mcc := "cc" $ MCC = f$edit(mcc, "UPCASE") -$ IF Mcc.eqs."CC -$ THEN -$ C_Compiler_Replace := "CC=" -$ ELSE -$ C_Compiler_Replace := "CC=CC=''Mcc'" -$ ENDIF +$ C_Compiler_Replace := "CC=CC=''Mcc'''CC_flags'" $ if "''Using_Dec_C'" .eqs. "Yes" $ THEN $ Checkcc := "''Mcc'/prefix=all" $ ELSE $ Checkcc := "''Mcc'" $ ENDIF -$ cc_flags = "" +$! cc_flags = "" $ if use_multiplicity .eqs. "Y" $ THEN $ perl_usemultiplicity = "define" @@ -63,6 +58,7 @@ $ myname = myhostname $ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## +$ perl_d_getcwd = "undef" $ perl_d_nv_preserves_uv = "define" $ perl_d_fs_data_s = "undef" $ perl_d_getmnt = "undef" @@ -74,6 +70,7 @@ $ perl_i_sysstatfs = "undef" $ perl_i_sysvfs = "undef" $ perl_i_ustat = "undef" $ perl_d_llseek="undef" +$ perl_d_iconv="undef" $ perl_d_madvise="undef" $ perl_selectminbits=32 $ perl_d_msync="undef" @@ -91,6 +88,7 @@ $ perl_d_getspent="undef $ perl_d_getspnam="undef $ perl_d_setspent="undef $ perl_d_fstatfs="undef" +$ perl_d_getfsstat="undef" $ perl_i_machcthreads="undef" $ perl_i_pthread="define" $ perl_d_fstatvfs="undef" @@ -131,24 +129,32 @@ $ perl_d_sendmsg = "undef" $ perl_d_recvmsg = "undef" $ perl_d_msghdr_s = "undef" $ perl_d_cmsghdr_s = "undef" -$ IF use_64bit .eqs. "Y" +$ IF use_64bitint .eqs. "Y" $ THEN -$ perl_use64bits = "define" +$ perl_use64bitint = "define" $ perl_uselargefiles = "define" $ perl_uselongdouble = "define" $ perl_usemorebits = "define" $ ELSE -$ perl_use64bits = "undef" +$ perl_use64bitint = "undef" $ perl_uselargefiles = "undef" $ perl_uselongdouble = "undef" $ perl_usemorebits = "undef" $ ENDIF +$ IF use_64bitall .eqs. "Y" +$ THEN +$ perl_use64bitall = "define" +$ ELSE +$ perl_use64bitall = "undef" +$ ENDIF $ perl_d_drand48proto = "define" +$ perl_d_lseekproto = "define" $ perl_libpth="/sys$share /sys$library" $ perl_ld="Link" $ perl_lddlflags="/Share" $ perl_ranlib="" $ perl_ar="" +$ perl_full_ar="" $ perl_eunicefix=":" $ perl_hint="none" $ perl_i_arpainet="undef" @@ -433,7 +439,7 @@ $ perl_pager="most" $! $! Are we 64 bit? $! -$ if (use_64bit .eqs. "Y") +$ if (use_64bitint .eqs. "Y") $ THEN $ perl_d_PRIfldbl = "define" $ perl_d_PRIgldbl = "define" @@ -1038,11 +1044,11 @@ $ DEASSIGN SYS$ERROR $ if (teststatus.nes."1") $ THEN $! Okay, int64_t failed. Must not exist -$ perl_d_int64t = "undef" +$ perl_d_int64_t = "undef" $ ELSE -$ perl_d_int64t="define" +$ perl_d_int64_t="define" $ ENDIF -$ WRITE_RESULT "d_int64t is ''perl_d_int64t'" +$ WRITE_RESULT "d_int64_t is ''perl_d_int64_t'" $! $! Check to see if off64_t exists $! @@ -1223,6 +1229,98 @@ $ ENDIF $ ENDIF $ WRITE_RESULT "i_sysfile is ''perl_i_sysfile'" $! +$! Check for sys/utsname.h +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "#include <unistd.h> +$ WS "#include <sys/utsname.h> +$ WS "int main() +$ WS "{" +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ if (teststatus.nes."1") +$ THEN +$ perl_i_sysutsname="undef" +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ ELSE +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_i_sysutsname="undef" +$ ELSE +$ perl_i_sysutsname="define" +$ ENDIF +$ ENDIF +$ WRITE_RESULT "i_sysutsname is ''perl_i_sysutsname'" +$! +$! Check for syslog.h +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "#include <unistd.h> +$ WS "#include <syslog.h> +$ WS "int main() +$ WS "{" +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ if (teststatus.nes."1") +$ THEN +$ perl_i_syslog="undef" +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ ELSE +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_i_syslog="undef" +$ ELSE +$ perl_i_syslog="define" +$ ENDIF +$ ENDIF +$ WRITE_RESULT "i_syslog is ''perl_i_syslog'" +$! $! Check for poll.h $! $ OS @@ -1315,6 +1413,52 @@ $ ENDIF $ ENDIF $ WRITE_RESULT "i_sysuio is ''perl_i_sysuio'" $! +$! Check for sys/mode.h +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "#include <unistd.h> +$ WS "#include <sys/mode.h> +$ WS "int main() +$ WS "{" +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ if (teststatus.nes."1") +$ THEN +$ perl_i_sysmode="undef" +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ ELSE +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_i_sysmode="undef" +$ ELSE +$ perl_i_sysmode="define" +$ ENDIF +$ ENDIF +$ WRITE_RESULT "i_sysmode is ''perl_i_sysmode'" +$! $! Check for sys/access.h $! $ OS @@ -1998,6 +2142,131 @@ $ perl_d_mkstemp="define" $ ENDIF $ WRITE_RESULT "d_mkstemp is ''perl_d_mkstemp'" $! +$! Check for mkstemps +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "int main() +$ WS "{" +$ WS "mkstemps(""foo"", 1); +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_d_mkstemps="undef" +$ ELSE +$ perl_d_mkstemps="define" +$ ENDIF +$ WRITE_RESULT "d_mkstemps is ''perl_d_mkstemps'" +$! +$! Check for iconv +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "#include <iconv.h> +$ WS "int main() +$ WS "{" +$ WS " iconv_t cd;" +$ WS " char *inbuf, *outbuf;" +$ WS " size_t inleft, outleft;" +$ WS " iconv(cd, &inbuf, &inleft, &outbuf, &outleft);" +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ if (teststatus.nes."1") +$ THEN +$ perl_d_iconv="undef" +$ perl_i_iconv="undef" +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ ELSE +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_d_iconv="undef" +$ perl_i_iconv="undef" +$ ELSE +$ perl_d_iconv="define" +$ perl_i_iconv="define" +$ ENDIF +$ ENDIF +$ WRITE_RESULT "d_iconv is ''perl_d_iconv'" +$ WRITE_RESULT "i_iconv is ''perl_i_iconv'" +$! +$! Check for mkdtemp +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ WS "int main() +$ WS "{" +$ WS "mkdtemp(""foo""); +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ savedstatus = $status +$ teststatus = f$extract(9,1,savedstatus) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_d_mkdtemp="undef" +$ ELSE +$ perl_d_mkdtemp="define" +$ ENDIF +$ WRITE_RESULT "d_mkdtemp is ''perl_d_mkdtemp'" +$! $! Check for setvbuf $! $ OS @@ -2715,6 +2984,52 @@ $ perl_d_getsent="undef" $ ENDIF $ WRITE_RESULT "d_getsent is ''perl_d_getsent'" $! +$! Check for socklen_t +$! +$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T") +$ THEN +$ OS +$ WS "#ifdef __DECC +$ WS "#include <stdlib.h> +$ WS "#endif +$ WS "#include <stdio.h> +$ IF ("''Has_Socketshr'".eqs."T") +$ THEN +$ WS "#include <socketshr.h>" +$ ELSE +$ WS "#include <netdb.h> +$ ENDIF +$ WS "int main() +$ WS "{" +$ WS "socklen_t x = 16; +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ on error then continue +$ on warning then continue +$ 'Checkcc' temp.c +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ teststatus = f$extract(9,1,$status) +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ if (teststatus.nes."1") +$ THEN +$ perl_d_socklen_t="undef" +$ ELSE +$ perl_d_socklen_t="define" +$ ENDIF +$ ELSE +$ perl_d_socklen_t="undef" +$ ENDIF +$ WRITE_RESULT "d_socklen_t is ''perl_d_socklen_t'" +$! $! Check for pthread_yield $! $ if ("''use_threads'".eqs."T") @@ -2917,6 +3232,7 @@ $ THEN $ perl_d_attribut="define" $ perl_vms_cc_type="gcc" $ ELSE +$ perl_vms_cc_type="cc" $ perl_d_attribut="undef" $ ENDIF $ @@ -3033,6 +3349,7 @@ $ perl_d_gethostprotos="define" $ perl_d_getnetprotos="define" $ perl_d_getprotoprotos="define" $ perl_d_getservprotos="define" +$ perl_sock_size_type="int *" $ ELSE $ perl_d_vms_do_sockets="undef" $ perl_d_htonl="undef" @@ -3054,6 +3371,7 @@ $ perl_d_gethostprotos="undef" $ perl_d_getnetprotos="undef" $ perl_d_getprotoprotos="undef" $ perl_d_getservprotos="undef" +$ perl_sock_size_type="undef" $ ENDIF $! Threads $ if ("''use_threads'".eqs."T") @@ -3274,6 +3592,7 @@ $ WC "ld='" + perl_ld + "'" $ WC "lddlflags='" + perl_lddlflags + "'" $ WC "ranlib='" + perl_ranlib + "'" $ WC "ar='" + perl_ar + "'" +$ WC "full_ar='" + perl_full_ar + "'" $ WC "eunicefix='" + perl_eunicefix + "'" $ WC "hint='" + perl_hint +"'" $ WC "hintfile='" + perl_hintfile + "'" @@ -3311,6 +3630,7 @@ $ WC "d_socket='" + perl_d_socket + "'" $ WC "d_sockpair='" + perl_d_sockpair + "'" $ WC "d_gethent='" + perl_d_gethent + "'" $ WC "d_getsent='" + perl_d_getsent + "'" +$ WC "d_socklen_t='" + perl_d_socklen_t + "'" $ WC "d_select='" + perl_d_select + "'" $ WC "i_niin='" + perl_i_niin + "'" $ WC "i_netinettcp='" + perl_i_netinettcp + "'" @@ -3547,6 +3867,7 @@ $ WC "d_dlsymun='" + perl_d_dlsymun + "'" $ WC "d_suidsafe='" + perl_d_suidsafe + "'" $ WC "d_dosuid='" + perl_d_dosuid + "'" $ WC "d_inetaton='" + perl_d_inetaton + "'" +$ WC "d_int64_t='" + perl_d_int64_t + "'" $ WC "d_isascii='" + perl_d_isascii + "'" $ WC "d_mkfifo='" + perl_d_mkfifo + "'" $ WC "d_pathconf='" + perl_d_pathconf + "'" @@ -3598,6 +3919,7 @@ $ WC "netdb_host_type='" + perl_netdb_host_type + "'" $ WC "netdb_hlen_type='" + perl_netdb_hlen_type + "'" $ WC "netdb_name_type='" + perl_netdb_name_type + "'" $ WC "netdb_net_type='" + perl_netdb_net_type + "'" +$ WC "sock_size_type='" + perl_sock_size_type + "'" $ WC "baserev='" + perl_baserev + "'" $ WC "doublesize='" + perl_doublesize + "'" $ WC "ptrsize='" + perl_ptrsize + "'" @@ -3614,9 +3936,10 @@ $ WC "d_oldpthreads='" + perl_d_oldpthreads + "'" $ WC "d_longdbl='" + perl_d_longdbl + "'" $ WC "longdblsize='" + perl_longdblsize + "'" $ WC "d_longlong='" + perl_d_longlong + "'" -$ WC "uselonglong='" + perl_d_longlong + "'" $ WC "longlongsize='" + perl_longlongsize + "'" $ WC "d_mkstemp='" + perl_d_mkstemp + "'" +$ WC "d_mkstemps='" + perl_d_mkstemps + "'" +$ WC "d_mkdtemp='" + perl_d_mkdtemp + "'" $ WC "d_setvbuf='" + perl_d_setvbuf + "'" $ WC "d_setenv='" + perl_d_setenv + "'" $ WC "d_endhent='" + perl_d_endhent + "'" @@ -3652,6 +3975,9 @@ $ WC "d_endpwent='" + perl_d_endpwent + "'" $ WC "d_semctl_semun='" + perl_d_semctl_semun + "'" $ WC "d_semctl_semid_ds='" + perl_d_semctl_semid_ds + "'" $ WC "extensions='" + perl_extensions + "'" +$ WC "known_extensions='" + perl_known_extensions + "'" +$ WC "static_ext='" + "'" +$ WC "dynamic_ext='" + perl_extensions + "'" $ WC "d_mknod='" + perl_d_mknod + "'" $ WC "devtype='" + perl_devtype + "'" $ WC "d_gethname='" + perl_d_gethname + "'" @@ -3681,11 +4007,12 @@ $ WC "i_machcthr='" + perl_i_machcthr + "'" $ WC "usemultiplicity='" + perl_usemultiplicity + "'" $ WC "i_poll='" + perl_i_poll + "'" $ WC "i_inttypes='" + perl_i_inttypes + "'" -$ WC "d_int64t='" + perl_d_int64t + "'" $ WC "d_off64_t='" + perl_d_off64_t + "'" $ WC "d_fpos64_t='" + perl_d_fpos64_t + "'" -$ WC "use64bits='" + perl_use64bits + "'" +$ WC "use64bitall='" + perl_use64bitall + "'" +$ WC "use64bitint='" + perl_use64bitint + "'" $ WC "d_drand48proto='" + perl_d_drand48proto + "'" +$ WC "d_lseekproto='" + perl_d_drand48proto + "'" $ WC "d_old_pthread_create_joinable='" + perl_d_old_pthread_create_joinable + "'" $ WC "old_pthread_create_joinable='" + perl_old_pthread_create_joinable + "'" $ WC "drand01='" + perl_drand01 + "'" @@ -3694,12 +4021,16 @@ $ WC "seedfunc='" + perl_seedfunc + "'" $ WC "sig_num_init='" + perl_sig_num_with_commas + "'" $ WC "i_sysmount='" + perl_i_sysmount + "'" $ WC "d_fstatfs='" + perl_d_fstatfs + "'" +$ WC "d_getfsstat='" + perl_d_getfsstat + "'" $ WC "d_memchr='" + perl_d_memchr + "'" $ WC "d_statfsflags='" + perl_d_statfsflags + "'" $ WC "fflushNULL='define'" $ WC "fflushall='undef'" $ WC "d_stdio_stream_array='undef'" $ WC "i_sysstatvfs='" + perl_i_sysstatvfs + "'" +$ WC "i_syslog='" + perl_i_syslog + "'" +$ WC "i_sysmode='" + perl_i_sysmode + "'" +$ WC "i_sysutsname='" + perl_i_sysutsname + "'" $ WC "i_machcthreads='" + perl_i_machcthreads + "'" $ WC "i_pthread='" + perl_i_pthread + "'" $ WC "d_fstatvfs='" + perl_d_fstatvfs + "'" @@ -3747,16 +4078,20 @@ $ WC "sPRIu64='" + perl_sPRIu64 + "'" $ WC "sPRIo64='" + perl_sPRIo64 + "'" $ WC "sPRIx64='" + perl_sPRIx64 + "'" $ WC "d_llseek='" + perl_d_llseek + "'" +$ WC "d_iconv='" + perl_d_iconv +"'" +$ WC "i_iconv='" + perl_i_iconv +"'" +$ WC "inc_version_list_init='""""'" $ WC "uselargefiles='" + perl_uselargefiles + "'" $ WC "uselongdouble='" + perl_uselongdouble + "'" $ WC "usemorebits='" + perl_usemorebits + "'" $ WC "d_quad='" + perl_d_quad + "'" -$ if (use_64bit .eqs. "Y") +$ if (use_64bitint .eqs. "Y") $ THEN $ WC "quadtype='" + perl_quadtype + "'" $ WC "uquadtype='" + perl_uquadtype + "'" $ ENDIF $ WC "d_fs_data_s='" + perl_d_fs_data_s + "'" +$ WC "d_getcwd='" + perl_d_getcwd + "'" $ WC "d_getmnt='" + perl_d_getmnt + "'" $ WC "d_sqrtl='" + perl_d_sqrtl + "'" $ WC "d_statfs_f_flags='" + perl_d_statfs_f_flags + "'" @@ -3869,11 +4204,15 @@ $ WRITE CONFIG "#define ALWAYS_DEFTYPES" $ ELSE $ WRITE CONFIG "#undef ALWAYS_DEFTYPES" $ ENDIF -$ if use_64bit.eqs."Y" +$ if use_64bitint.eqs."Y" $ THEN -$ WRITE CONFIG "#define USE_LONG_LONG" +$ WRITE CONFIG "#define USE_64_BIT_INT" $ WRITE CONFIG "#define USE_LONG_DOUBLE" $ ENDIF +$ if use_64bitall.eqs."Y" +$ THEN +$ WRITE CONFIG "#define USE_64_BIT_ALL" +$ ENDIF $ WRITE CONFIG "#define HAS_ENVGETENV" $ WRITE CONFIG "#define PERL_EXTERNAL_GLOB" $ CLOSE CONFIG diff --git a/vos/config.def b/vos/config.def index ce33890996..8f866218c4 100644 --- a/vos/config.def +++ b/vos/config.def @@ -72,6 +72,8 @@ $d_fstatfs='undef' $d_fstatvfs='undef' $d_ftello='undef' $d_Gconvert='sprintf((b),"%.*g",(n),(x))' +$d_getcwd='define' +$d_getfsstat='undef' $d_getgrent='undef' $d_getgrps='undef' $d_gethbyaddr='define' @@ -107,6 +109,7 @@ $d_gnulibc='undef' $d_grpasswd='undef' $d_hasmntopt='undef' $d_htonl='define' +$d_iconv='undef' $d_index='undef' $d_inetaton='undef' $d_int64t='undef' @@ -119,7 +122,9 @@ $d_locconv='define' $d_lockf='define' $d_longdbl='define' $d_longlong='undef' +$d_lseekproto='define' $d_lstat='define' +$d_madvise='undef' $d_mblen='define' $d_mbstowcs='define' $d_mbtowc='define' @@ -131,12 +136,16 @@ $d_memset='define' $d_mkdir='define' $d_mkfifo='define' $d_mktime='define' +$d_mmap='undef' +$d_mprotect='undef' $d_msg='undef' $d_msg_ctrunc='undef' $d_msg_dontroute='undef' $d_msg_oob='undef' $d_msg_peek='undef' $d_msg_proxy='undef' +$d_msync='undef' +$d_munmap='undef' $d_mymalloc='undef' $d_nice='undef' $d_nv_preserves_uv='define' @@ -289,6 +298,7 @@ $i_dlfcn='undef' $i_fcntl='define' $i_float='define' $i_grp='undef' +$i_iconv='undef' $i_inttypes='undef' $i_limits='define' $i_locale='define' @@ -394,6 +404,7 @@ $sitearchexp='' $sitelib='/system/ported/perl/lib/site/5.005' $sitelibexp='/system/ported/perl/lib/site/5.005' $sizetype='size_t' +$socksizetype='int' $sPRIfldbl='"Lf"' $sPRIgldbl='"Lg"' $src='%es#lang/vos_ftp_site/pub/vos/alpha/perl' @@ -419,11 +430,11 @@ $uidsize='4' $uidtype='uid_t' $uquadtype='_error_' $use5005threads='undef' -$use64bits='undef' +$use64bitall='undef' +$use64bitint='undef' $usedl='undef' $uselargefiles='undef' $uselongdouble='define' -$uselonglong='undef' $usemorebits='undef' $usemultiplicity='undef' $useperlio='undef' diff --git a/vos/config.h b/vos/config.h index c1fdd06dec..2f4e15a820 100644 --- a/vos/config.h +++ b/vos/config.h @@ -358,6 +358,18 @@ */ #define HAS_MKTIME /**/ +/* HAS_MSYNC: + * This symbol, if defined, indicates that the msync system call is + * available to synchronize a mapped file. + */ +/*#define HAS_MSYNC /**/ + +/* HAS_MUNMAP: + * This symbol, if defined, indicates that the munmap system call is + * available to unmap a region, usually mapped by mmap(). + */ +/*#define HAS_MUNMAP /**/ + /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -980,6 +992,37 @@ */ #define STDCHAR unsigned char /**/ +/* CROSSCOMPILE: + * This symbol, if defined, signifies that we our + * build process is a cross-compilation. + */ +/*#define CROSSCOMPILE /**/ + +/* INTSIZE: + * This symbol contains the value of sizeof(int) so that the C + * preprocessor can make decisions based on it. + */ +/* LONGSIZE: + * This symbol contains the value of sizeof(long) so that the C + * preprocessor can make decisions based on it. + */ +/* SHORTSIZE: + * This symbol contains the value of sizeof(short) so that the C + * preprocessor can make decisions based on it. + */ +#define INTSIZE 4 /**/ +#define LONGSIZE 4 /**/ +#define SHORTSIZE 2 /**/ + +/* MULTIARCH: + * This symbol, if defined, signifies that the build + * process will produce some binary files that are going to be + * used in a cross-platform environment. This is the case for + * example with the NeXT "fat" binaries that contain executables + * for several CPUs. + */ +/*#define MULTIARCH /**/ + /* HAS_QUAD: * This symbol, if defined, tells that there's a 64-bit integer type, * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one @@ -1020,41 +1063,17 @@ */ /*#define I_SYS_SECURITY /**/ -/* CROSSCOMPILE: - * This symbol, if defined, signifies that we our - * build process is a cross-compilation. - */ -/*#define CROSSCOMPILE /**/ - -/* INTSIZE: - * This symbol contains the value of sizeof(int) so that the C - * preprocessor can make decisions based on it. - */ -/* LONGSIZE: - * This symbol contains the value of sizeof(long) so that the C - * preprocessor can make decisions based on it. - */ -/* SHORTSIZE: - * This symbol contains the value of sizeof(short) so that the C - * preprocessor can make decisions based on it. - */ -#define INTSIZE 4 /**/ -#define LONGSIZE 4 /**/ -#define SHORTSIZE 2 /**/ - -/* MULTIARCH: - * This symbol, if defined, signifies that the build - * process will produce some binary files that are going to be - * used in a cross-platform environment. This is the case for - * example with the NeXT "fat" binaries that contain executables - * for several CPUs. +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. */ -/*#define MULTIARCH /**/ +#define OSNAME "VOS" /**/ /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. The default is eight, - * for safety. + * double, or a long double when applicable. Usual values are 2, + * 4 and 8. The default is eight, for safety. */ #if defined(CROSSCOMPILE) || defined(MULTIARCH) # define MEM_ALIGNBYTES 8 @@ -1062,6 +1081,61 @@ #define MEM_ALIGNBYTES 8 #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define ARCHLIB "" /**/ +/*#define ARCHLIB_EXP "" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "vos" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "/system/ported/command_library" /**/ +#define BIN_EXP "/system/ported/command_library" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always $undef + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1105,406 +1179,6 @@ #define BYTEORDER 0x4321 /* large digits for MSB */ #endif /* NeXT */ -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. - */ -/*#define CASTI32 /**/ - -/* CASTNEGFLOAT: - * This symbol is defined if the C compiler can cast negative - * numbers to unsigned longs, ints and shorts. - */ -/* CASTFLAGS: - * This symbol contains flags that say what difficulties the compiler - * has casting odd floating values to unsigned long: - * 0 = ok - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - * 4 = couldn't cast in argument expression list - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ - -/* VOID_CLOSEDIR: - * This symbol, if defined, indicates that the closedir() routine - * does not return a value. - */ -/*#define VOID_CLOSEDIR /**/ - -/* HAS_FD_SET: - * This symbol, when defined, indicates presence of the fd_set typedef - * in <sys/types.h> - */ -/*#define HAS_FD_SET /**/ - -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. Arguments for the Gconvert - * macro are: value, number of digits, whether trailing zeros should - * be retained, and the output buffer. - * Possible values are: - * d_Gconvert='gconvert((x),(n),(t),(b))' - * d_Gconvert='gcvt((x),(n),(b))' - * d_Gconvert='sprintf((b),"%.*g",(n),(x))' - * The last two assume trailing zeros should not be kept. - */ -#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) - -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*#define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*#define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*#define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include <time.h>. - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include <sys/time.h>. - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include <sys/time.h> with KERNEL defined. - */ -/*#define I_TIME /**/ -#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 4 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() rand()/(RAND_MAX+1) /**/ -#define Rand_seed_t unsigned int /**/ -#define seedDrand01(x) srand((Rand_seed_t)x) /**/ -#define RANDBITS 15 /**/ - -/* SSize_t: - * This symbol holds the type used by functions that return - * a count of bytes or an error condition. It must be a signed type. - * It is usually ssize_t, but may be long or int, etc. - * It may be necessary to include <sys/types.h> or <unistd.h> - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t ssize_t /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define ARCHLIB "" /**/ -/*#define ARCHLIB_EXP "" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "/system/ported/command_library" /**/ -#define BIN_EXP "/system/ported/command_library" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "/system/ported/perl/lib/5.005" /**/ -#define PRIVLIB_EXP "/system/ported/perl/lib/5.005" /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-dependent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define SITEARCH "" /**/ -/*#define SITEARCH_EXP "" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-independent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "/system/ported/perl/lib/site/5.005" /**/ -#define SITELIB_EXP "/system/ported/perl/lib/site/5.005" /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PERL_VENDORLIB_EXP "" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "VOS" /**/ - /* CAT2: * This macro catenates 2 tokens together. */ @@ -1562,6 +1236,33 @@ */ /*#define HAS_ACCESS /**/ +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +/*#define CASTI32 /**/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + * 4 = couldn't cast in argument expression list + */ +#define CASTNEGFLOAT /**/ +#define CASTFLAGS 0 /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +/*#define VOID_CLOSEDIR /**/ + /* HAS_CSH: * This symbol, if defined, indicates that the C-shell exists. */ @@ -1573,6 +1274,22 @@ #define CSH "" /**/ #endif +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +/*#define HAS_DRAND48_PROTO /**/ + /* HAS_ENDGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for finalizing sequential access of the group database. @@ -1609,6 +1326,70 @@ */ #define HAS_ENDSERVENT /**/ +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +/*#define HAS_ENDSPENT /**/ + +/* HAS_FD_SET: + * This symbol, when defined, indicates presence of the fd_set typedef + * in <sys/types.h> + */ +/*#define HAS_FD_SET /**/ + +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_FPOS64_T /**/ + +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATFS /**/ + +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO /**/ + +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) + +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +#define HAS_GETCWD /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1657,11 +1438,31 @@ */ #define HAS_GETHOSTNAME /**/ #define HAS_UNAME /**/ -/*#define HAS_PHOSTNAME /**/ +/*#define HAS_PHOSTNAME /**/ #ifdef HAS_PHOSTNAME #define PHOSTNAME "" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1680,6 +1481,14 @@ */ #define HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1697,6 +1506,14 @@ #define HAS_GETPROTOBYNAME /**/ #define HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1710,6 +1527,26 @@ */ #define HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +/*#define HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1721,6 +1558,20 @@ #define HAS_GETSERVBYNAME /**/ #define HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC /**/ +#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) +# define _GNU_SOURCE +#endif +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1746,6 +1597,40 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ICONV: + * This symbol, if defined, indicates that the iconv routine is + * available to do character set conversions. + */ +/*#define HAS_ICONV /**/ + +/* HAS_INT64_T: + * This symbol will defined if the C compiler supports int64_t. + * Usually the <inttypes.h> needs to be included, but sometimes + * <sys/types.h> is enough. + */ +# HAS_INT64_T /**/ + +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#define HAS_LDBL_DIG /* */ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1779,12 +1664,113 @@ */ #define HAS_MEMCHR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +# HAS_MKDTEMP /**/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +# HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to excluslvely create and open a uniquely named + * (with a suffix) temporary file. + */ +# HAS_MKSTEMPS /**/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +/*#define HAS_MMAP /**/ +#define Mmap_t $mmaptype /**/ + +/* HAS_MPROTECT: + * This symbol, if defined, indicates that the mprotect system call is + * available to modify the access protection of a memory mapped file. + */ +/*#define HAS_MPROTECT /**/ + /* HAS_MSG: * This symbol, if defined, indicates that the entire msg*(2) library is * supported (IPC mechanism based on message queues). */ /*#define HAS_MSG /**/ +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/*#define HAS_OFF64_T /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +#define HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/*#define HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_MEMCPY /**/ + +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +#define HAS_SANE_MEMCMP /**/ + /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is * supported. @@ -1834,6 +1820,12 @@ */ #define HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +/*#define HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1841,12 +1833,55 @@ */ #define HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ /*#define HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1894,6 +1929,12 @@ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +/*#define HAS_SQRTL /**/ + /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. @@ -1902,6 +1943,88 @@ /*#define USE_STAT_BLOCKS /**/ #endif +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3), + * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +/*#define HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_ptr) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->_cnt) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_base) +#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) +#endif + /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is * available to translate error numbers to strings. See the writeup @@ -1921,6 +2044,52 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +/*#define HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#define HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including <sys/sem.h>. If not, the user code @@ -1943,6 +2112,12 @@ /*#define USE_SEMCTL_SEMUN /**/ /*#define USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +/*#define HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1956,6 +2131,78 @@ */ #define Signal_t void /* Signal handler's return type */ +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +/*#define USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "d" /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ + /* Groups_t: * This symbol holds the type used for the second argument to * getgroups() and setgropus(). Usually, this is the same as @@ -1969,6 +2216,19 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include <grp.h>. @@ -1980,12 +2240,54 @@ /*#define I_GRP /**/ /*#define GRPASSWD /**/ +/* I_ICONV: + * This symbol, if defined, indicates that <iconv.h> exists and + * should be included. + */ +/*#define I_ICONV /**/ + +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include <inttypes.h>. + */ +/*#define I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include <mach/cthreads.h>. + */ +/*#define I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that <mntent.h> exists and + * should be included. + */ +/*#define I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that <netdb.h> exists and * should be included. */ #define I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/tcp.h>. + */ +/*#define I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that <poll.h> exists and + * should be included. + */ +/*#define I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include <pthread.h>. + */ +/*#define I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include <pwd.h>. @@ -2032,297 +2334,6 @@ /*#define PWGECOS /**/ /*#define PWPASSWD /**/ -/* I_SYSUIO: - * This symbol, if defined, indicates that <sys/uio.h> exists and - * should be included. - */ -/*#define I_SYSUIO /**/ - -/* Free_t: - * This variable contains the return type of free(). It is usually - * void, but occasionally int. - */ -/* Malloc_t: - * This symbol is the type of pointer returned by malloc and realloc. - */ -#define Malloc_t void * /**/ -#define Free_t void /**/ - -/* MYMALLOC: - * This symbol, if defined, indicates that we're using our own malloc. - */ -/*#define MYMALLOC /**/ - -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -#define SIG_NAME "ZERO","ABRT","FPE","ILL","INT","SEGV","TERM","USR1","USR2","IO","HUP","URG","ALRM","KILL","PIPE","QUIT","CHLD","CONT","STOP","TSTP","TTIN","TTOU","BUS","RT1","RT2","RT3","RT4","RT5","RT6","RT7","RT8",0 /**/ -#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,0 /**/ - -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. - */ -/*#define HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. - */ -/*#define HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always $undef - * for those versions. - */ -/*#define PERL_BINCOMPAT_5005 /**/ - -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. - */ -/*#define DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT /**/ - -/* HAS_STRUCT_FS_DATA: - * This symbol, if defined, indicates that the struct fs_data - * to do statfs() is supported. - */ -/*#define HAS_STRUCT_FS_DATA /**/ - -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). - */ -/*#define HAS_FSEEKO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems by file descriptors. - */ -/*#define HAS_FSTATFS /**/ -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). - */ -/*#define HAS_FTELLO /**/ - -/* HAS_GETMNT: - * This symbol, if defined, indicates that the getmnt routine is - * available to get filesystem mount info by filename. - */ -/*#define HAS_GETMNT /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems to get their info. - */ -/*#define HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. - */ -/*#define HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. - */ -/*#define HAS_HASMNTOPT /**/ - -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the <inttypes.h> needs to be included, but sometimes - * <sys/types.h> is enough. - */ -/*#define HAS_INT64_T /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's <float.h> - * or <limits.h> defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. - */ -#define HAS_LDBL_DIG /* */ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. - */ -/*#define USE_SFIO /**/ - -/* HAS_SQRTL: - * This symbol, if defined, indicates that the sqrtl routine is - * available to do long double square roots. - */ -/*#define HAS_SQRTL /**/ - -/* HAS_STRUCT_STATFS_F_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem containing the file. - * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3), - * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not - * have statfs() and struct statfs, they have ustat() and getmnt() - * with struct ustat and struct fs_data. - */ -/*#define HAS_STRUCT_STATFS_F_FLAGS /**/ - -/* HAS_STRUCT_STATFS: - * This symbol, if defined, indicates that the struct statfs - * to do statfs() is supported. - */ -/*#define HAS_STRUCT_STATFS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems by file descriptors. - */ -/*#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); - */ -/*#define HAS_TELLDIR_PROTO /**/ - -/* HAS_USTAT: - * This symbol, if defined, indicates that the ustat system call is - * available to query file system statistics by dev_t. - */ -/*#define HAS_USTAT /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. - */ -/*#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. - */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. - */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL /**/ - -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the <db.h> header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. - */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the <db.h> header file. In older versions of DB, it was - * int, while in newer ones it is size_t. - */ -#define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include <inttypes.h>. - */ -/*#define I_INTTYPES /**/ - -/* I_MNTENT: - * This symbol, if defined, indicates that <mntent.h> exists and - * should be included. - */ -/*#define I_MNTENT /**/ - -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include <netinet/tcp.h>. - */ -/*#define I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that <poll.h> exists and - * should be included. - */ -/*#define I_POLL /**/ - /* I_SHADOW: * This symbol, if defined, indicates that <shadow.h> exists and * should be included. @@ -2335,6 +2346,18 @@ */ /*#define I_SOCKS /**/ +/* I_SYSLOG: + * This symbol, if defined, indicates that <syslog.h> exists and + * should be included. + */ +# I_SYSLOG /**/ + +/* I_SYSMODE: + * This symbol, if defined, indicates that <sys/mode.h> exists and + * should be included. + */ +# I_SYSMODE /**/ + /* I_SYS_MOUNT: * This symbol, if defined, indicates that <sys/mount.h> exists and * should be included. @@ -2352,26 +2375,60 @@ */ /*#define I_SYS_STATVFS /**/ +/* I_SYSUIO: + * This symbol, if defined, indicates that <sys/uio.h> exists and + * should be included. + */ +/*#define I_SYSUIO /**/ + +/* I_SYSUTSNAME: + * This symbol, if defined, indicates that <sys/utsname.h> exists and + * should be included. + */ +# I_SYSUTSNAME /**/ + /* I_SYS_VFS: * This symbol, if defined, indicates that <sys/vfs.h> exists and * should be included. */ /*#define I_SYS_VFS /**/ +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <time.h>. + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h>. + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h> with KERNEL defined. + */ +/*#define I_TIME /**/ +#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL /**/ + /* I_USTAT: * This symbol, if defined, indicates that <ustat.h> exists and * should be included. */ /*#define I_USTAT /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +#define PERL_INC_VERSION_LIST /**/ + +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. */ -/*#define HAS_OFF64_T /**/ -/*#define HAS_FPOS64_T /**/ +/*#define INSTALL_USR_BIN_PERL /**/ /* PERL_PRIfldbl: * This symbol, if defined, contains the string used by stdio to @@ -2384,6 +2441,92 @@ #define PERL_PRIfldbl "Lf" /**/ #define PERL_PRIgldbl "Lg" /**/ +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t off_t /* <offset> type */ +#define LSEEKSIZE 4 /* <offset> size */ +#define Off_t_size 4 /* <offset> size */ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ +/* Malloc_t: + * This symbol is the type of pointer returned by malloc and realloc. + */ +#define Malloc_t void * /**/ +#define Free_t void /**/ + +/* MYMALLOC: + * This symbol, if defined, indicates that we're using our own malloc. + */ +/*#define MYMALLOC /**/ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t mode_t /* file mode parameter for system calls */ + +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK + +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). + */ +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). + */ +#define Netdb_host_t char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t char * /**/ +#define Netdb_net_t long /**/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2447,6 +2590,10 @@ /* U64SIZE: * This symbol contains the sizeof(U64). */ +/* NV_PRESERVES_UV: + * This symbol, if defined, indicates that a variable of type NVTYPE + * can preserve all the bit of a variable of type UVSIZE. + */ #define IVTYPE int /**/ #define UVTYPE unsigned int /**/ #define I8TYPE char /**/ @@ -2472,6 +2619,7 @@ #define I64SIZE _error_ /**/ #define U64SIZE _error_ /**/ #endif +#define NV_PRESERVES_UV /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -2494,6 +2642,59 @@ #define UVof "o" /**/ #define UVxf "x" /**/ +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Pid_t pid_t /* PID type */ + +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "/system/ported/perl/lib/5.005" /**/ +#define PRIVLIB_EXP "/system/ported/perl/lib/5.005" /**/ + +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). + */ +#define PTRSIZE 4 /**/ + +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() rand()/(RAND_MAX+1) /**/ +#define Rand_seed_t unsigned int /**/ +#define seedDrand01(x) srand((Rand_seed_t)x) /**/ +#define RANDBITS 15 /**/ + /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. * That is, if you do select(n, ...), how many bits at least will be @@ -2503,6 +2704,99 @@ */ #define SELECT_MIN_BITS 1 /**/ +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t fd_set * /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NAME "ZERO","ABRT","FPE","ILL","INT","SEGV","TERM","USR1","USR2","IO","HUP","URG","ALRM","KILL","PIPE","QUIT","CHLD","CONT","STOP","TSTP","TTIN","TTOU","BUS","RT1","RT2","RT3","RT4","RT5","RT6","RT7","RT8",0 /**/ +#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,0 /**/ + +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITEARCH "" /**/ +#define SITEARCH_EXP "" /**/ + +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITELIB "/system/ported/perl/lib/site/5.005" /**/ +#define SITELIB_EXP "/system/ported/perl/lib/site/5.005" /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t size_t /* length paramater for string functions */ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include <sys/types.h> or <unistd.h> + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#define SSize_t ssize_t /* signed count of bytes */ + /* STARTPERL: * This variable contains the string to put in front of a perl * script to make sure (one hopes) that it runs with perl and not @@ -2521,25 +2815,52 @@ #define HAS_STDIO_STREAM_ARRAY /**/ #define STDIO_STREAM_ARRAY _iob -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -/*#define HAS_STRTOULL /**/ +#define Uid_t_f "d" /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ -/* USE_64_BITS: +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ + +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -/*#define USE_64_BITS /**/ +/* USE_64_BIT_ALL: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be used (be they 32 or 64 bits). The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_INT +/*#define USE_64_BIT_INT /**/ +#endif + +#ifndef USE_64_BIT_ALL +/*#define USE_64_BIT_ALL /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES /*#define USE_LARGE_FILES /**/ @@ -2553,14 +2874,10 @@ #define USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. +/* USE_MORE_BITS: + * This symbol, if defined, indicates that 64-bit interfaces and + * long doubles should be used when available. */ -#ifndef USE_LONG_LONG -/*#define USE_LONG_LONG /**/ -#endif - #ifndef USE_MORE_BITS /*#define USE_MORE_BITS /**/ #endif @@ -2590,6 +2907,56 @@ /*#define USE_SOCKS /**/ #endif +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. + */ +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. + */ +/* OLD_PTHREADS_API: + * This symbol, if defined, indicates that Perl should + * be built to use the old draft POSIX threads API. + */ +/*#define USE_5005THREADS /**/ +# USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif +/*#define OLD_PTHREADS_API /**/ + +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PERL_VENDORLIB_EXP "" /**/ + +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and @@ -2622,233 +2989,27 @@ * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/ -#define PERL_PM_APIVERSION 5.00563 /* Change to string for tuples?*/ - -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -/*#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t char * /**/ -#define Netdb_net_t long /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "vos" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD /**/ -/*#define HAS_SCHED_YIELD /**/ +#define PERL_XS_APIVERSION "5.00563" +#define PERL_PM_APIVERSION "5.00563" -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include <mach/cthreads.h>. +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. */ -/*#define I_MACH_CTHREADS /**/ +/*#define HAS_GETFSSTAT /**/ -/* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include <pthread.h>. - */ -/*#define I_PTHREAD /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. - */ -/* OLD_PTHREADS_API: - * This symbol, if defined, indicates that Perl should - * be built to use the old draft POSIX threads API. - */ -#ifndef USE_TTHREADS -/*#define USE_THREADS /**/ -#endif -/*#define OLD_PTHREADS_API /**/ - -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case <sys/types.h> should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include <sys/times.h>. - */ -#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t_f: - * This symbol defines the format string used for printing a Gid_t. - */ -#define Gid_t_f "d" /**/ - -/* Gid_t_size: - * This symbol holds the size of a Gid_t in bytes. - */ -#define Gid_t_size 4 /* GID size */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include <sys/types.h> to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -/* Off_t_size: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* <offset> type */ -#define LSEEKSIZE 4 /* <offset> size */ -#define Off_t_size 4 /* <offset> size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include <sys/types.h> - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Pid_t pid_t /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Size_t size_t /* length paramater for string functions */ - -/* Uid_t_f: - * This symbol defines the format string used for printing a Uid_t. - */ -#define Uid_t_f "d" /**/ - -/* Uid_t_size: - * This symbol holds the size of a Uid_t in bytes. +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); */ -#define Uid_t_size 4 /* UID size */ +#define HAS_LSEEK_PROTO /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). */ -#define Uid_t uid_t /* UID type */ +#define Sock_size_t int /**/ #endif diff --git a/vos/config_h.SH_orig b/vos/config_h.SH_orig index 56df72c16a..ad136f26db 100755 --- a/vos/config_h.SH_orig +++ b/vos/config_h.SH_orig @@ -376,6 +376,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_mktime HAS_MKTIME /**/ +/* HAS_MSYNC: + * This symbol, if defined, indicates that the msync system call is + * available to synchronize a mapped file. + */ +#$d_msync HAS_MSYNC /**/ + +/* HAS_MUNMAP: + * This symbol, if defined, indicates that the munmap system call is + * available to unmap a region, usually mapped by mmap(). + */ +#$d_munmap HAS_MUNMAP /**/ + /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -998,6 +1010,37 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define STDCHAR $stdchar /**/ +/* CROSSCOMPILE: + * This symbol, if defined, signifies that we our + * build process is a cross-compilation. + */ +#$crosscompile CROSSCOMPILE /**/ + +/* INTSIZE: + * This symbol contains the value of sizeof(int) so that the C + * preprocessor can make decisions based on it. + */ +/* LONGSIZE: + * This symbol contains the value of sizeof(long) so that the C + * preprocessor can make decisions based on it. + */ +/* SHORTSIZE: + * This symbol contains the value of sizeof(short) so that the C + * preprocessor can make decisions based on it. + */ +#define INTSIZE $intsize /**/ +#define LONGSIZE $longsize /**/ +#define SHORTSIZE $shortsize /**/ + +/* MULTIARCH: + * This symbol, if defined, signifies that the build + * process will produce some binary files that are going to be + * used in a cross-platform environment. This is the case for + * example with the NeXT "fat" binaries that contain executables + * for several CPUs. + */ +#$multiarch MULTIARCH /**/ + /* HAS_QUAD: * This symbol, if defined, tells that there's a 64-bit integer type, * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one @@ -1038,41 +1081,17 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_syssecrt I_SYS_SECURITY /**/ -/* CROSSCOMPILE: - * This symbol, if defined, signifies that we our - * build process is a cross-compilation. - */ -#$crosscompile CROSSCOMPILE /**/ - -/* INTSIZE: - * This symbol contains the value of sizeof(int) so that the C - * preprocessor can make decisions based on it. - */ -/* LONGSIZE: - * This symbol contains the value of sizeof(long) so that the C - * preprocessor can make decisions based on it. - */ -/* SHORTSIZE: - * This symbol contains the value of sizeof(short) so that the C - * preprocessor can make decisions based on it. - */ -#define INTSIZE $intsize /**/ -#define LONGSIZE $longsize /**/ -#define SHORTSIZE $shortsize /**/ - -/* MULTIARCH: - * This symbol, if defined, signifies that the build - * process will produce some binary files that are going to be - * used in a cross-platform environment. This is the case for - * example with the NeXT "fat" binaries that contain executables - * for several CPUs. +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. */ -#$multiarch MULTIARCH /**/ +#define OSNAME "$osname" /**/ /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. The default is eight, - * for safety. + * double, or a long double when applicable. Usual values are 2, + * 4 and 8. The default is eight, for safety. */ #if defined(CROSSCOMPILE) || defined(MULTIARCH) # define MEM_ALIGNBYTES 8 @@ -1080,6 +1099,61 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define MEM_ALIGNBYTES $alignbytes #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for $package. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#$d_archlib ARCHLIB "$archlib" /**/ +#$d_archlib ARCHLIB_EXP "$archlibexp" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "$archname" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +#$d_atolf HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +#$d_atoll HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "$bin" /**/ +#define BIN_EXP "$binexp" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always $undef + * for those versions. + */ +#$d_bincompat5005 PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1123,406 +1197,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define BYTEORDER 0x$byteorder /* large digits for MSB */ #endif /* NeXT */ -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. - */ -#$d_casti32 CASTI32 /**/ - -/* CASTNEGFLOAT: - * This symbol is defined if the C compiler can cast negative - * numbers to unsigned longs, ints and shorts. - */ -/* CASTFLAGS: - * This symbol contains flags that say what difficulties the compiler - * has casting odd floating values to unsigned long: - * 0 = ok - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - * 4 = couldn't cast in argument expression list - */ -#$d_castneg CASTNEGFLOAT /**/ -#define CASTFLAGS $castflags /**/ - -/* VOID_CLOSEDIR: - * This symbol, if defined, indicates that the closedir() routine - * does not return a value. - */ -#$d_void_closedir VOID_CLOSEDIR /**/ - -/* HAS_FD_SET: - * This symbol, when defined, indicates presence of the fd_set typedef - * in <sys/types.h> - */ -#$d_fd_set HAS_FD_SET /**/ - -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. Arguments for the Gconvert - * macro are: value, number of digits, whether trailing zeros should - * be retained, and the output buffer. - * Possible values are: - * d_Gconvert='gconvert((x),(n),(t),(b))' - * d_Gconvert='gcvt((x),(n),(b))' - * d_Gconvert='sprintf((b),"%.*g",(n),(x))' - * The last two assume trailing zeros should not be kept. - */ -#define Gconvert(x,n,t,b) $d_Gconvert - -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -#$d_gnulibc HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#$d_isascii HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -#$d_lchown HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#$d_open3 HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -#$d_safebcpy HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -#$d_safemcpy HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#$d_sanemcmp HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -#$d_sigaction HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -#$d_sigsetjmp HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#$d_stdstdio USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) $stdio_ptr -#$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) $stdio_cnt -#$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#$d_stdiobase USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) $stdio_base -#define FILE_bufsiz(fp) $stdio_bufsiz -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#$d_vprintf HAS_VPRINTF /**/ -#$d_charvspr USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE $doublesize /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include <time.h>. - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include <sys/time.h>. - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include <sys/time.h> with KERNEL defined. - */ -#$i_time I_TIME /**/ -#$i_systime I_SYS_TIME /**/ -#$i_systimek I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK $o_nonblock -#define VAL_EAGAIN $eagain -#define RD_NODATA $rd_nodata -#$d_eofnblk EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE $ptrsize /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() $drand01 /**/ -#define Rand_seed_t $randseedtype /**/ -#define seedDrand01(x) $seedfunc((Rand_seed_t)x) /**/ -#define RANDBITS $randbits /**/ - -/* SSize_t: - * This symbol holds the type used by functions that return - * a count of bytes or an error condition. It must be a signed type. - * It is usually ssize_t, but may be long or int, etc. - * It may be necessary to include <sys/types.h> or <unistd.h> - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t $ssizetype /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -#$ebcdic EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for $package. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#$d_archlib ARCHLIB "$archlib" /**/ -#$d_archlib ARCHLIB_EXP "$archlibexp" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "$bin" /**/ -#define BIN_EXP "$binexp" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -#$installusrbinperl INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "$privlib" /**/ -#define PRIVLIB_EXP "$privlibexp" /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-dependent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#$d_sitearch SITEARCH "$sitearch" /**/ -#$d_sitearch SITEARCH_EXP "$sitearchexp" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-independent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "$sitelib" /**/ -#define SITELIB_EXP "$sitelibexp" /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "$osname" /**/ - /* CAT2: * This macro catenates 2 tokens together. */ @@ -1580,6 +1254,33 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_access HAS_ACCESS /**/ +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +#$d_casti32 CASTI32 /**/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + * 4 = couldn't cast in argument expression list + */ +#$d_castneg CASTNEGFLOAT /**/ +#define CASTFLAGS $castflags /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +#$d_void_closedir VOID_CLOSEDIR /**/ + /* HAS_CSH: * This symbol, if defined, indicates that the C-shell exists. */ @@ -1591,6 +1292,22 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define CSH "$full_csh" /**/ #endif +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +#$d_drand48proto HAS_DRAND48_PROTO /**/ + /* HAS_ENDGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for finalizing sequential access of the group database. @@ -1627,6 +1344,70 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_endsent HAS_ENDSERVENT /**/ +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +#$d_endspent HAS_ENDSPENT /**/ + +/* HAS_FD_SET: + * This symbol, when defined, indicates presence of the fd_set typedef + * in <sys/types.h> + */ +#$d_fd_set HAS_FD_SET /**/ + +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +#$d_fpos64_t HAS_FPOS64_T /**/ + +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +#$d_fs_data_s HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +#$d_fseeko HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +#$d_fstatfs HAS_FSTATFS /**/ + +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +#$d_ftello HAS_FTELLO /**/ + +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) $d_Gconvert + +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +#$d_getcwd HAS_GETCWD /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1675,11 +1456,31 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_gethname HAS_GETHOSTNAME /**/ #$d_uname HAS_UNAME /**/ -#$d_phostname HAS_PHOSTNAME /**/ +#$d_phostname HAS_PHOSTNAME /**/ #ifdef HAS_PHOSTNAME #define PHOSTNAME "$aphostname" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_gethostprotos HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +#$d_getmnt HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +#$d_getmntent HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1698,6 +1499,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getnent HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getnetprotos HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1715,6 +1524,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_getpbyname HAS_GETPROTOBYNAME /**/ #$d_getpbynumber HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1728,6 +1545,26 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getsent HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that <netdb.h> includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getservprotos HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +#$d_getspent HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +#$d_getspnam HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1739,6 +1576,20 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_getsbyname HAS_GETSERVBYNAME /**/ #$d_getsbyport HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +#$d_gnulibc HAS_GNULIBC /**/ +#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) +# define _GNU_SOURCE +#endif +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +#$d_hasmntopt HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1764,6 +1615,40 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_htonl HAS_NTOHL /**/ #$d_htonl HAS_NTOHS /**/ +/* HAS_ICONV: + * This symbol, if defined, indicates that the iconv routine is + * available to do character set conversions. + */ +#$d_iconv HAS_ICONV /**/ + +/* HAS_INT64_T: + * This symbol will defined if the C compiler supports int64_t. + * Usually the <inttypes.h> needs to be included, but sometimes + * <sys/types.h> is enough. + */ +#$d_int64_t HAS_INT64_T /**/ + +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#$d_isascii HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#$d_lchown HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#$d_ldbl_dig HAS_LDBL_DIG /* */ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1797,12 +1682,113 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_memchr HAS_MEMCHR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +#$d_mkdtemp HAS_MKDTEMP /**/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +#$d_mkstemp HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to excluslvely create and open a uniquely named + * (with a suffix) temporary file. + */ +#$d_mkstemps HAS_MKSTEMPS /**/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +#$d_mmap HAS_MMAP /**/ +#define Mmap_t $mmaptype /**/ + +/* HAS_MPROTECT: + * This symbol, if defined, indicates that the mprotect system call is + * available to modify the access protection of a memory mapped file. + */ +#$d_mprotect HAS_MPROTECT /**/ + /* HAS_MSG: * This symbol, if defined, indicates that the entire msg*(2) library is * supported (IPC mechanism based on message queues). */ #$d_msg HAS_MSG /**/ +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +#$d_off64_t HAS_OFF64_T /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +#$d_open3 HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +#$d_old_pthread_create_joinable OLD_PTHREAD_CREATE_JOINABLE $old_pthread_create_joinable /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +#$d_pthread_yield HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD $sched_yield /**/ +#$d_sched_yield HAS_SCHED_YIELD /**/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +#$d_safebcpy HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +#$d_safemcpy HAS_SAFE_MEMCPY /**/ + +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +#$d_sanemcmp HAS_SANE_MEMCMP /**/ + /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is * supported. @@ -1852,6 +1838,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setsent HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +#$d_setspent HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1859,12 +1851,55 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setvbuf HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +#$d_sfio USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ #$d_shm HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +#$d_sigaction HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +#$d_sigsetjmp HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1912,6 +1947,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_msg_proxy HAS_MSG_PROXY /**/ #$d_scm_rights HAS_SCM_RIGHTS /**/ +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +#$d_sqrtl HAS_SQRTL /**/ + /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. @@ -1920,6 +1961,88 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_statblks USE_STAT_BLOCKS /**/ #endif +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3), + * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +#$d_statfs_f_flags HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +#$d_statfs_s HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +#$d_fstatvfs HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#$d_stdstdio USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) $stdio_ptr +#$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) $stdio_cnt +#$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#$d_stdiobase USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) $stdio_base +#define FILE_bufsiz(fp) $stdio_bufsiz +#endif + /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is * available to translate error numbers to strings. See the writeup @@ -1939,6 +2062,52 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_syserrlst HAS_SYS_ERRLIST /**/ #define Strerror(e) $d_strerrm +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +#$d_strtold HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +#$d_strtoll HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +#$d_strtoull HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +#$d_strtouq HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#$d_telldirproto HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t $timetype /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#$d_times HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including <sys/sem.h>. If not, the user code @@ -1961,6 +2130,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_semctl_semun USE_SEMCTL_SEMUN /**/ #$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +#$d_ustat HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1974,6 +2149,78 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Signal_t $signal_t /* Signal handler's return type */ +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#$d_vprintf HAS_VPRINTF /**/ +#$d_charvspr USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#$usedl USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE $doublesize /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +#$ebcdic EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#$fflushNULL FFLUSH_NULL /**/ +#$fflushall FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t $fpostype /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f $gidformat /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size $gidsize /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t $gidtype /* Type for getgid(), etc... */ + /* Groups_t: * This symbol holds the type used for the second argument to * getgroups() and setgropus(). Usually, this is the same as @@ -1987,6 +2234,19 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define Groups_t $groupstype /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t $db_hashtype /**/ +#define DB_Prefix_t $db_prefixtype /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include <grp.h>. @@ -1998,12 +2258,54 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$i_grp I_GRP /**/ #$d_grpasswd GRPASSWD /**/ +/* I_ICONV: + * This symbol, if defined, indicates that <iconv.h> exists and + * should be included. + */ +#$i_iconv I_ICONV /**/ + +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include <inttypes.h>. + */ +#$i_inttypes I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include <mach/cthreads.h>. + */ +#$i_machcthr I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that <mntent.h> exists and + * should be included. + */ +#$i_mntent I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that <netdb.h> exists and * should be included. */ #$i_netdb I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/tcp.h>. + */ +#$i_netinettcp I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that <poll.h> exists and + * should be included. + */ +#$i_poll I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include <pthread.h>. + */ +#$i_pthread I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include <pwd.h>. @@ -2050,297 +2352,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_pwgecos PWGECOS /**/ #$d_pwpasswd PWPASSWD /**/ -/* I_SYSUIO: - * This symbol, if defined, indicates that <sys/uio.h> exists and - * should be included. - */ -#$i_sysuio I_SYSUIO /**/ - -/* Free_t: - * This variable contains the return type of free(). It is usually - * void, but occasionally int. - */ -/* Malloc_t: - * This symbol is the type of pointer returned by malloc and realloc. - */ -#define Malloc_t $malloctype /**/ -#define Free_t $freetype /**/ - -/* MYMALLOC: - * This symbol, if defined, indicates that we're using our own malloc. - */ -#$d_mymalloc MYMALLOC /**/ - -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -#define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num_init /**/ - -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED $defvoidused -#endif -#define VOIDFLAGS $voidflags -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. - */ -#$d_atolf HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. - */ -#$d_atoll HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always $undef - * for those versions. - */ -#$d_bincompat5005 PERL_BINCOMPAT_5005 /**/ - -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. - */ -#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -#$d_endspent HAS_ENDSPENT /**/ - -/* HAS_STRUCT_FS_DATA: - * This symbol, if defined, indicates that the struct fs_data - * to do statfs() is supported. - */ -#$d_fs_data_s HAS_STRUCT_FS_DATA /**/ - -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). - */ -#$d_fseeko HAS_FSEEKO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems by file descriptors. - */ -#$d_fstatfs HAS_FSTATFS /**/ -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). - */ -#$d_ftello HAS_FTELLO /**/ - -/* HAS_GETMNT: - * This symbol, if defined, indicates that the getmnt routine is - * available to get filesystem mount info by filename. - */ -#$d_getmnt HAS_GETMNT /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems to get their info. - */ -#$d_getmntent HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -#$d_getspent HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. - */ -#$d_getspnam HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. - */ -#$d_hasmntopt HAS_HASMNTOPT /**/ - -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the <inttypes.h> needs to be included, but sometimes - * <sys/types.h> is enough. - */ -#$d_int64t HAS_INT64_T /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's <float.h> - * or <limits.h> defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. - */ -#$d_ldbl_dig HAS_LDBL_DIG /* */ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -#$d_setspent HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. - */ -#$d_sfio USE_SFIO /**/ - -/* HAS_SQRTL: - * This symbol, if defined, indicates that the sqrtl routine is - * available to do long double square roots. - */ -#$d_sqrtl HAS_SQRTL /**/ - -/* HAS_STRUCT_STATFS_F_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem containing the file. - * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3), - * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not - * have statfs() and struct statfs, they have ustat() and getmnt() - * with struct ustat and struct fs_data. - */ -#$d_statfs_f_flags HAS_STRUCT_STATFS_F_FLAGS /**/ - -/* HAS_STRUCT_STATFS: - * This symbol, if defined, indicates that the struct statfs - * to do statfs() is supported. - */ -#$d_statfs_s HAS_STRUCT_STATFS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems by file descriptors. - */ -#$d_fstatvfs HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); - */ -#$d_telldirproto HAS_TELLDIR_PROTO /**/ - -/* HAS_USTAT: - * This symbol, if defined, indicates that the ustat system call is - * available to query file system statistics by dev_t. - */ -#$d_ustat HAS_USTAT /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. - */ -#$usedl USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. - */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. - */ -#$fflushNULL FFLUSH_NULL /**/ -#$fflushall FFLUSH_ALL /**/ - -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the <db.h> header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. - */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the <db.h> header file. In older versions of DB, it was - * int, while in newer ones it is size_t. - */ -#define DB_Hash_t $db_hashtype /**/ -#define DB_Prefix_t $db_prefixtype /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include <inttypes.h>. - */ -#$i_inttypes I_INTTYPES /**/ - -/* I_MNTENT: - * This symbol, if defined, indicates that <mntent.h> exists and - * should be included. - */ -#$i_mntent I_MNTENT /**/ - -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include <netinet/tcp.h>. - */ -#$i_netinettcp I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that <poll.h> exists and - * should be included. - */ -#$i_poll I_POLL /**/ - /* I_SHADOW: * This symbol, if defined, indicates that <shadow.h> exists and * should be included. @@ -2353,6 +2364,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_socks I_SOCKS /**/ +/* I_SYSLOG: + * This symbol, if defined, indicates that <syslog.h> exists and + * should be included. + */ +#$i_syslog I_SYSLOG /**/ + +/* I_SYSMODE: + * This symbol, if defined, indicates that <sys/mode.h> exists and + * should be included. + */ +#$i_sysmode I_SYSMODE /**/ + /* I_SYS_MOUNT: * This symbol, if defined, indicates that <sys/mount.h> exists and * should be included. @@ -2370,26 +2393,60 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_sysstatvfs I_SYS_STATVFS /**/ +/* I_SYSUIO: + * This symbol, if defined, indicates that <sys/uio.h> exists and + * should be included. + */ +#$i_sysuio I_SYSUIO /**/ + +/* I_SYSUTSNAME: + * This symbol, if defined, indicates that <sys/utsname.h> exists and + * should be included. + */ +#$i_sysutsname I_SYSUTSNAME /**/ + /* I_SYS_VFS: * This symbol, if defined, indicates that <sys/vfs.h> exists and * should be included. */ #$i_sysvfs I_SYS_VFS /**/ +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <time.h>. + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h>. + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h> with KERNEL defined. + */ +#$i_time I_TIME /**/ +#$i_systime I_SYS_TIME /**/ +#$i_systimek I_SYS_TIME_KERNEL /**/ + /* I_USTAT: * This symbol, if defined, indicates that <ustat.h> exists and * should be included. */ #$i_ustat I_USTAT /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +#define PERL_INC_VERSION_LIST $inc_version_list_init /**/ + +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. */ -#$d_off64_t HAS_OFF64_T /**/ -#$d_fpos64_t HAS_FPOS64_T /**/ +#$installusrbinperl INSTALL_USR_BIN_PERL /**/ /* PERL_PRIfldbl: * This symbol, if defined, contains the string used by stdio to @@ -2402,6 +2459,92 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ #$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t $lseektype /* <offset> type */ +#define LSEEKSIZE $lseeksize /* <offset> size */ +#define Off_t_size $lseeksize /* <offset> size */ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ +/* Malloc_t: + * This symbol is the type of pointer returned by malloc and realloc. + */ +#define Malloc_t $malloctype /**/ +#define Free_t $freetype /**/ + +/* MYMALLOC: + * This symbol, if defined, indicates that we're using our own malloc. + */ +#$d_mymalloc MYMALLOC /**/ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t $modetype /* file mode parameter for system calls */ + +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK $o_nonblock +#define VAL_EAGAIN $eagain +#define RD_NODATA $rd_nodata +#$d_eofnblk EOF_NONBLOCK + +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). + */ +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). + */ +#define Netdb_host_t $netdb_host_type /**/ +#define Netdb_hlen_t $netdb_hlen_type /**/ +#define Netdb_name_t $netdb_name_type /**/ +#define Netdb_net_t $netdb_net_type /**/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2465,6 +2608,10 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- /* U64SIZE: * This symbol contains the sizeof(U64). */ +/* NV_PRESERVES_UV: + * This symbol, if defined, indicates that a variable of type NVTYPE + * can preserve all the bit of a variable of type UVSIZE. + */ #define IVTYPE $ivtype /**/ #define UVTYPE $uvtype /**/ #define I8TYPE $i8type /**/ @@ -2490,6 +2637,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define I64SIZE $i64size /**/ #define U64SIZE $u64size /**/ #endif +#$d_nv_preserves_uv NV_PRESERVES_UV /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -2512,6 +2660,59 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define UVof $uvoformat /**/ #define UVxf $uvxformat /**/ +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Pid_t $pidtype /* PID type */ + +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "$privlib" /**/ +#define PRIVLIB_EXP "$privlibexp" /**/ + +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). + */ +#define PTRSIZE $ptrsize /**/ + +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() $drand01 /**/ +#define Rand_seed_t $randseedtype /**/ +#define seedDrand01(x) $seedfunc((Rand_seed_t)x) /**/ +#define RANDBITS $randbits /**/ + /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. * That is, if you do select(n, ...), how many bits at least will be @@ -2521,6 +2722,99 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define SELECT_MIN_BITS $selectminbits /**/ +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t $selecttype /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NAME $sig_name_init /**/ +#define SIG_NUM $sig_num_init /**/ + +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITEARCH "$sitearch" /**/ +#define SITEARCH_EXP "$sitearchexp" /**/ + +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITELIB "$sitelib" /**/ +#define SITELIB_EXP "$sitelibexp" /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t $sizetype /* length paramater for string functions */ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include <sys/types.h> or <unistd.h> + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#define SSize_t $ssizetype /* signed count of bytes */ + /* STARTPERL: * This variable contains the string to put in front of a perl * script to make sure (one hopes) that it runs with perl and not @@ -2539,25 +2833,52 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY /**/ #define STDIO_STREAM_ARRAY $stdio_stream_array -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -#$d_strtoull HAS_STRTOULL /**/ +#define Uid_t_f $uidformat /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size $uidsize /* UID size */ -/* USE_64_BITS: +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t $uidtype /* UID type */ + +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -#$use64bits USE_64_BITS /**/ +/* USE_64_BIT_ALL: + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers + * will be used (be they 32 or 64 bits). The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_INT +#$use64bitint USE_64_BIT_INT /**/ +#endif + +#ifndef USE_64_BIT_ALL +#$use64bitall USE_64_BIT_ALL /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES #$uselargefiles USE_LARGE_FILES /**/ @@ -2571,14 +2892,10 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$uselongdouble USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. +/* USE_MORE_BITS: + * This symbol, if defined, indicates that 64-bit interfaces and + * long doubles should be used when available. */ -#ifndef USE_LONG_LONG -#$uselonglong USE_LONG_LONG /**/ -#endif - #ifndef USE_MORE_BITS #$usemorebits USE_MORE_BITS /**/ #endif @@ -2608,6 +2925,56 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$usesocks USE_SOCKS /**/ #endif +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. + */ +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. + */ +/* OLD_PTHREADS_API: + * This symbol, if defined, indicates that Perl should + * be built to use the old draft POSIX threads API. + */ +#$use5005threads USE_5005THREADS /**/ +#$useithreads USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif +#$d_oldpthreads OLD_PTHREADS_API /**/ + +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ + +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED $defvoidused +#endif +#define VOIDFLAGS $voidflags +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and @@ -2640,234 +3007,28 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION $xs_apiversion /* Change to string for tuples?*/ -#define PERL_PM_APIVERSION $pm_apiversion /* Change to string for tuples?*/ - -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -#$d_drand48proto HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_gethostprotos HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getnetprotos HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that <netdb.h> includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getservprotos HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t $netdb_host_type /**/ -#define Netdb_hlen_t $netdb_hlen_type /**/ -#define Netdb_name_t $netdb_name_type /**/ -#define Netdb_net_t $netdb_net_type /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t $selecttype /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "$archname" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -#$d_old_pthread_create_joinable OLD_PTHREAD_CREATE_JOINABLE $old_pthread_create_joinable /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -#$d_pthread_yield HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD $sched_yield /**/ -#$d_sched_yield HAS_SCHED_YIELD /**/ +#define PERL_XS_APIVERSION "$xs_apiversion" +#define PERL_PM_APIVERSION "$pm_apiversion" -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include <mach/cthreads.h>. +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the getfsstat routine is + * available to stat filesystems in bulk. */ -#$i_machcthr I_MACH_CTHREADS /**/ +#$d_getfsstat HAS_GETFSSTAT /**/ -/* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include <pthread.h>. - */ -#$i_pthread I_PTHREAD /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. - */ -/* OLD_PTHREADS_API: - * This symbol, if defined, indicates that Perl should - * be built to use the old draft POSIX threads API. - */ -#ifndef USE_TTHREADS -#$usethreads USE_THREADS /**/ -#endif -#$d_oldpthreads OLD_PTHREADS_API /**/ - -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case <sys/types.h> should be - * included). - */ -#define Time_t $timetype /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include <sys/times.h>. - */ -#$d_times HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Fpos_t $fpostype /* File position type */ - -/* Gid_t_f: - * This symbol defines the format string used for printing a Gid_t. - */ -#define Gid_t_f $gidformat /**/ - -/* Gid_t_size: - * This symbol holds the size of a Gid_t in bytes. - */ -#define Gid_t_size $gidsize /* GID size */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include <sys/types.h> to get - * any typedef'ed information. - */ -#define Gid_t $gidtype /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -/* Off_t_size: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t $lseektype /* <offset> type */ -#define LSEEKSIZE $lseeksize /* <offset> size */ -#define Off_t_size $lseeksize /* <offset> size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include <sys/types.h> - * to get any typedef'ed information. - */ -#define Mode_t $modetype /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Pid_t $pidtype /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * <sys/types.h> to get any typedef'ed information. - */ -#define Size_t $sizetype /* length paramater for string functions */ - -/* Uid_t_f: - * This symbol defines the format string used for printing a Uid_t. - */ -#define Uid_t_f $uidformat /**/ - -/* Uid_t_size: - * This symbol holds the size of a Uid_t in bytes. +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek(int, off_t, int); */ -#define Uid_t_size $uidsize /* UID size */ +#$d_lseekproto HAS_LSEEK_PROTO /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * <sys/types.h> to get any typedef'ed information. +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). */ -#define Uid_t $uidtype /* UID type */ +#define Sock_size_t $socksizetype /**/ #endif !GROK!THIS! diff --git a/vos/vos_dummies.c b/vos/vos_dummies.c index 3c0852db60..ec4964574e 100644 --- a/vos/vos_dummies.c +++ b/vos/vos_dummies.c @@ -86,6 +86,11 @@ extern void Perl_dump_mstats (char *s) bomb ("Perl_dump_mstats"); } +extern int Perl_get_mstats (struct perl_mstats *buf, int buflen, int level) +{ + bomb ("Perl_get_mstats"); +} + extern pid_t waitpid (pid_t pid, int *stat_loc, int options) { diff --git a/warnings.h b/warnings.h index 8c1bbf752c..31942e1e66 100644 --- a/warnings.h +++ b/warnings.h @@ -61,46 +61,56 @@ #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_DEPRECATED 17 -#define WARN_DIGIT 18 -#define WARN_OCTAL 19 -#define WARN_PARENTHESIS 20 -#define WARN_PRECEDENCE 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 */ diff --git a/warnings.pl b/warnings.pl index 9d571038e2..0952305b28 100644 --- a/warnings.pl +++ b/warnings.pl @@ -9,43 +9,52 @@ sub DEFAULT_ON () { 1 } 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, } ; @@ -103,6 +112,32 @@ sub mkRange } ########################################################################### +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 { @@ -124,6 +159,12 @@ sub mkHex ########################################################################### +if (@ARGV && $ARGV[0] eq "tree") +{ + print " all -+\n" ; + printTree($tree, " ", 4) ; + exit ; +} #unlink "warnings.h"; #unlink "lib/warnings.pm"; @@ -255,6 +296,7 @@ foreach $k (sort keys %list) { } print PM " );\n\n" ; +print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ; while (<DATA>) { print PM $_ ; } @@ -281,13 +323,35 @@ warnings - Perl pragma to control optional warnings 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 @@ -326,12 +390,34 @@ sub unimport { 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; diff --git a/win32/Makefile b/win32/Makefile index 6bf5e6ec33..4203378ec4 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -29,7 +29,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.5.650 +INST_VER = \5.5.660 # # Comment this out if you DON'T want your perl installation to have @@ -471,6 +471,7 @@ UTILS = \ ..\pod\podselect \ ..\x2p\find2perl \ ..\x2p\s2p \ + bin\exetype.pl \ bin\runperl.pl \ bin\pl2bat.pl \ bin\perlglob.pl \ @@ -620,7 +621,8 @@ SETARGV_OBJ = setargv$(o) !ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -641,6 +643,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -657,6 +660,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -675,7 +679,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -692,7 +697,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -957,6 +963,12 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs $(MAKE) cd ..\..\win32 +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\win32 + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl diff --git a/win32/bin/exetype.pl b/win32/bin/exetype.pl index 5846b3ee3b..27e3b94bc8 100644 --- a/win32/bin/exetype.pl +++ b/win32/bin/exetype.pl @@ -1,26 +1,60 @@ #!perl -w use strict; -unless (@ARGV == 2) { - print "Usage: $0 exefile [CONSOLE|WINDOWS]\n"; + +# All the IMAGE_* structures are defined in the WINNT.H file +# of the Microsoft Platform SDK. + +my %subsys = (NATIVE => 1, + WINDOWS => 2, + CONSOLE => 3, + POSIX => 7, + WINDOWSCE => 9); + +unless (0 < @ARGV && @ARGV < 3) { + printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys; exit; } -unless ($ARGV[1] =~ /^(console|windows)$/i) { - print "Invalid subsystem $ARGV[1], please use CONSOLE or WINDOWS\n"; + +$ARGV[1] = uc $ARGV[1] if $ARGV[1]; +unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) { + (my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/; + print "Invalid subsystem $ARGV[1], please use $subsys\n"; exit; } -my ($record,$magic,$offset,$size); -open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!"; + +my ($record,$magic,$signature,$offset,$size); +open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n"; binmode EXE; -read EXE, $record, 32*4; + +# read IMAGE_DOS_HEADER structure +read EXE, $record, 64; ($magic,$offset) = unpack "Sx58L", $record; -die "Not an MSDOS executable file" unless $magic == 0x5a4d; + +die "$ARGV[0] is not an MSDOS executable file.\n" + unless $magic == 0x5a4d; # "MZ" + +# read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER seek EXE, $offset, 0; -read EXE, $record, 24; -($magic,$size) = unpack "Lx16S", $record; -die "PE header not found" unless $magic == 0x4550; -die "Optional header not in NT32 format" unless $size == 224; -seek EXE, $offset+24+68, 0; -print EXE pack "S", uc($ARGV[1]) eq 'CONSOLE' ? 3 : 2; +read EXE, $record, 4+20+2; +($signature,$size,$magic) = unpack "Lx16Sx2S", $record; + +die "PE header not found" unless $signature == 0x4550; # "PE\0\0" + +die "Optional header is neither in NT32 nor in NT64 format" + unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC + ($size == 240 && $magic == 0x20b); # IMAGE_NT_OPTIONAL_HDR64_MAGIC + +# Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code +seek EXE, $offset+4+20+68, 0; +if (@ARGV == 1) { + read EXE, $record, 2; + my ($subsys) = unpack "S", $record; + $subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)"; + print "$ARGV[0] uses the $subsys subsystem.\n"; +} +else { + print EXE pack "S", $subsys{$ARGV[1]}; +} close EXE; __END__ @@ -52,6 +86,19 @@ use a console supplied by the operating system. The WINDOWS subsystem handles an application that does not require a console and creates its own windows, if required. +=item NATIVE + +The NATIVE subsystem handles a Windows NT device driver. + +=item WINDOWSCE + +The WINDOWSCE subsystem handles Windows CE consumer electronics +applications. + +=item POSIX + +The POSIX subsystem handles a POSIX application in Windows NT. + =back =head1 AUTHOR diff --git a/win32/config.bc b/win32/config.bc index fd70a3f560..fe321aaccd 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -147,6 +147,8 @@ d_fstatfs='undef' d_fstatvfs='undef' d_ftello='undef' d_ftime='define' +d_getcwd='undef' +d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -164,13 +166,13 @@ d_getnetprotos='undef' d_getpbyname='define' d_getpbynumber='define' d_getpent='undef' -d_getpwent='undef' d_getpgid='undef' d_getpgrp2='undef' d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' @@ -178,23 +180,25 @@ d_getservprotos='define' d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' +d_gnulibc='undef' d_grpasswd='undef' d_hasmntopt='undef' -d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' d_int64t='undef' d_isascii='define' d_killpg='undef' -d_ldbl_dig='define' d_lchown='undef' +d_ldbl_dig='define' d_link='define' d_locconv='define' d_lockf='undef' d_longdbl='define' d_longlong='undef' +d_lseekproto='define' d_lstat='undef' +d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' @@ -204,8 +208,13 @@ d_memcpy='define' d_memmove='define' d_memset='define' d_mkdir='define' +d_mkdtemp='undef' d_mkfifo='undef' +d_mkstemp='undef' +d_mkstemps='undef' d_mktime='define' +d_mmap='undef' +d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -216,6 +225,8 @@ d_msgctl='undef' d_msgget='undef' d_msgrcv='undef' d_msgsnd='undef' +d_msync='undef' +d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_off64_t='undef' @@ -262,7 +273,6 @@ d_seteuid='undef' d_setgrent='undef' d_setgrps='undef' d_sethent='undef' -d_setpwent='undef' d_setlinebuf='undef' d_setlocale='define' d_setnent='undef' @@ -271,6 +281,7 @@ d_setpgid='undef' d_setpgrp2='undef' d_setpgrp='undef' d_setprior='undef' +d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' @@ -540,6 +551,7 @@ man3ext='3' medium='' mips_type='' mkdir='mkdir' +mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -646,6 +658,7 @@ small='' so='dll' sockethdr='' socketlib='' +socksizetype='int' sort='sort' spackage='Perl5' spitshell='' @@ -693,12 +706,12 @@ uname='uname' uniq='uniq' uquadtype='unsigned __int64' use5005threads='undef' -use64bits='undef' +use64bitall='undef' +use64bitint='undef' usedl='define' useithreads='undef' uselargefiles='undef' uselongdouble='undef' -uselonglong='undef' usemorebits='undef' usemultiplicity='undef' usemymalloc='n' diff --git a/win32/config.gc b/win32/config.gc index 10a1c778f9..9c6f1f6dce 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -147,6 +147,8 @@ d_fstatfs='undef' d_fstatvfs='undef' d_ftello='undef' d_ftime='define' +d_getcwd='undef' +d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -164,13 +166,13 @@ d_getnetprotos='undef' d_getpbyname='define' d_getpbynumber='define' d_getpent='undef' -d_getpwent='undef' d_getpgid='undef' d_getpgrp2='undef' d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' @@ -178,23 +180,25 @@ d_getservprotos='define' d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' +d_gnulibc='undef' d_grpasswd='undef' d_hasmntopt='undef' -d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' d_int64t='undef' d_isascii='define' d_killpg='undef' -d_ldbl_dig='define' d_lchown='undef' +d_ldbl_dig='define' d_link='define' d_locconv='define' d_lockf='undef' d_longdbl='define' d_longlong='undef' +d_lseekproto='define' d_lstat='undef' +d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' @@ -204,8 +208,13 @@ d_memcpy='define' d_memmove='define' d_memset='define' d_mkdir='define' +d_mkdtemp='undef' d_mkfifo='undef' +d_mkstemp='undef' +d_mkstemps='undef' d_mktime='define' +d_mmap='undef' +d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -216,6 +225,8 @@ d_msgctl='undef' d_msgget='undef' d_msgrcv='undef' d_msgsnd='undef' +d_msync='undef' +d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_off64_t='undef' @@ -262,7 +273,6 @@ d_seteuid='undef' d_setgrent='undef' d_setgrps='undef' d_sethent='undef' -d_setpwent='undef' d_setlinebuf='undef' d_setlocale='define' d_setnent='undef' @@ -271,6 +281,7 @@ d_setpgid='undef' d_setpgrp2='undef' d_setpgrp='undef' d_setprior='undef' +d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' @@ -540,6 +551,7 @@ man3ext='3' medium='' mips_type='' mkdir='mkdir' +mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -646,6 +658,7 @@ small='' so='dll' sockethdr='' socketlib='' +socksizetype='int' sort='sort' spackage='Perl5' spitshell='' @@ -693,12 +706,12 @@ uname='uname' uniq='uniq' uquadtype='unsigned long long' use5005threads='undef' -use64bits='undef' +use64bitall='undef' +use64bitint='undef' usedl='define' useithreads='undef' uselargefiles='undef' uselongdouble='undef' -uselonglong='undef' usemorebits='undef' usemultiplicity='undef' usemymalloc='n' diff --git a/win32/config.vc b/win32/config.vc index 5514827e86..ed981567fb 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -147,6 +147,8 @@ d_fstatfs='undef' d_fstatvfs='undef' d_ftello='undef' d_ftime='define' +d_getcwd='undef' +d_getfsstat='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -164,13 +166,13 @@ d_getnetprotos='undef' d_getpbyname='define' d_getpbynumber='define' d_getpent='undef' -d_getpwent='undef' d_getpgid='undef' d_getpgrp2='undef' d_getpgrp='undef' d_getppid='undef' d_getprior='undef' d_getprotoprotos='define' +d_getpwent='undef' d_getsbyname='define' d_getsbyport='define' d_getsent='undef' @@ -178,23 +180,25 @@ d_getservprotos='define' d_getspent='undef' d_getspnam='undef' d_gettimeod='undef' +d_gnulibc='undef' d_grpasswd='undef' d_hasmntopt='undef' -d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' d_int64t='undef' d_isascii='define' d_killpg='undef' -d_ldbl_dig='define' d_lchown='undef' +d_ldbl_dig='define' d_link='define' d_locconv='define' d_lockf='undef' d_longdbl='define' d_longlong='undef' +d_lseekproto='define' d_lstat='undef' +d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' @@ -204,8 +208,13 @@ d_memcpy='define' d_memmove='define' d_memset='define' d_mkdir='define' +d_mkdtemp='undef' d_mkfifo='undef' +d_mkstemp='undef' +d_mkstemps='undef' d_mktime='define' +d_mmap='undef' +d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -216,6 +225,8 @@ d_msgctl='undef' d_msgget='undef' d_msgrcv='undef' d_msgsnd='undef' +d_msync='undef' +d_munmap='undef' d_mymalloc='undef' d_nice='undef' d_off64_t='undef' @@ -262,7 +273,6 @@ d_seteuid='undef' d_setgrent='undef' d_setgrps='undef' d_sethent='undef' -d_setpwent='undef' d_setlinebuf='undef' d_setlocale='define' d_setnent='undef' @@ -271,6 +281,7 @@ d_setpgid='undef' d_setpgrp2='undef' d_setpgrp='undef' d_setprior='undef' +d_setpwent='undef' d_setregid='undef' d_setresgid='undef' d_setresuid='undef' @@ -540,6 +551,7 @@ man3ext='3' medium='' mips_type='' mkdir='mkdir' +mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -646,6 +658,7 @@ small='' so='dll' sockethdr='' socketlib='' +socksizetype='int' sort='sort' spackage='Perl5' spitshell='' @@ -693,12 +706,12 @@ uname='uname' uniq='uniq' uquadtype='unsigned __int64' use5005threads='undef' -use64bits='undef' +use64bitall='undef' +use64bitint='undef' usedl='define' useithreads='undef' uselargefiles='undef' uselongdouble='undef' -uselonglong='undef' usemorebits='undef' usemultiplicity='undef' usemymalloc='n' @@ -732,8 +745,8 @@ xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' PERL_REVISION='~PERL_REVISION~' -PERL_VERSION='~PERL_VERSION~' PERL_SUBVERSION='~PERL_SUBVERSION~' +PERL_VERSION='~PERL_VERSION~' PERL_API_REVISION='~PERL_API_REVISION~' PERL_API_SUBVERSION='~PERL_API_SUBVERSION~' PERL_API_VERSION='~PERL_API_VERSION~' diff --git a/win32/config_H.bc b/win32/config_H.bc index e89f71eecd..868e9a35d6 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -293,6 +293,12 @@ */ /*#define HAS_LSTAT /**/ +/* HAS_MADVISE: + * This symbol, if defined, indicates that the madvise routine is + * available to hint about the expected access behavior. + */ +/*#define HAS_MADVISE /**/ + /* HAS_MBLEN: * This symbol, if defined, indicates that the mblen routine is available * to find the number of bytes in a multibye character. @@ -344,6 +350,12 @@ */ #define HAS_MKDIR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +/*#define HAS_MKDTEMP /**/ + /* HAS_MKFIFO: * This symbol, if defined, indicates that the mkfifo routine is * available to create FIFOs. Otherwise, mknod should be able to @@ -352,6 +364,20 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * extemporary file. + */ +/*#define HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to exclusively create and open a uniquely named + * (with a suffix) temporary file. + */ +/*#define HAS_MKSTEMPS /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1082,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1113,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -1338,6 +1364,7 @@ * available to stat filesystems by file descriptors. */ /*#define HAS_FSTATFS /**/ + /* HAS_FTELLO: * This symbol, if defined, indicates that the ftello routine is * available to ftell beyond 32 bits (useful for ILP32 hosts). @@ -1361,6 +1388,18 @@ */ #define Gconvert(x,n,t,b) gcvt((x),(n),(b)) +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +/*#define HAS_GETCWD /**/ + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems in bulk. + */ +/*#define HAS_GETFSSTAT /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1608,6 +1647,14 @@ #define LONGLONGSIZE 8 /**/ #endif +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek _((int, off_t, int)); + */ +#define HAS_LSEEK_PROTO /**/ + /* HAS_MEMCHR: * This symbol, if defined, indicates that the memchr routine is available * to locate characters within a C string. @@ -1836,6 +1883,12 @@ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + /* HAS_SQRTL: * This symbol, if defined, indicates that the sqrtl routine is * available to do long double square roots. @@ -2540,8 +2593,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2639,7 +2692,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2657,8 +2710,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2713,19 +2766,35 @@ */ #define Uid_t uid_t /* UID type */ -/* USE_64_BITS: +/* USE_64_BIT_ALL: + * This variable conditionally defines the USE_64_BIT_ALL symbol, + * and indicates that 64-bit integer types should be used + * when available. The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_ALL +/*#define USE_64_BIT_ALL /**/ +#endif + +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -/*#define USE_64_BITS /**/ +#ifndef USE_64_BIT_INT +/*#define USE_64_BIT_INT /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES /*#define USE_LARGE_FILES /**/ @@ -2739,14 +2808,6 @@ /*#define USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. - */ -#ifndef USE_LONG_LONG -/*#define USE_LONG_LONG /**/ -#endif - #ifndef USE_MORE_BITS /*#define USE_MORE_BITS /**/ #endif diff --git a/win32/config_H.gc b/win32/config_H.gc index d9adb8f8d7..e3ce507097 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -293,6 +293,12 @@ */ /*#define HAS_LSTAT /**/ +/* HAS_MADVISE: + * This symbol, if defined, indicates that the madvise routine is + * available to hint about the expected access behavior. + */ +/*#define HAS_MADVISE /**/ + /* HAS_MBLEN: * This symbol, if defined, indicates that the mblen routine is available * to find the number of bytes in a multibye character. @@ -344,6 +350,12 @@ */ #define HAS_MKDIR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +/*#define HAS_MKDTEMP /**/ + /* HAS_MKFIFO: * This symbol, if defined, indicates that the mkfifo routine is * available to create FIFOs. Otherwise, mknod should be able to @@ -352,6 +364,20 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +/*#define HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to exclusively create and open a uniquely named + * (with a suffix) temporary file. + */ +/*#define HAS_MKSTEMPS /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1082,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1113,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -1338,6 +1364,7 @@ * available to stat filesystems by file descriptors. */ /*#define HAS_FSTATFS /**/ + /* HAS_FTELLO: * This symbol, if defined, indicates that the ftello routine is * available to ftell beyond 32 bits (useful for ILP32 hosts). @@ -1361,6 +1388,18 @@ */ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +/*#define HAS_GETCWD /**/ + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems in bulk. + */ +/*#define HAS_GETFSSTAT /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1608,6 +1647,14 @@ #define LONGLONGSIZE 8 /**/ #endif +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek _((int, off_t, int)); + */ +#define HAS_LSEEK_PROTO /**/ + /* HAS_MEMCHR: * This symbol, if defined, indicates that the memchr routine is available * to locate characters within a C string. @@ -1836,6 +1883,12 @@ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + /* HAS_SQRTL: * This symbol, if defined, indicates that the sqrtl routine is * available to do long double square roots. @@ -2540,8 +2593,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2639,7 +2692,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2657,8 +2710,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2713,19 +2766,35 @@ */ #define Uid_t uid_t /* UID type */ -/* USE_64_BITS: +/* USE_64_BIT_ALL: + * This variable conditionally defines the USE_64_BIT_ALL symbol, + * and indicates that 64-bit integer types should be used + * when available. The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_ALL. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_ALL +/*#define USE_64_BIT_ALL /**/ +#endif + +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -/*#define USE_64_BITS /**/ +#ifndef USE_64_BIT_INT +/*#define USE_64_BIT_INT /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES /*#define USE_LARGE_FILES /**/ @@ -2739,14 +2808,6 @@ /*#define USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. - */ -#ifndef USE_LONG_LONG -/*#define USE_LONG_LONG /**/ -#endif - #ifndef USE_MORE_BITS /*#define USE_MORE_BITS /**/ #endif diff --git a/win32/config_H.vc b/win32/config_H.vc index 1cd5e65a60..6677bcc4ce 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -293,6 +293,12 @@ */ /*#define HAS_LSTAT /**/ +/* HAS_MADVISE: + * This symbol, if defined, indicates that the madvise routine is + * available to hint about the expected access behavior. + */ +/*#define HAS_MADVISE /**/ + /* HAS_MBLEN: * This symbol, if defined, indicates that the mblen routine is available * to find the number of bytes in a multibye character. @@ -344,6 +350,12 @@ */ #define HAS_MKDIR /**/ +/* HAS_MKDTEMP: + * This symbol, if defined, indicates that the mkdtemp routine is + * available to exclusively create a uniquely named temporary directory. + */ +/*#define HAS_MKDTEMP /**/ + /* HAS_MKFIFO: * This symbol, if defined, indicates that the mkfifo routine is * available to create FIFOs. Otherwise, mknod should be able to @@ -352,6 +364,20 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +/*#define HAS_MKSTEMP /**/ + +/* HAS_MKSTEMPS: + * This symbol, if defined, indicates that the mkstemps routine is + * available to exclusively create and open a uniquely named + * (with a suffix) temporary file. + */ +/*#define HAS_MKSTEMPS /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1082,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1113,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -1338,6 +1364,7 @@ * available to stat filesystems by file descriptors. */ /*#define HAS_FSTATFS /**/ + /* HAS_FTELLO: * This symbol, if defined, indicates that the ftello routine is * available to ftell beyond 32 bits (useful for ILP32 hosts). @@ -1361,6 +1388,18 @@ */ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) +/* HAS_GETCWD: + * This symbol, if defined, indicates that the getcwd routine is + * available to get the current working directory. + */ +/*#define HAS_GETCWD /**/ + +/* HAS_GETFSSTAT: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems in bulk. + */ +/*#define HAS_GETFSSTAT /**/ + /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1608,6 +1647,14 @@ #define LONGLONGSIZE 8 /**/ #endif +/* HAS_LSEEK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the lseek() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern off_t lseek _((int, off_t, int)); + */ +#define HAS_LSEEK_PROTO /**/ + /* HAS_MEMCHR: * This symbol, if defined, indicates that the memchr routine is available * to locate characters within a C string. @@ -1836,6 +1883,12 @@ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + /* HAS_SQRTL: * This symbol, if defined, indicates that the sqrtl routine is * available to do long double square roots. @@ -2540,8 +2593,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2639,7 +2692,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2657,8 +2710,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters @@ -2713,19 +2766,35 @@ */ #define Uid_t uid_t /* UID type */ -/* USE_64_BITS: +/* USE_64_BIT_ALL: + * This variable conditionally defines the USE_64_BIT_ALL symbol, + * and indicates that 64-bit integer types should be used + * when available. The maximal possible + * 64-bitness is employed: LP64 or ILP64, meaning that you will + * be able to use more than 2 gigabytes of memory. This mode is + * even more binary incompatible than USE_64_BIT_INT. You may not + * be able to run the resulting executable in a 32-bit CPU at all or + * you may need at least to reboot your OS to 64-bit mode. + */ +#ifndef USE_64_BIT_ALL +/*#define USE_64_BIT_ALL /**/ +#endif + +/* USE_64_BIT_INT: * This symbol, if defined, indicates that 64-bit integers should * be used when available. If not defined, the native integers - * will be used (be they 32 or 64 bits). + * will be employed (be they 32 or 64 bits). The minimal possible + * 64-bitness is used, just enough to get 64-bit integers into Perl. + * This may mean using for example "long longs", while your memory + * may still be limited to 2 gigabytes. */ -#ifndef USE_64_BITS -/*#define USE_64_BITS /**/ +#ifndef USE_64_BIT_INT +/*#define USE_64_BIT_INT /**/ #endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support - * should be used when available. The USE_64_BITS symbol will - * also be turned on if necessary. + * should be used when available. */ #ifndef USE_LARGE_FILES /*#define USE_LARGE_FILES /**/ @@ -2739,14 +2808,6 @@ /*#define USE_LONG_DOUBLE /**/ #endif -/* USE_LONG_LONG: - * This symbol, if defined, indicates that long longs should - * be used when available. - */ -#ifndef USE_LONG_LONG -/*#define USE_LONG_LONG /**/ -#endif - #ifndef USE_MORE_BITS /*#define USE_MORE_BITS /**/ #endif diff --git a/win32/makefile.mk b/win32/makefile.mk index 64f89fdbb3..6357300b18 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -33,7 +33,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER *= \5.5.650 +INST_VER *= \5.5.660 # # Comment this out if you DON'T want your perl installation to have @@ -99,9 +99,9 @@ INST_ARCH *= \$(ARCHNAME) # Visual C++ >= 6.x #CCTYPE *= MSVC60 # Borland 5.02 or later -CCTYPE *= BORLAND -# mingw32/gcc-2.95.2 or better -#CCTYPE *= GCC +#CCTYPE *= BORLAND +# mingw32+gcc-2.95.2 or better +CCTYPE *= GCC # # uncomment this if you are compiling under Windows 95/98 and command.com @@ -165,9 +165,9 @@ CCTYPE *= BORLAND # so you may have to set CCHOME explicitly (spaces in the path name should # not be quoted) # -CCHOME *= c:\bc5 +#CCHOME *= c:\bc5 #CCHOME *= $(MSVCDIR) -#CCHOME *= D:\packages\mingw32 +CCHOME *= c:\gcc-2.95.2-msvcrt CCINCDIR *= $(CCHOME)\include CCLIBDIR *= $(CCHOME)\lib @@ -288,8 +288,8 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) .ENDIF -.IF "$(USE_OBJECT)" == "define" -ARCHNAME = $(ARCHNAME)-thread +.IF "$(USE_ITHREADS)" == "define" +ARCHNAME !:= $(ARCHNAME)-thread .ENDIF # Visual Studio 98 specific @@ -409,6 +409,9 @@ OBJOUT_FLAG = -o EXEOUT_FLAG = -o LIBOUT_FLAG = +# NOTE: we assume that GCC uses MSVCRT.DLL +BUILDOPT += -fno-strict-aliasing -DPERL_MSVCRT_READFIX + .ELSE CC = cl @@ -576,6 +579,7 @@ UTILS = \ ..\pod\podselect \ ..\x2p\find2perl \ ..\x2p\s2p \ + bin\exetype.pl \ bin\runperl.pl \ bin\pl2bat.pl \ bin\perlglob.pl \ @@ -590,11 +594,7 @@ CFGH_TMPL = config_H.bc CFGSH_TMPL = config.gc CFGH_TMPL = config_H.gc -.IF "$(USE_OBJECT)" == "define" -PERLIMPLIB = ..\libperlcore$(a) -.ELSE -PERLIMPLIB = ..\libperl$(a) -.ENDIF +PERLIMPLIB = ..\libperl56$(a) .ELSE @@ -741,7 +741,8 @@ SETARGV_OBJ = setargv$(o) .ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -762,6 +763,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -778,6 +780,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -796,7 +799,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -813,7 +817,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -1182,6 +1187,11 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\$(*B) && $(MAKE) +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) && \ + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\Sys\$(*B) && $(MAKE) + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) && \ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl diff --git a/win32/perlhost.h b/win32/perlhost.h index 4b4ad586a4..a748ead0b2 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -486,6 +486,12 @@ PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl) return g_win32_get_sitelib(pl); } +void +PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr) +{ + win32_get_child_IO(ptr); +} + struct IPerlEnv perlEnv = { PerlEnvGetenv, @@ -500,6 +506,7 @@ struct IPerlEnv perlEnv = PerlEnvOsId, PerlEnvLibPath, PerlEnvSiteLibPath, + PerlEnvGetChildIO, }; #undef IPERL2HOST diff --git a/win32/vdir.h b/win32/vdir.h index 50822a7aa4..df9a10b130 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -25,14 +25,6 @@ public: WCHAR* MapPathW(const WCHAR *pInName); int SetCurrentDirectoryA(char *lpBuffer); int SetCurrentDirectoryW(WCHAR *lpBuffer); - inline const char *GetDirA(int index) - { - return dirTableA[index]; - }; - inline const WCHAR *GetDirW(int index) - { - return dirTableW[index]; - }; inline int GetDefault(void) { return nDefault; }; inline char* GetCurrentDirectoryA(int dwBufSize, char *lpBuffer) @@ -84,6 +76,32 @@ protected: SetDirW(pPath, index); nDefault = index; }; + inline const char *GetDirA(int index) + { + char *ptr = dirTableA[index]; + if (!ptr) { + /* simulate the existance of this drive */ + ptr = szLocalBufferA; + ptr[0] = 'A' + index; + ptr[1] = ':'; + ptr[2] = '\\'; + ptr[3] = 0; + } + return ptr; + }; + inline const WCHAR *GetDirW(int index) + { + WCHAR *ptr = dirTableW[index]; + if (!ptr) { + /* simulate the existance of this drive */ + ptr = szLocalBufferW; + ptr[0] = 'A' + index; + ptr[1] = ':'; + ptr[2] = '\\'; + ptr[3] = 0; + } + return ptr; + }; inline int DriveIndex(char chr) { @@ -265,6 +283,82 @@ inline void DoGetFullPathNameA(char* lpBuffer, DWORD dwSize, char* Dest) GetFullPathNameA(lpBuffer, dwSize, Dest, &pPtr); } +inline bool IsSpecialFileName(const char* pName) +{ + /* specical file names are devices that the system can open + * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$ + * (x is a single digit, and names are case-insensitive) + */ + char ch = (pName[0] & ~0x20); + switch (ch) + { + case 'A': /* AUX */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && !pName[3]) + return true; + break; + case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ + ch = (pName[1] & ~0x20); + switch (ch) + { + case 'L': /* CLOCK$ */ + if (((pName[2] & ~0x20) == 'O') + && ((pName[3] & ~0x20) == 'C') + && ((pName[4] & ~0x20) == 'K') + && (pName[5] == '$') + && !pName[6]) + return true; + break; + case 'O': /* COMx, CON, CONIN$ CONOUT$ */ + if ((pName[2] & ~0x20) == 'M') { + if ((pName[3] >= '1') && (pName[3] <= '9') + && !pName[4]) + return true; + } + else if ((pName[2] & ~0x20) == 'N') { + if (!pName[3]) + return true; + else if ((pName[3] & ~0x20) == 'I') { + if (((pName[4] & ~0x20) == 'N') + && (pName[5] == '$') + && !pName[6]) + return true; + } + else if ((pName[3] & ~0x20) == 'O') { + if (((pName[4] & ~0x20) == 'U') + && ((pName[5] & ~0x20) == 'T') + && (pName[6] == '$') + && !pName[7]) + return true; + } + } + break; + } + break; + case 'L': /* LPTx */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && (pName[3] >= '1') && (pName[3] <= '9') + && !pName[4]) + return true; + break; + case 'N': /* NUL */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'L') + && !pName[3]) + return true; + break; + case 'P': /* PRN */ + if (((pName[1] & ~0x20) == 'R') + && ((pName[2] & ~0x20) == 'N') + && !pName[3]) + return true; + break; + } + return false; +} + char *VDir::MapPathA(const char *pInName) { /* * possiblities -- relative path or absolute path with or without drive letter @@ -317,11 +411,16 @@ char *VDir::MapPathA(const char *pInName) } else { /* relative path */ - strcat(szBuffer, pInName); - if (strlen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; + if (IsSpecialFileName(pInName)) { + return (char*)pInName; + } + else { + strcat(szBuffer, pInName); + if (strlen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; - DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } } } } @@ -408,6 +507,82 @@ inline void DoGetFullPathNameW(WCHAR* lpBuffer, DWORD dwSize, WCHAR* Dest) GetFullPathNameW(lpBuffer, dwSize, Dest, &pPtr); } +inline bool IsSpecialFileName(const WCHAR* pName) +{ + /* specical file names are devices that the system can open + * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$ + * (x is a single digit, and names are case-insensitive) + */ + WCHAR ch = (pName[0] & ~0x20); + switch (ch) + { + case 'A': /* AUX */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && !pName[3]) + return true; + break; + case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ + ch = (pName[1] & ~0x20); + switch (ch) + { + case 'L': /* CLOCK$ */ + if (((pName[2] & ~0x20) == 'O') + && ((pName[3] & ~0x20) == 'C') + && ((pName[4] & ~0x20) == 'K') + && (pName[5] == '$') + && !pName[6]) + return true; + break; + case 'O': /* COMx, CON, CONIN$ CONOUT$ */ + if ((pName[2] & ~0x20) == 'M') { + if ((pName[3] >= '1') && (pName[3] <= '9') + && !pName[4]) + return true; + } + else if ((pName[2] & ~0x20) == 'N') { + if (!pName[3]) + return true; + else if ((pName[3] & ~0x20) == 'I') { + if (((pName[4] & ~0x20) == 'N') + && (pName[5] == '$') + && !pName[6]) + return true; + } + else if ((pName[3] & ~0x20) == 'O') { + if (((pName[4] & ~0x20) == 'U') + && ((pName[5] & ~0x20) == 'T') + && (pName[6] == '$') + && !pName[7]) + return true; + } + } + break; + } + break; + case 'L': /* LPTx */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && (pName[3] >= '1') && (pName[3] <= '9') + && !pName[4]) + return true; + break; + case 'N': /* NUL */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'L') + && !pName[3]) + return true; + break; + case 'P': /* PRN */ + if (((pName[1] & ~0x20) == 'R') + && ((pName[2] & ~0x20) == 'N') + && !pName[3]) + return true; + break; + } + return false; +} + WCHAR* VDir::MapPathW(const WCHAR *pInName) { /* * possiblities -- relative path or absolute path with or without drive letter @@ -460,11 +635,16 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* relative path */ - wcscat(szBuffer, pInName); - if (wcslen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; + if (IsSpecialFileName(pInName)) { + return (WCHAR*)pInName; + } + else { + wcscat(szBuffer, pInName); + if (wcslen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; - DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } } } } diff --git a/win32/win32.c b/win32/win32.c index 71097ea1ae..ff52692fec 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1132,6 +1132,7 @@ win32_stat(const char *path, struct stat *sbuf) if (S_ISDIR(sbuf->st_mode)) sbuf->st_mode |= S_IWRITE | S_IEXEC; else if (S_ISREG(sbuf->st_mode)) { + int perms; if (l >= 4 && path[l-4] == '.') { const char *e = path + l - 3; if (strnicmp(e,"exe",3) @@ -1144,6 +1145,9 @@ win32_stat(const char *path, struct stat *sbuf) } else sbuf->st_mode &= ~S_IEXEC; + /* Propagate permissions to _group_ and _others_ */ + perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC); + sbuf->st_mode |= (perms>>3) | (perms>>6); } #endif } @@ -2709,7 +2713,12 @@ _fixed_read(int fh, void *buf, unsigned cnt) 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; @@ -2857,7 +2866,8 @@ _fixed_read(int fh, void *buf, unsigned cnt) } functionexit: - LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ + if (_pioinfo(fh)->lockinitflag) + LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ return bytes_read; } @@ -3119,6 +3129,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) int ret; void* env; char* dir; + child_IO_table tbl; STARTUPINFO StartupInfo; PROCESS_INFORMATION ProcessInformation; DWORD create = 0; @@ -3147,9 +3158,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) } 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) @@ -3960,6 +3972,15 @@ Perl_win32_init(int *argcp, char ***argvp) 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 diff --git a/win32/win32.h b/win32/win32.h index 65d24e4c65..4e73a23fe6 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -75,6 +75,7 @@ #include <stdio.h> #include <direct.h> #include <stdlib.h> +#include <fcntl.h> #ifndef EXT #include "EXTERN.h" #endif @@ -300,6 +301,14 @@ DllExport int RunPerl(int argc, char **argv, char **env); 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 @@ -73,9 +73,7 @@ #define MEM_SIZE Size_t -#ifdef STANDARD_C -# include <stdlib.h> -#else +#ifndef STANDARD_C Malloc_t malloc (MEM_SIZE nbytes); Malloc_t calloc (MEM_SIZE elements, MEM_SIZE size); Malloc_t realloc (Malloc_t where, MEM_SIZE nbytes); |