diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-09-11 20:50:37 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-09-11 20:50:37 +0000 |
commit | 8545b19a71bec2bf174ceba51982f52749a4822b (patch) | |
tree | 1f5f2a8cc7511639b9210f1d5cdb85bf21ea1b17 | |
parent | 7481bb52051f557e66a749903d91c3b51ae46e5c (diff) | |
parent | 8a7fc0dc3015c8254ce4e866be71508e3379d45d (diff) | |
download | perl-8545b19a71bec2bf174ceba51982f52749a4822b.tar.gz |
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@4127
-rw-r--r-- | AUTHORS | 5 | ||||
-rw-r--r-- | Changes | 237 | ||||
-rw-r--r-- | MANIFEST | 6 | ||||
-rw-r--r-- | README.dos | 2 | ||||
-rw-r--r-- | XSUB.h | 3 | ||||
-rw-r--r-- | av.h | 20 | ||||
-rw-r--r-- | cop.h | 1 | ||||
-rw-r--r-- | djgpp/config.over | 5 | ||||
-rw-r--r-- | djgpp/configure.bat | 1 | ||||
-rw-r--r-- | djgpp/djgpp.c | 13 | ||||
-rw-r--r-- | djgpp/djgppsed.sh | 7 | ||||
-rw-r--r-- | dosish.h | 1 | ||||
-rw-r--r-- | embed.h | 10 | ||||
-rwxr-xr-x | embed.pl | 4 | ||||
-rw-r--r-- | ext/B/B/C.pm | 27 | ||||
-rw-r--r-- | ext/Data/Dumper/Dumper.pm | 7 | ||||
-rw-r--r-- | lib/ExtUtils/MM_Unix.pm | 4 | ||||
-rw-r--r-- | lib/Getopt/Long.pm | 51 | ||||
-rw-r--r-- | lib/Pod/Html.pm | 3 | ||||
-rw-r--r-- | objXSUB.h | 2 | ||||
-rw-r--r-- | op.c | 14 | ||||
-rw-r--r-- | patchlevel.h | 9 | ||||
-rw-r--r-- | perl.c | 1 | ||||
-rwxr-xr-x | perlapi.c | 2 | ||||
-rw-r--r-- | pod/Makefile | 4 | ||||
-rw-r--r-- | pod/buildtoc | 2 | ||||
-rw-r--r-- | pod/perl.pod | 1 | ||||
-rw-r--r-- | pod/perlcompile.pod | 443 | ||||
-rw-r--r-- | pod/perlre.pod | 71 | ||||
-rw-r--r-- | pod/pod2usage.PL | 5 | ||||
-rw-r--r-- | pod/podchecker.PL | 5 | ||||
-rw-r--r-- | pod/podselect.PL | 5 | ||||
-rw-r--r-- | pod/roffitall | 1 | ||||
-rw-r--r-- | pp.c | 1 | ||||
-rw-r--r-- | pp.h | 2 | ||||
-rw-r--r-- | pp_hot.c | 1 | ||||
-rw-r--r-- | proto.h | 3 | ||||
-rw-r--r-- | sv.h | 11 | ||||
-rwxr-xr-x | t/io/openpid.t | 4 | ||||
-rwxr-xr-x | t/lib/gol-basic.t | 24 | ||||
-rwxr-xr-x | t/lib/gol-compat.t | 25 | ||||
-rwxr-xr-x | t/lib/gol-linkage.t | 37 | ||||
-rw-r--r-- | util.c | 18 | ||||
-rw-r--r-- | win32/Makefile | 3 | ||||
-rw-r--r-- | win32/makefile.mk | 3 | ||||
-rw-r--r-- | x2p/s2p.PL | 6 | ||||
-rw-r--r-- | xsutils.c | 75 |
47 files changed, 1014 insertions, 171 deletions
@@ -39,7 +39,7 @@ mbiggar Mark A Biggar mab@wdl.loral.com mbligh Martin J. Bligh mbligh@sequent.com mike Mike Stok mike@stok.co.uk millert Todd Miller millert@openbsd.org -molnarl Laszlo Molnar molnarl@cdata.tvnet.hu +laszlo.molnar Laszlo Molnar Laszlo.Molnar@eth.ericsson.se mpeix Mark Bixby markb@cccd.edu muir David Muir Sharnoff muir@idiom.com neale Neale Ferguson neale@VMA.TABNSW.COM.AU @@ -86,7 +86,7 @@ cygwin win32 dec_osf jhi,spider dgux roderick doc tchrist -dos lmolnarl +dos laszlo.molnar dynix/ptx mbligh ebcdic vms,vmesa,posixbc filespec kjahds @@ -99,7 +99,6 @@ locale jhi,domo lynxos lynxos machten domo mm makemaker -msdos molnarl mvs pvhp netbsd jhi openbsd millert @@ -31,7 +31,7 @@ current addresses (as of July 1998): Doug MacEachern <dougm@opengroup.org> Paul Marquess <pmarquess@bfsec.bt.co.uk> Stephen McCamant <alias@mcs.com> - Laszlo Molnar <molnarl@cdata.tvnet.hu> + Laszlo Molnar <laszlo.molnar@eth.ericsson.se> Hans Mulder <hansmu@xs4all.nl> Matthias Neeracher <neeri@iis.ee.ethz.ch> Jeff Okamoto <okamoto@hpcc123.corp.hp.com> @@ -79,6 +79,241 @@ Version 5.005_62 Development release working toward 5.006 ---------------- ____________________________________________________________________________ +[ 4117] By: jhi on 1999/09/09 18:24:30 + Log: Remove ill-designed %B introduced by change #4111. + Branch: cfgperl + ! sv.c t/op/sprintf.t +____________________________________________________________________________ +[ 4116] By: jhi on 1999/09/09 15:56:52 + Log: perldeltify change #4115. + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4115] By: jhi on 1999/09/09 15:48:56 + Log: From: "John L. Allen" <allen@grumman.com> + To: perl5-porters@perl.org + Subject: [ID 19990901.003] Time::Local should not croak on "out-of-range" days + Date: Wed, 1 Sep 1999 13:33:39 -0400 (EDT) + Message-Id: <199909011733.NAA17356@gateway.grumman.com> + Branch: cfgperl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4114] By: jhi on 1999/09/09 15:42:30 + Log: From: "Daniel S. Lewart" <lewart@www.cvm.uiuc.edu> + To: perl5-porters@perl.org + Subject: [ID 19990909.003] MAXINT redefined warning on HP-UX 10.20 + Date: Thu, 9 Sep 1999 10:33:37 -0500 (CDT) + Message-Id: <199909091533.KAA01242@www.cvm.uiuc.edu> + Branch: cfgperl + ! pp_sys.c +____________________________________________________________________________ +[ 4113] By: jhi on 1999/09/09 10:17:45 + Log: From: paul.marquess@bt.com + To: gsar@ActiveState.com + Cc: perl5-porters@perl.org + Subject: [PATCH 5.005_61] DB_File 1.71 + Date: Thu, 9 Sep 1999 11:20:13 +0100 + Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB202D49BBE@mbtlipnt02.btlabs.bt.co.uk> + Branch: cfgperl + + ext/DB_File/version.c + ! MANIFEST ext/DB_File/Changes ext/DB_File/DB_File.pm + ! ext/DB_File/Makefile.PL ext/DB_File/dbinfo ext/DB_File/typemap + ! t/lib/db-btree.t +____________________________________________________________________________ +[ 4112] By: jhi on 1999/09/09 09:05:32 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_58] Fix interaction of (?p{}) and (?>) + Date: Thu, 9 Sep 1999 04:40:11 -0400 (EDT) + Message-Id: <199909090840.EAA26471@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regexec.c t/op/pat.t +____________________________________________________________________________ +[ 4111] By: jhi on 1999/09/09 07:50:07 + Log: %#b in particular and %B in general were kaputt. + Branch: cfgperl + ! sv.c t/op/sprintf.t +____________________________________________________________________________ +[ 4110] By: jhi on 1999/09/09 07:29:17 + Log: Tidy up 64-bit situation in perldelta. + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4109] By: jhi on 1999/09/09 07:26:53 + Log: Clear up PL_regcc issues. + + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_60] Another regexec.c unobfuscation + Date: Thu, 9 Sep 1999 02:49:49 -0400 (EDT) + Message-Id: <199909090649.CAA26119@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regexec.c +____________________________________________________________________________ +[ 4108] By: gsar on 1999/09/08 20:52:51 + Log: avoid ass_u_ming uppercase types are not user objects (spotted + by Kurt Starsinic) + Branch: perl + ! ext/Data/Dumper/Dumper.pm +____________________________________________________________________________ +[ 4107] By: gsar on 1999/09/08 20:35:18 + Log: From: akim@epita.fr (DEMAILLE Akim) + Date: Wed, 8 Sep 1999 18:18:44 +0200 (CEST) + Message-Id: <m11OkQm-003A4IC@beyrouth.lrde.epita.fr> + Subject: [ID 19990908.014] s2p does not quote @ + Branch: perl + ! x2p/s2p.PL +____________________________________________________________________________ +[ 4106] By: gsar on 1999/09/08 20:25:12 + Log: integrate cfgperl contents into mainline + Branch: perl + !> (integrate 30 files) +____________________________________________________________________________ +[ 4105] By: jhi on 1999/09/08 09:02:37 + Log: Minor touches at the [:class:] description. + Branch: cfgperl + ! pod/perlre.pod +____________________________________________________________________________ +[ 4104] By: jhi on 1999/09/08 08:57:58 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: Mailing list Perl5 <perl5-porters@perl.org> + Subject: [PATCH 5.005_58] Fix debugging output for REx + Date: Wed, 8 Sep 1999 05:02:02 -0400 + Message-ID: <19990908050201.A17682@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regcomp.c +____________________________________________________________________________ +[ 4103] By: gsar on 1999/09/08 00:53:50 + Log: fix memory leak in C<sub f { split ' ', "a b" } f() while 1> + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 4102] By: gsar on 1999/09/08 00:52:50 + Log: fix memory leak in C<sub f { @_ = 1 } f() while 1> + Branch: perl + ! cop.h pp_hot.c +____________________________________________________________________________ +[ 4101] By: gsar on 1999/09/07 17:25:07 + Log: various fixups for windows + Branch: perl + ! embed.h embed.pl objXSUB.h op.c perlapi.c proto.h + ! win32/Makefile win32/makefile.mk xsutils.c +____________________________________________________________________________ +[ 4100] By: jhi on 1999/09/07 12:49:15 + Log: Fix pointer casts. + + From: Robin Barker <rmb1@cise.npl.co.uk> + To: perl5-porters@perl.org + Subject: [ID 19990907.004] [PATCH perl5.005_61] compiler warnings with + -Duse64bits + Date: Tue, 7 Sep 1999 12:30:18 +0100 (BST) + Message-Id: <199909071130.MAA11435@tempest.npl.co.uk> + Branch: cfgperl + ! doio.c dump.c ext/B/B.xs ext/B/typemap + ! ext/ByteLoader/bytecode.h ext/Devel/DProf/DProf.xs + ! ext/DynaLoader/dl_dlopen.xs ext/ODBM_File/ODBM_File.xs + ! ext/POSIX/POSIX.xs lib/ExtUtils/typemap malloc.c perl.h pp.c + ! pp_ctl.c pp_hot.c pp_sys.c sv.c +____________________________________________________________________________ +[ 4099] By: jhi on 1999/09/07 10:29:04 + Log: Add sig/pid/uid size and sign probes. + Branch: metaconfig + + U/typedefs/gidsign.U U/typedefs/gidsize.U U/typedefs/pidsign.U + + U/typedefs/pidsize.U U/typedefs/uidsign.U U/typedefs/uidsize.U +____________________________________________________________________________ +[ 4098] By: jhi on 1999/09/07 10:27:06 + Log: Band-aid until we've got %{Uid_t} or something similar + for sv_catpvfn(). + Branch: cfgperl + ! taint.c +____________________________________________________________________________ +[ 4097] By: jhi on 1999/09/07 09:41:23 + Log: Fix a printf thinko: now quads must have the ll L q prefix. + (in other words, a bare %d is an int/unsigned) + Branch: cfgperl + ! pp_sys.c sv.c t/op/64bit.t +____________________________________________________________________________ +[ 4096] By: jhi on 1999/09/07 07:36:17 + Log: HP-UX 10.20 and gcc 2.8.1 break UINT32_MAX. + + From: "Daniel S. Lewart" <lewart@www.cvm.uiuc.edu> + To: perl5-porters@perl.org + Subject: [ID 19990906.007] Not OK: perl 5.00561 on PA-RISC1.1 10.20 + Date: Mon, 6 Sep 1999 21:18:12 -0500 (CDT) + Message-Id: <199909070218.VAA29232@www.cvm.uiuc.edu> + Branch: cfgperl + ! hints/hpux.sh perl.h +____________________________________________________________________________ +[ 4095] By: gsar on 1999/09/06 20:47:02 + Log: applied suggested patch with suitable test to detect MSVC + From: "Vishal Bhatia" <vishalb@my-deja.com> + Date: Wed, 11 Aug 1999 01:43:28 -0700 + Message-ID: <GFCJELIOGEENAAAA@my-deja.com> + Subject: compiler on win32 + Branch: perl + ! ext/B/B/C.pm +____________________________________________________________________________ +[ 4094] By: jhi on 1999/09/06 20:34:44 + Log: Integrate with Sarathy. + Branch: cfgperl + !> ext/B/B/Bytecode.pm lib/Test/Harness.pm t/TEST t/UTEST + !> t/harness t/pragma/sub_lval.t utils/Makefile utils/perlcc.PL +____________________________________________________________________________ +[ 4093] By: jhi on 1999/09/06 20:33:43 + Log: Fix UV_SIZEOF to UVSIZE; change the overflow tests + so that they overflow also on 64-bit platforms. + Branch: cfgperl + ! t/pragma/warn/toke t/pragma/warn/util toke.c util.c +____________________________________________________________________________ +[ 4092] By: gsar on 1999/09/06 20:16:58 + Log: support bytecode and C backends in perlcc (patch suggested + by Tom Hughes <tom@compton.au>); s/-opt/-noopt/ and make the + C backend the default; describe new switches in pod; introduce + PERLCC_OPTS and s/COMPILE_TIMEOUT/PERLCC_TIMEOUT/; + s/COMPILE_TEST/HARNESS_COMPILE_TEST/; document these %ENV + entries + Branch: perl + ! ext/B/B/Bytecode.pm lib/Test/Harness.pm t/TEST t/UTEST + ! t/harness utils/Makefile utils/perlcc.PL +____________________________________________________________________________ +[ 4091] By: jhi on 1999/09/06 19:10:41 + Log: Integrate with Sarathy. + Branch: cfgperl + +> t/pragma/sub_lval.t + !> (integrate 52 files) +____________________________________________________________________________ +[ 4090] By: gsar on 1999/09/06 19:09:06 + Log: propagate changed error text + Branch: perl + ! t/pragma/sub_lval.t +____________________________________________________________________________ +[ 4089] By: gsar on 1999/09/06 18:54:43 + Log: sprintf doc tweak (from Ian Phillipps <ian@dial.pipex.com>) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4088] By: gsar on 1999/09/06 18:52:10 + Log: From: paul.marquess@bt.com + Date: Sun, 5 Sep 1999 15:11:08 +0100 + Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB202D49BAB@mbtlipnt02.btlabs.bt.co.uk> + Subject: [PATCH 5.005_61] Another patch for Lexical Warnings + Branch: perl + ! pp_sys.c t/pragma/warn/doio t/pragma/warn/op + ! t/pragma/warn/pp_hot t/pragma/warn/pp_sys + ! t/pragma/warn/regcomp t/pragma/warn/sv t/pragma/warn/toke + ! t/pragma/warn/universal t/pragma/warn/utf8 t/pragma/warn/util + ! toke.c +____________________________________________________________________________ +[ 4087] By: gsar on 1999/09/06 18:06:06 + Log: change#3612 is buggy when quotemeta argument matches target + (hope this is the last of the optimized-OP_SASSIGN bugs) + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Date: Sun, 5 Sep 1999 06:07:42 -0400 (EDT) + Message-Id: <199909051007.GAA06423@monk.mps.ohio-state.edu> + Subject: Re: [BUG: quotemeta] + Branch: perl + ! Changes op.c t/op/lex_assign.t +____________________________________________________________________________ [ 4086] By: gsar on 1999/09/06 17:57:52 Log: misc tweaks Branch: perl @@ -992,6 +992,7 @@ pod/perlapio.pod IO API info pod/perlbook.pod Book info pod/perlbot.pod Object-oriented Bag o' Tricks pod/perlcall.pod Callback info +pod/perlcompile.pod Info on using the Compiler suite pod/perldata.pod Data structure info pod/perldbmfilter.pod Info about DBM Filters pod/perldebug.pod Debugger info @@ -1168,7 +1169,10 @@ t/lib/filepath.t See if File::Path works t/lib/filespec.t See if File::Spec works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works -t/lib/getopt.t See if Getopt::Std and Getopt::Long works +t/lib/getopt.t See if Getopt::Std and Getopt::Long work +t/lib/gol-basic.t See if Getopt::Long works +t/lib/gol-compat.t See if Getopt::Long works +t/lib/gol-linkage.t See if Getopt::Long works t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison t/lib/h2ph.t See if h2ph works like it should diff --git a/README.dos b/README.dos index 56d78df2a0..95ab911820 100644 --- a/README.dos +++ b/README.dos @@ -266,7 +266,7 @@ variable does NOT point to bash). =head1 AUTHOR -Laszlo Molnar, F<molnarl@cdata.tvnet.hu> +Laszlo Molnar, F<laszlo.molnar@eth.ericsson.se> =head1 SEE ALSO @@ -11,6 +11,9 @@ I32 ax = mark - PL_stack_base + 1; \ I32 items = sp - mark +#define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ + ? PAD_SV(PL_op->op_targ) : sv_newmortal()) + #define XSANY CvXSUBANY(cv) #define dXSI32 I32 ix = XSANY.any_i32 @@ -21,8 +21,28 @@ struct xpvav { U8 xav_flags; }; + +/* AVf_REAL is set for all AVs whose xav_array contents are refcounted. + * Some things like "@_" and the scratchpad list do not set this, to + * indicate that they are cheating (for efficiency) by not refcounting + * the AV's contents. + * + * AVf_REIFY is only meaningful on such "fake" AVs (i.e. where AVf_REAL + * is not set). It indicates that the fake AV is capable of becoming + * real if the array needs to be modified in some way. Functions that + * modify fake AVs check both flags to call av_reify() as appropriate. + * + * Note that the Perl stack has neither flag set. (Thus, items that go + * on the stack are never refcounted.) + * + * These internal details are subject to change any time. AV + * manipulations external to perl should not care about any of this. + * GSAR 1999-09-10 + */ #define AVf_REAL 1 /* free old entries */ #define AVf_REIFY 2 /* can become real */ + +/* XXX this is not used anywhere */ #define AVf_REUSED 4 /* got undeffed--don't turn old memory into SVs now */ #define Nullav Null(AV*) @@ -76,6 +76,7 @@ struct block_sub { /* destroy arg array */ \ av_clear(cxsub.argarray); \ AvREAL_off(cxsub.argarray); \ + AvREIFY_on(cxsub.argarray); \ } \ if (cxsub.cv) { \ if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \ diff --git a/djgpp/config.over b/djgpp/config.over index 4895cf1a43..c624386678 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -25,7 +25,10 @@ repair() -e 's/posix/POSIX/'\ -e 's/sdbm_fil/SDBM_File/'\ -e 's/socket/Socket/'\ - -e 's/thread/Thread/' + -e 's/thread/Thread/'\ + -e 's/byteload/ByteLoader/'\ + -e 's=devel/peek=Devel/Peek='\ + -e 's=devel/dprof=Devel/DProf=' } static_ext=$(repair "$static_ext") extensions=$(repair "$extensions") diff --git a/djgpp/configure.bat b/djgpp/configure.bat index e7d41d7130..6073f442e0 100644 --- a/djgpp/configure.bat +++ b/djgpp/configure.bat @@ -29,6 +29,7 @@ goto end sh -c 'if test ! -d /tmp; then mkdir /tmp; fi' cp djgpp.c config.over .. cd .. +mv ext/B/defsu* ext/B/defsubsh.PL echo Running sed... sh djgpp/djgppsed.sh diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 5c1d3c4de4..5a8fc5fa5c 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -123,7 +123,7 @@ convretcode (pTHX_ int rc,char *prog,int fl) Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s", fl ? "exec" : "spawn",prog,Strerror (errno)); if (rc > 0) - return rc <<= 8; + return rc << 8; if (rc < 0) return 255 << 8; return 0; @@ -252,6 +252,7 @@ struct globinfo int fd; char *matches; size_t size; + fpos_t pos; }; #define MAXOPENGLOBS 10 @@ -286,6 +287,7 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args) if ((gi=searchfd (-1)) == NULL) break; + gi->pos=0; pattern=alloca (strlen (name+=13)+1); strcpy (pattern,name); if (!_USE_LFN) @@ -332,11 +334,10 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args) if ((gi=searchfd (fd))==NULL) break; - ic=tell (fd); - if (siz+ic>=gi->size) - siz=gi->size-ic; - memcpy (buf,ic+gi->matches,siz); - lseek (fd,siz,1); + if (siz+gi->pos > gi->size) + siz = gi->size - gi->pos; + memcpy (buf,gi->pos+gi->matches,siz); + gi->pos += siz; *rv=siz; return 1; } diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh index 5276f4f67f..a25e894157 100644 --- a/djgpp/djgppsed.sh +++ b/djgpp/djgppsed.sh @@ -17,13 +17,15 @@ SCOR='s=c\\\.c|=c\_c|=g' SHSED='s=\.\(hsed\)=_\1=g' SDEPTMP='s=\.\(deptmp\)=_\1=g' SCPP='s=\.\(cpp\.\)=_\1=g' -SARGV='s=\.\(argv\.\)=_\1=g' +SARGV='s=\.\(argv\)\.=_\1_=g' SABC='s=\.\([abc][^a]\)=_\1=g' SDBMX='s=\.\(dbmx\)=_\1=g' SDBHASH='s=dbhash\.tmp=dbhash_tmp=g' SSTAT='s=\.\(stat\.\)=_\1=g' STMP2='s=tmp2=tm2=g' SPACKLIST='s=\.\(packlist\)=_\1=g' +SDEFSUB='s=defsubs\.h=defsubsh=g' +SPLPLI='s=PL/;=PL/i;=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 @@ -47,3 +49,6 @@ sed -e $SPACKLIST lib/ExtUtils/Installed.pm >s; mv -f s lib/ExtUtils/Installed.p sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm sed -e $SPACKLIST lib/ExtUtils/inst >s; mv -f s lib/ExtUtils/inst sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t +sed -e $SDEFSUB ext/B/Makefile.PL >s; mv -f s ext/B/Makefile.PL +sed -e $SDEFSUB ext/B/B.xs >s; mv -f s ext/B/B.xs +sed -e $SDEFSUB -e $SPLPLI ext/B/defsubsh.PL >s; mv -f s ext/B/defsubsh.PL @@ -8,6 +8,7 @@ # define BIT_BUCKET "nul" # define OP_BINARY O_BINARY # define PERL_SYS_INIT(c,v) Perl_DJGPP_init(c,v) +# define init_os_extras Perl_init_os_extras # include <signal.h> # define HAS_UTIME # define HAS_KILL @@ -1005,9 +1005,6 @@ #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) #define isa_lookup S_isa_lookup #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#define modify_SV_attributes S_modify_SV_attributes -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) #define mess_alloc S_mess_alloc # if defined(LEAKTEST) @@ -2333,9 +2330,6 @@ #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) #define isa_lookup(a,b,c,d) S_isa_lookup(aTHX_ a,b,c,d) #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#define modify_SV_attributes(a,b,c,d) S_modify_SV_attributes(aTHX_ a,b,c,d) -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) #define mess_alloc() S_mess_alloc(aTHX) # if defined(LEAKTEST) @@ -4549,10 +4543,6 @@ #define S_isa_lookup CPerlObj::S_isa_lookup #define isa_lookup S_isa_lookup #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#define S_modify_SV_attributes CPerlObj::S_modify_SV_attributes -#define modify_SV_attributes S_modify_SV_attributes -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) #define S_mess_alloc CPerlObj::S_mess_alloc #define mess_alloc S_mess_alloc @@ -2038,10 +2038,6 @@ s |I32 |win32_textfilter |int idx|SV *sv|int maxlen s |SV*|isa_lookup |HV *stash|const char *name|int len|int level #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -s |int|modify_SV_attributes|SV *sv|SV **retlist|SV **attrlist|int numattrs -#endif - #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) s |SV* |mess_alloc # if defined(LEAKTEST) diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index c7547ad691..3230ebdf10 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -56,6 +56,9 @@ use B::Asmdata qw(@specialsv_name); 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; @@ -162,7 +165,7 @@ sub B::OP::save { $init->add(sprintf("(void)find_threadsv(%s);", cstring($threadsv_names[$op->targ]))); } - $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x", + $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, $type, $op_seq, $op->flags, $op->private)); savesym($op, sprintf("&op_list[%d]", $opsect->index)); @@ -175,7 +178,7 @@ sub B::FAKEOP::new { sub B::FAKEOP::save { my ($op, $level) = @_; - $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x", + $opsect->add(sprintf("%s, %s, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x", $op->next, $op->sibling, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); return sprintf("&op_list[%d]", $opsect->index); @@ -193,7 +196,7 @@ sub B::UNOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first})); @@ -204,7 +207,7 @@ sub B::BINOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last})); @@ -215,7 +218,7 @@ sub B::LISTOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, @@ -227,7 +230,7 @@ sub B::LOGOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->other})); @@ -241,7 +244,7 @@ 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, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, @@ -254,7 +257,7 @@ sub B::PVOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, cstring($op->pv))); @@ -266,7 +269,7 @@ 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, %u, %u, %u, 0x%x, 0x%x, %s", + $svopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s", ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, $op->private, "(SV*)$svsym")); @@ -278,7 +281,7 @@ sub B::GVOP::save { my $sym = objsym($op); return $sym if defined $sym; my $gvsym = $op->gv->save; - $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv", + $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); @@ -294,7 +297,7 @@ sub B::COP::save { my $stashsym = $op->stash->save; warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV) if $debug_cops; - $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u", + $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, $op->targ, $op->type, $op_seq, $op->flags, $op->private, cstring($op->label), $op->cop_seq, @@ -330,7 +333,7 @@ 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, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x", + $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, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, $op->children, diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm index 4705669e6d..c37e6b54dd 100644 --- a/ext/Data/Dumper/Dumper.pm +++ b/ext/Data/Dumper/Dumper.pm @@ -13,7 +13,7 @@ $VERSION = $VERSION = '2.101'; #$| = 1; -require 5.004; +require 5.004_02; require Exporter; require DynaLoader; require overload; @@ -214,9 +214,8 @@ sub _dump { if ($type) { # prep it, if it looks like an object - if ($type =~ /[a-z_:]/) { - my $freezer = $s->{freezer}; - $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer); + if (my $freezer = $s->{freezer}) { + $val->$freezer() if UNIVERSAL::can($val, $freezer); } ($realpack, $realtype, $id) = diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 7c9657a127..0909cc15b5 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1391,9 +1391,9 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) $h{$name} = 1; } elsif ($name =~ /\.PL$/) { ($pl_files{$name} = $name) =~ s/\.PL$// ; - } elsif ($Is_VMS && $name =~ /[._]pl$/i) { + } elsif (($Is_VMS || $Is_Dos) && $name =~ /[._]pl$/i) { # case-insensitive filesystem, one dot per name, so foo.h.PL - # under Unix appears as foo.h_pl under VMS + # under Unix appears as foo.h_pl under VMS or fooh.pl on Dos local($/); open(PL,$name); my $txt = <PL>; close PL; if ($txt =~ /Extracting \S+ \(with variable substitutions/) { ($pl_files{$name} = $name) =~ s/[._]pl$//i ; diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index c125ccf443..479efcabe1 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -2,22 +2,23 @@ package Getopt::Long; -# RCS Status : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pl,v 2.21 1999-08-04 10:33:07+02 jv Exp $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Fri Jan 8 14:48:43 1999 -# Update Count : 707 +# Last Modified On: Wed Aug 4 10:08:50 1999 +# Update Count : 709 # Status : Released ################ Copyright ################ # This program is Copyright 1990,1999 by Johan Vromans. # This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# +# modify it under the terms of the Perl Artistic License or the +# GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any +# later version. +# # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the @@ -35,7 +36,7 @@ BEGIN { require 5.004; use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - $VERSION = "2.19"; + $VERSION = "2.20"; @ISA = qw(Exporter); @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); @@ -108,12 +109,12 @@ __END__ ################ AutoLoading subroutines ################ -# RCS Status : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $ +# RCS Status : $Id: GetoptLongAl.pl,v 2.22 1999-07-07 12:57:05+02 jv Exp $ # Author : Johan Vromans # Created On : Fri Mar 27 11:50:30 1998 # Last Modified By: Johan Vromans -# Last Modified On: Sun Jun 14 13:54:35 1998 -# Update Count : 24 +# Last Modified On: Wed Jul 7 12:47:57 1999 +# Update Count : 28 # Status : Released sub GetOptions { @@ -137,7 +138,7 @@ sub GetOptions { print STDERR ("GetOpt::Long $Getopt::Long::VERSION ", "called from package \"$pkg\".", "\n ", - 'GetOptionsAl $Revision: 2.20 $ ', + 'GetOptionsAl $Revision: 2.22 $ ', "\n ", "ARGV: (@ARGV)", "\n ", @@ -164,7 +165,11 @@ sub GetOptions { # See if the first element of the optionlist contains option # starter characters. - if ( $optionlist[0] =~ /^\W+$/ ) { + # Be careful not to interpret '<>' as option starters. + if ( $optionlist[0] =~ /^\W+$/ + && !($optionlist[0] eq '<>' + && @optionlist > 0 + && ref($optionlist[1])) ) { $genprefix = shift (@optionlist); # Turn into regexp. Needs to be parenthesized! $genprefix =~ s/(\W)/\\$1/g; @@ -1118,11 +1123,14 @@ CONFIGURATION OPTIONS), options that start with "+" or "-" may also include their arguments, e.g. "+foo=bar". This is for compatiblity with older implementations of the GNU "getopt" routine. -If the first argument to GetOptions is a string consisting of only -non-alphanumeric characters, it is taken to specify the option starter -characters. Everything starting with one of these characters from the -starter will be considered an option. B<Using a starter argument is -strongly deprecated.> +If the first argument to GetOptions (after the optional linkage +specification) is a string consisting of only non-alphanumeric +characters, it is taken to specify the option starter characters. +Everything starting with one of these characters from the starter will +be considered an option. GetOptions will not interpret a leading +"<>" as option starters if the next argument is a reference. To +force "<" and ">" as option starters, use "><". Confusing? Well, +B<using a starter argument is strongly deprecated.> For convenience, option specifiers may have a leading B<-> or B<-->, so it is possible to write: @@ -1366,9 +1374,10 @@ Johan Vromans E<lt>jvromans@squirrel.nlE<gt> This program is Copyright 1990,1999 by Johan Vromans. This program is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License -as published by the Free Software Foundation; either version 2 -of the License, or (at your option) any later version. +modify it under the terms of the Perl Artistic License or the +GNU General Public License as published by the Free Software +Foundation; either version 2 of the License, or (at your option) any +later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 5238a1a1a7..e9c640cf5d 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1506,7 +1506,8 @@ sub process_L { $link = "#" . htmlify(0,$section); $linktext = $section unless defined($linktext); } elsif ( $page =~ /::/ ) { - $linktext = ($section ? "$section" : "$page"); + $linktext = ($section ? "$section" : "$page") + unless defined($linktext); $page =~ s,::,/,g; # Search page cache for an entry keyed under the html page name, # then look to see what directory that page might be in. NOTE: @@ -3584,8 +3584,6 @@ #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) # if defined(LEAKTEST) # endif @@ -1267,19 +1267,19 @@ Perl_mod(pTHX_ OP *o, I32 type) if (kid->op_type == OP_METHOD_NAMED || kid->op_type == OP_METHOD) { - OP *new; + OP *newop; if (kid->op_sibling || kid->op_next != kid) { yyerror("panic: unexpected optree near method call"); break; } - NewOp(1101, new, 1, OP); - new->op_type = OP_RV2CV; - new->op_ppaddr = PL_ppaddr[OP_RV2CV]; - new->op_next = new; - kid->op_sibling = new; - new->op_private |= OPpLVAL_INTRO; + NewOp(1101, newop, 1, OP); + newop->op_type = OP_RV2CV; + newop->op_ppaddr = PL_ppaddr[OP_RV2CV]; + newop->op_next = newop; + kid->op_sibling = newop; + newop->op_private |= OPpLVAL_INTRO; break; } diff --git a/patchlevel.h b/patchlevel.h index 5b07ae698f..02a968910e 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -7,6 +7,9 @@ #define PERL_VERSION 5 /* epoch */ #define PERL_SUBVERSION 61 /* generation */ +#define __PATCHLEVEL_H_INCLUDED__ +#endif + /* local_patches -- list of locally applied less-than-subversion patches. If you're distributing such a patch, please give it a name and a @@ -42,6 +45,7 @@ This will prevent patch from choking if someone has previously applied different patches than you. */ +#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL ,NULL @@ -51,13 +55,8 @@ static char *local_patches[] = { # define LOCAL_PATCH_COUNT \ (sizeof(local_patches)/sizeof(local_patches[0])-2) -# define __PATCHLEVEL_H_INCLUDED__ -#endif - /* the old terms of reference, add them only when explicitly included */ -#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(PATCHLEVEL) #define PATCHLEVEL PERL_VERSION #undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */ #define SUBVERSION PERL_SUBVERSION #endif - @@ -14,6 +14,7 @@ #include "EXTERN.h" #define PERL_IN_PERL_C #include "perl.h" +#include "patchlevel.h" /* for local_patches */ /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD @@ -4869,8 +4869,6 @@ Perl_boot_core_xsutils(pTHXo) #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) # if defined(LEAKTEST) # endif diff --git a/pod/Makefile b/pod/Makefile index f28b9d43a1..8a96236acf 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -59,6 +59,7 @@ POD = \ perlxstut.pod \ perlguts.pod \ perlcall.pod \ + perlcompile.pod \ perltodo.pod \ perlhist.pod \ perlfaq.pod \ @@ -118,6 +119,7 @@ MAN = \ perlxstut.man \ perlguts.man \ perlcall.man \ + perlcompile.man \ perltodo.man \ perlhist.man \ perlfaq.man \ @@ -177,6 +179,7 @@ HTML = \ perlxstut.html \ perlguts.html \ perlcall.html \ + perlcompile.html \ perltodo.html \ perlhist.html \ perlfaq.html \ @@ -236,6 +239,7 @@ TEX = \ perlxstut.tex \ perlguts.tex \ perlcall.tex \ + perlcompile.tex \ perltodo.tex \ perlhist.tex \ perlfaq.tex \ diff --git a/pod/buildtoc b/pod/buildtoc index 2574b1096f..1a9a24bb2d 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -13,7 +13,7 @@ sub output ($); perllol perltoot perltootc perlobj perltie perlbot perlipc perldbmfilter perldebug perldiag perlsec perltrap perlport perlstyle perlpod perlbook - perlembed perlapio perlxs perlxstut perlguts perlcall + perlembed perlapio perlxs perlxstut perlguts perlcall perlcompile perlhist ); diff --git a/pod/perl.pod b/pod/perl.pod index 0275543c31..abf3a7bff3 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -50,6 +50,7 @@ sections: perlthrtut Perl threads tutorial perldbmfilter Perl DBM Filters + perlcompile Perl compiler suite intro perldebug Perl debugging perldiag Perl diagnostic messages perlsec Perl security diff --git a/pod/perlcompile.pod b/pod/perlcompile.pod new file mode 100644 index 0000000000..0ba94187db --- /dev/null +++ b/pod/perlcompile.pod @@ -0,0 +1,443 @@ +=head1 NAME + +perlcompile - Introduction to the Perl Compiler-Translator + +=head1 DESCRIPTION + +Perl has always had a compiler: your source is compiled into an +internal form (a parse tree) which is then optimized before being +run. Since version 5.005, Perl has shipped with a module +capable of inspecting the optimized parse tree (C<B>), and this has +been used to write many useful utilities, including a module that lets +you turn your Perl into C source code that can be compiled into an +native executable. + +The C<B> module provides access to the parse tree, and other modules +("back ends") do things with the tree. Some write it out as +bytecode, C source code, or a semi-human-readable text. Another +traverses the parse tree to build a cross-reference of which +subroutines, formats, and variables are used where. Another checks +your code for dubious constructs. Yet another back end dumps the +parse tree back out as Perl source, acting as a source code beautifier +or deobfuscator. + +Because its original purpose was to be a way to produce C code +corresponding to a Perl program, and in turn a native executable, the +C<B> module and its associated back ends are known as "the +compiler", even though they don't really compile anything. +Different parts of the compiler are more accurately a "translator", +or an "inspector", but people want Perl to have a "compiler +option" not an "inspector gadget". What can you do? + +This document covers the use of the Perl compiler: which modules +it comprises, how to use the most important of the back end modules, +what problems there are, and how to work around them. + +=head2 Layout + +The compiler back ends are in the C<B::> hierarchy, and the front-end +(the module that you, the user of the compiler, will sometimes +interact with) is the O module. Some back ends (e.g., C<B::C>) have +programs (e.g., I<perlcc>) to hide the modules' complexity. + +Here are the important back ends to know about, with their status +expressed as a number from 0 (outline for later implementation) to +10 (if there's a bug in it, we're very surprised): + +=over 4 + +=item B::Bytecode + +Stores the parse tree in a machine-independent format, suitable +for later reloading through the ByteLoader module. Status: 5 (some +things work, some things don't, some things are untested). + +=item B::C + +Creates a C source file containing code to rebuild the parse tree +and resume the interpreter. Status: 6 (many things work adequately, +including programs using Tk). + +=item B::CC + +Creates a C source file corresponding to the run time code path in +the parse tree. This is the closest to a Perl-to-C translator there +is, but the code it generates is almost incomprehensible because it +translates the parse tree into a giant switch structure that +manipulates Perl structures. Eventual goal is to reduce (given +sufficient type information in the Perl program) some of the +Perl data structure manipulations into manipulations of C-level +ints, floats, etc. Status: 5 (some things work, including +uncomplicated Tk examples). + +=item B::Lint + +Complains if it finds dubious constructs in your source code. Status: +6 (it works adequately, but only has a very limited number of areas +that it checks). + +=item B::Deparse + +Recreates the Perl source, making an attempt to format it coherently. +Status: 8 (it works nicely, but a few obscure things are missing). + +=item B::Xref + +Reports on the declaration and use of subroutines and variables. +Status: 8 (it works nicely, but still has a few lingering bugs). + +=back + +=head1 Using The Back Ends + +The following sections describe how to use the various compiler back +ends. They're presented roughly in order of maturity, so that the +most stable and proven back ends are described first, and the most +experimental and incomplete back ends are described last. + +The O module automatically enabled the B<-c> flag to Perl, which +prevents Perl from executing your code once it has been compiled. +This is why all the back ends print: + + myperlprogram syntax OK + +before producing any other output. + +=head2 The Cross Referencing Back End (B::Xref) + +The cross referencing back end produces a report on your program, +breaking down declarations and uses of subroutines and variables (and +formats) by file and subroutine. For instance, here's part of the +report from the I<pod2man> program that comes with Perl: + + Subroutine clear_noremap + Package (lexical) + $ready_to_print i1069, 1079 + Package main + $& 1086 + $. 1086 + $0 1086 + $1 1087 + $2 1085, 1085 + $3 1085, 1085 + $ARGV 1086 + %HTML_Escapes 1085, 1085 + +This shows the variables used in the subroutine C<clear_noremap>. The +variable C<$ready_to_print> is a my() (lexical) variable, +B<i>ntroduced (first declared with my()) on line 1069, and used on +line 1079. The variable C<$&> from the main package is used on 1086, +and so on. + +A line number may be prefixed by a single letter: + +=over 4 + +=item i + +Lexical variable introduced (declared with my()) for the first time. + +=item & + +Subroutine or method call. + +=item s + +Subroutine defined. + +=item r + +Format defined. + +=back + +The most useful option the cross referencer has is to save the report +to a separate file. For instance, to save the report on +I<myperlprogram> to the file I<report>: + + $ perl -MO=Xref,-oreport myperlprogram + +=head2 The Decompiling Back End + +The Deparse back end turns your Perl source back into Perl source. It +can reformat along the way, making it useful as a de-obfuscator. The +most basic way to use it is: + + $ perl -MO=Deparse myperlprogram + +You'll notice immediately that Perl has no idea of how to paragraph +your code. You'll have to separate chunks of code from each other +with newlines by hand. However, watch what it will do with +one-liners: + + $ perl -MO=Deparse -e '$op=shift||die "usage: $0 + code [...]";chomp(@ARGV=<>)unless@ARGV; for(@ARGV){$was=$_;eval$op; + die$@ if$@; rename$was,$_ unless$was eq $_}' + -e syntax OK + $op = shift @ARGV || die("usage: $0 code [...]"); + chomp(@ARGV = <ARGV>) unless @ARGV; + foreach $_ (@ARGV) { + $was = $_; + eval $op; + die $@ if $@; + rename $was, $_ unless $was eq $_; + } + +(this is the I<rename> program that comes in the I<eg/> directory +of the Perl source distribution). + +The decompiler has several options for the code it generates. For +instance, you can set the size of each indent from 4 (as above) to +2 with: + + $ perl -MO=Deparse,-si2 myperlprogram + +The B<-p> option adds parentheses where normally they are omitted: + + $ perl -MO=Deparse -e 'print "Hello, world\n"' + -e syntax OK + print "Hello, world\n"; + $ perl -MO=Deparse,-p -e 'print "Hello, world\n"' + -e syntax OK + print("Hello, world\n"); + +See L<B::Deparse> for more information on the formatting options. + +=head2 The Lint Back End (B::Lint) + +The lint back end inspects programs for poor style. One programmer's +bad style is another programmer's useful tool, so options let you +select what is complained about. + +To run the style checker across your source code: + + $ perl -MO=Lint myperlprogram + +To disable context checks and undefined subroutines: + + $ perl -MO=Lint,-context,-undefined-subs myperlprogram + +See L<B::Lint> for information on the options. + +=head2 The Simple C Back End + +This module saves the internal compiled state of your Perl program +to a C source file, which can be turned into a native executable +for that particular platform using a C compiler. The resulting +program links against the Perl interpreter library, so it +will not save you disk space (unless you build Perl with a shared +library) or program size. It may, however, save you startup time. + +The C<perlcc> tool generates such executables by default. + + perlcc myperlprogram.pl + +=head2 The Bytecode Back End + +This back end is only useful if you also have a way to load and +execute the bytecode that it produces. The ByteLoader module provides +this functionality. + +To turn a Perl program into executable byte code, you can use C<perlcc> +with the C<-b> switch: + + perlcc -b myperlprogram.pl + +The byte code is machine independent, so once you have a compiled +module or program, it is as portable as Perl source (assuming that +the user of the module or program has a modern-enough Perl interpreter +to decode the byte code). + +See B<B::Bytecode> for information on options to control the +optimization and nature of the code generated by the Bytecode module. + +=head2 The Optimized C Back End + +The optimized C back end will turn your Perl program's run time +code-path into an equivalent (but optimized) C program that manipulates +the Perl data structures directly. The program will still link against +the Perl interpreter library, to allow for eval(), C<s///e>, +C<require>, etc. + +The C<perlcc> tool generates such executables when using the -opt +switch. To compile a Perl program (ending in C<.pl> +or C<.p>): + + perlcc -opt myperlprogram.pl + +To produce a shared library from a Perl module (ending in C<.pm>): + + perlcc -opt Myperlmodule.pm + +For more information, see L<perlcc> and L<B::CC>. + +=over 4 + +=item B + +This module is the introspective ("reflective" in Java terms) +module, which allows a Perl program to inspect its innards. The +back end modules all use this module to gain access to the compiled +parse tree. You, the user of a back end module, will not need to +interact with B. + +=item O + +This module is the front-end to the compiler's back ends. Normally +called something like this: + + $ perl -MO=Deparse myperlprogram + +This is like saying C<use O 'Deparse'> in your Perl program. + +=item B::Asmdata + +This module is used by the B::Assembler module, which is in turn used +by the B::Bytecode module, which stores a parse-tree as +bytecode for later loading. It's not a back end itself, but rather a +component of a back end. + +=item B::Assembler + +This module turns a parse-tree into data suitable for storing +and later decoding back into a parse-tree. It's not a back end +itself, but rather a component of a back end. It's used by the +I<assemble> program that produces bytecode. + +=item B::Bblock + +This module is used by the B::CC back end. It walks "basic blocks", +whatever they may be. + +=item B::Bytecode + +This module is a back end that generates bytecode from a +program's parse tree. This bytecode is written to a file, from where +it can later be reconstructed back into a parse tree. The goal is to +do the expensive program compilation once, save the interpreter's +state into a file, and then restore the state from the file when the +program is to be executed. See L</"The Bytecode Back End"> +for details about usage. + +=item B::C + +This module writes out C code corresponding to the parse tree and +other interpreter internal structures. You compile the corresponding +C file, and get an executable file that will restore the internal +structures and the Perl interpreter will begin running the +program. See L</"The Simple C Back End"> for details about usage. + +=item B::CC + +This module writes out C code corresponding to your program's +operations. Unlike the B::C module, which merely stores the +interpreter and its state in a C program, the B::CC module makes a +C program that does not involve the interpreter. As a consequence, +programs translated into C by B::CC can execute faster than normal +interpreted programs. See L</"The Optimized C Back End"> for +details about usage. + +=item B::Debug + +This module dumps the Perl parse tree in verbose detail to STDOUT. +It's useful for people who are writing their own back end, or who +are learning about the Perl internals. It's not useful to the +average programmer. + +=item B::Deparse + +This module produces Perl source code from the compiled parse tree. +It is useful in debugging and deconstructing other people's code, +also as a pretty-printer for your own source. See +L</"The Decompiling Back End"> for details about usage. + +=item B::Disassembler + +This module turns bytecode back into a parse tree. It's not a back +end itself, but rather a component of a back end. It's used by the +I<disassemble> program that comes with the bytecode. + +=item B::Lint + +This module inspects the compiled form of your source code for things +which, while some people frown on them, aren't necessarily bad enough +to justify a warning. For instance, use of an array in scalar context +without explicitly saying C<scalar(@array)> is something that Lint +can identify. See L</"The Lint Back End"> for details about usage. + +=item B::Showlex + +This module prints out the my() variables used in a function or a +file. To gt a list of the my() variables used in the subroutine +mysub() defined in the file myperlprogram: + + $ perl -MO=Showlex,mysub myperlprogram + +To gt a list of the my() variables used in the file myperlprogram: + + $ perl -MO=Showlex myperlprogram + +[BROKEN] + +=item B::Stackobj + +This module is used by the B::CC module. It's not a back end itself, +but rather a component of a back end. + +=item B::Stash + +This module is used by the L<perlcc> program, which compiles a module +into an executable. B::Stash prints the symbol tables in use by a +program, and is used to prevent B::CC from producing C code for the +B::* and O modules. It's not a back end itself, but rather a +component of a back end. + +=item B::Terse + +This module prints the contents of the parse tree, but without as much +information as B::Debug. For comparison, C<print "Hello, world."> +produced 96 lines of output from B::Debug, but only 6 from B::Terse. + +This module is useful for people who are writing their own back end, +or who are learning about the Perl internals. It's not useful to the +average programmer. + +=item B::Xref + +This module prints a report on where the variables, subroutines, and +formats are defined and used within a program and the modules it +loads. See L</"The Cross Referencing Back End"> for details about +usage. + +=cut + +=head1 KNOWN PROBLEMS + +The simple C backend currently only saves typeglobs with alphanumeric +names. + +The optimized C backend outputs code for more modules than it should +(e.g., DirHandle). It also has little hope of properly handling +C<goto LABEL> outside the running subroutine (C<goto &sub> is ok). +C<goto LABEL> currently does not work at all in this backend. +It also creates a huge initialization function that gives +C compilers headaches. Splitting the initialization function gives +better results. Other problems include: unsigned math does not +work correctly; some opcodes are handled incorrectly by default +opcode handling mechanism. + +BEGIN{} blocks are executed while compiling your code. Any external +state that is initialized in BEGIN{}, such as opening files, initiating +database connections etc., do not behave properly. To work around +this, Perl has an INIT{} block that corresponds to code being executed +before your program begins running but after your program has finished +being compiled. Execution order: BEGIN{}, (possible save of state +through compiler back-end), INIT{}, program runs, END{}. + +=head1 AUTHOR + +This document was originally written by Nathan Torkington, and is now +maintained by the perl5-porters mailing list +I<perl5-porters@perl.org>. + +=cut diff --git a/pod/perlre.pod b/pod/perlre.pod index 468bf9f820..4bc042d9b3 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -293,7 +293,8 @@ Perl defines the following zero-width assertions: \A Match only at beginning of string \Z Match only at end of string, or before newline at the end \z Match only at end of string - \G Match only where previous m//g left off (works only with /g) + \G Match only at pos() (e.g. at the end-of-match position + of prior m//g) A word boundary (C<\b>) is a spot between two characters that has a C<\w> on one side of it and a C<\W> on the other side @@ -389,6 +390,12 @@ meanings like this: /$unquoted\Q$quoted\E$unquoted/ +Beware that if you put literal backslashes (those not inside +interpolated variables) between C<\Q> and C<\E>, double-quotish +backslash interpolation may lead to confusing results. If you +I<need> to use literal backslashes within C<\Q...\E>, +consult L<perlop/"Gory details of parsing quoted constructs">. + =head2 Extended Patterns Perl also defines a consistent extension syntax for features not @@ -570,6 +577,8 @@ module. See L<perlsec> for details about both these mechanisms. B<WARNING>: This extended regular expression feature is considered highly experimental, and may be changed or deleted without notice. +A simplified version of the syntax may be introduced for commonly +used idioms. This is a "postponed" regular subexpression. The C<code> is evaluated at run time, at the moment this subexpression may match. The result @@ -598,9 +607,11 @@ highly experimental, and may be changed or deleted without notice. An "independent" subexpression, one which matches the substring that a I<standalone> C<pattern> would match if anchored at the given -position--but it matches no more than this substring. This +position, and it matches I<nothing other than this substring>. This construct is useful for optimizations of what would otherwise be "eternal" matches, because it will not backtrack (see L<"Backtracking">). +It may also be useful in places where the "grab all you can, and do not +give anything back" semantic is desirable. For example: C<^(?E<gt>a*)ab> will never match, since C<(?E<gt>a*)> (anchored at the beginning of string, as above) will match I<all> @@ -623,7 +634,7 @@ Consider this pattern: m{ \( ( - [^()]+ + [^()]+ # x+ | \( [^()]* \) )+ @@ -643,7 +654,7 @@ hung. However, a tiny change to this pattern m{ \( ( - (?> [^()]+ ) + (?> [^()]+ ) # change x+ above to (?> x+ ) | \( [^()]* \) )+ @@ -660,6 +671,27 @@ On simple groups, such as the pattern C<(?E<gt> [^()]+ )>, a comparable effect may be achieved by negative look-ahead, as in C<[^()]+ (?! [^()] )>. This was only 4 times slower on a string with 1000000 C<a>s. +The "grab all you can, and do not give anything back" semantic is desirable +in many situations where on the first sight a simple C<()*> looks like +the correct solution. Suppose we parse text with comments being delimited +by C<#> followed by some optional (horizontal) whitespace. Contrary to +its appearence, C<#[ \t]*> I<is not> the correct subexpression to match +the comment delimiter, because it may "give up" some whitespace if +the remainder of the pattern can be made to match that way. The correct +answer is either one of these: + + (?>#[ \t]*) + #[ \t]*(?![ \t]) + +For example, to grab non-empty comments into $1, one should use either +one of these: + + / (?> \# [ \t]* ) ( .+ ) /x; + / \# [ \t]* ( [^ \t] .* ) /x; + +Which one you pick depends on which of these expressions better reflects +the above specification of comments. + =item C<(?(condition)yes-pattern|no-pattern)> =item C<(?(condition)yes-pattern)> @@ -688,7 +720,8 @@ themselves. A fundamental feature of regular expression matching involves the notion called I<backtracking>, which is currently used (when needed) by all regular expression quantifiers, namely C<*>, C<*?>, C<+>, -C<+?>, C<{n,m}>, and C<{n,m}?>. +C<+?>, C<{n,m}>, and C<{n,m}?>. Backtracking is often optimized +internally, but the general principle outlined here is valid. For a regular expression to match, the I<entire> regular expression must match, not just part of it. So if the beginning of a pattern containing a @@ -861,20 +894,22 @@ is not a zero-width assertion, but a one-width assertion. B<WARNING>: particularly complicated regular expressions can take exponential time to solve because of the immense number of possible -ways they can use backtracking to try match. For example, this will -take a painfully long time to run +ways they can use backtracking to try match. For example, without +internal optimizations done by the regular expression engine, this will +take a painfully long time to run: - /((a{0,5}){0,5}){0,5}/ + 'aaaaaaaaaaaa' =~ /((a{0,5}){0,5}){0,5}[c]/ And if you used C<*>'s instead of limiting it to 0 through 5 matches, then it would take forever--or until you ran out of stack space. -A powerful tool for optimizing such beasts is "independent" groups, -which do not backtrace (see L<C<(?E<gt>pattern)>>). Note also that -zero-length look-ahead/look-behind assertions will not backtrace to make +A powerful tool for optimizing such beasts is what is known as an +"independent group", +which does not backtrack (see L<C<(?E<gt>pattern)>>). Note also that +zero-length look-ahead/look-behind assertions will not backtrack to make the tail match, since they are in "logical" context: only whether they match is considered relevant. For an example -where side-effects of a look-ahead I<might> have influenced the +where side-effects of look-ahead I<might> have influenced the following match, see L<C<(?E<gt>pattern)>>. =head2 Version 8 Regular Expressions @@ -1007,7 +1042,7 @@ may match zero-length substrings. Here's a simple example being: @chars = split //, $string; # // is not magic in split ($whitewashed = $string) =~ s/()/ /g; # parens avoid magic s// / -Thus Perl allows the C</()/> construct, which I<forcefully breaks +Thus Perl allows such constructs, by I<forcefully breaking the infinite loop>. The rules for this are different for lower-level loops given by the greedy modifiers C<*+{}>, and for higher-level ones like the C</g> modifier or split() operator. @@ -1047,6 +1082,8 @@ position one notch further in the string. The additional state of being I<matched with zero-length> is associated with the matched string, and is reset by each assignment to pos(). +Zero-length matches at the end of the previous match are ignored +during C<split>. =head2 Creating custom RE engines @@ -1097,8 +1134,12 @@ part of this regular expression needs to be converted explicitly =head1 BUGS -This manpage is varies from difficult to understand to completely -and utterly opaque. +This document varies from difficult to understand to completely +and utterly opaque. The wandering prose riddled with jargon is +hard to fathom in several places. + +This document needs a rewrite that separates the tutorial content +from the reference content. =head1 SEE ALSO diff --git a/pod/pod2usage.PL b/pod/pod2usage.PL index fdaa955c69..adf49bd69d 100644 --- a/pod/pod2usage.PL +++ b/pod/pod2usage.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,10 +13,11 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; chdir(dirname($0)); ($file = basename($0)) =~ s/\.PL$//; $file =~ s/\.pl$// - if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving" + if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; @@ -177,3 +179,4 @@ pod2usage(\%usage); close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/pod/podchecker.PL b/pod/podchecker.PL index 1ca0d79eda..0d31763879 100644 --- a/pod/podchecker.PL +++ b/pod/podchecker.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,10 +13,11 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; chdir(dirname($0)); ($file = basename($0)) =~ s/\.PL$//; $file =~ s/\.pl$// - if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving" + if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; @@ -128,3 +130,4 @@ if(@ARGV) { close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/pod/podselect.PL b/pod/podselect.PL index 0df830406e..a76f6a045f 100644 --- a/pod/podselect.PL +++ b/pod/podselect.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,10 +13,11 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; chdir(dirname($0)); ($file = basename($0)) =~ s/\.PL$//; $file =~ s/\.pl$// - if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving" + if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; @@ -140,3 +142,4 @@ else { close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/pod/roffitall b/pod/roffitall index afb4432e2a..bcf58642b7 100644 --- a/pod/roffitall +++ b/pod/roffitall @@ -68,6 +68,7 @@ toroff=` $mandir/perlxstut.1 \ $mandir/perlguts.1 \ $mandir/perlcall.1 \ + $mandir/perlcompile.1 \ $mandir/perltodo.1 \ $mandir/perlhist.1 \ $mandir/perldelta.1 \ @@ -4929,6 +4929,7 @@ PP(pp_split) else { if (!AvREAL(ary)) { AvREAL_on(ary); + AvREIFY_off(ary); for (i = AvFILLp(ary); i >= 0; i--) AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ } @@ -49,8 +49,6 @@ #define dTARG SV *targ -#define dXS_TARGET SV * targ = (PL_op->op_private & OPpENTERSUB_HASTARG ? PAD_SV(PL_op->op_targ) : sv_newmortal()) - #define NORMAL PL_op->op_next #define DIE return Perl_die @@ -2512,6 +2512,7 @@ try_autoload: if (AvREAL(av)) { av_clear(av); AvREAL_off(av); + AvREIFY_on(av); } #ifndef USE_THREADS cx->blk_sub.savearray = GvAV(PL_defgv); @@ -980,9 +980,6 @@ STATIC I32 S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen); #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level); #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -STATIC int S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs); -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) STATIC SV* S_mess_alloc(pTHX); # if defined(LEAKTEST) @@ -692,12 +692,5 @@ struct xpvio { #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) -#if !defined(DOSISH) || defined(WIN32) || defined(OS2) -# define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) -# define Sv_Grow sv_grow -#else - /* extra parentheses intentionally NOT placed around "len"! */ -# define SvGROW(sv,len) ((SvLEN(sv) < (unsigned long)len) \ - ? sv_grow(sv,(unsigned long)len) : SvPVX(sv)) -# define Sv_Grow(sv,len) sv_grow(sv,(unsigned long)(len)) -#endif /* DOSISH */ +#define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) +#define Sv_Grow sv_grow diff --git a/t/io/openpid.t b/t/io/openpid.t index 21ec0830d4..0e8b934e51 100755 --- a/t/io/openpid.t +++ b/t/io/openpid.t @@ -10,6 +10,10 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + if ($^O eq 'dos') { + print "1..0 # Skip: no multitasking\n"; + exit 0; + } } diff --git a/t/lib/gol-basic.t b/t/lib/gol-basic.t new file mode 100755 index 0000000000..4b25322336 --- /dev/null +++ b/t/lib/gol-basic.t @@ -0,0 +1,24 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} + +use Getopt::Long 2.17; + +print "1..9\n"; + +@ARGV = qw(-Foo -baR --foo bar); +Getopt::Long::Configure ("no_ignore_case"); +undef $opt_baR; +undef $opt_bar; +print "ok 1\n" if GetOptions ("foo", "Foo=s"); +print ((defined $opt_foo) ? "" : "not ", "ok 2\n"); +print (($opt_foo == 1) ? "" : "not ", "ok 3\n"); +print ((defined $opt_Foo) ? "" : "not ", "ok 4\n"); +print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n"); +print ((@ARGV == 1) ? "" : "not ", "ok 6\n"); +print (($ARGV[0] eq "bar") ? "" : "not ", "ok 7\n"); +print (!(defined $opt_baR) ? "" : "not ", "ok 8\n"); +print (!(defined $opt_bar) ? "" : "not ", "ok 9\n"); diff --git a/t/lib/gol-compat.t b/t/lib/gol-compat.t new file mode 100755 index 0000000000..a4f807c7dd --- /dev/null +++ b/t/lib/gol-compat.t @@ -0,0 +1,25 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} + +require "newgetopt.pl"; + +print "1..9\n"; + +@ARGV = qw(-Foo -baR --foo bar); +$newgetopt::ignorecase = 0; +$newgetopt::ignorecase = 0; +undef $opt_baR; +undef $opt_bar; +print "ok 1\n" if NGetOpt ("foo", "Foo=s"); +print ((defined $opt_foo) ? "" : "not ", "ok 2\n"); +print (($opt_foo == 1) ? "" : "not ", "ok 3\n"); +print ((defined $opt_Foo) ? "" : "not ", "ok 4\n"); +print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n"); +print ((@ARGV == 1) ? "" : "not ", "ok 6\n"); +print (($ARGV[0] eq "bar") ? "" : "not ", "ok 7\n"); +print (!(defined $opt_baR) ? "" : "not ", "ok 8\n"); +print (!(defined $opt_bar) ? "" : "not ", "ok 9\n"); diff --git a/t/lib/gol-linkage.t b/t/lib/gol-linkage.t new file mode 100755 index 0000000000..a1b2c05be3 --- /dev/null +++ b/t/lib/gol-linkage.t @@ -0,0 +1,37 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} + +use Getopt::Long; + +print "1..18\n"; + +@ARGV = qw(-Foo -baR --foo bar); +Getopt::Long::Configure ("no_ignore_case"); +%lnk = (); +print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s"); +print ((defined $lnk{foo}) ? "" : "not ", "ok 2\n"); +print (($lnk{foo} == 1) ? "" : "not ", "ok 3\n"); +print ((defined $lnk{Foo}) ? "" : "not ", "ok 4\n"); +print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n"); +print ((@ARGV == 1) ? "" : "not ", "ok 6\n"); +print (($ARGV[0] eq "bar") ? "" : "not ", "ok 7\n"); +print (!(exists $lnk{baR}) ? "" : "not ", "ok 8\n"); + +@ARGV = qw(-Foo -baR --foo bar); +Getopt::Long::Configure ("default","no_ignore_case"); +%lnk = (); +my $foo; +print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s"); +print ((defined $foo) ? "" : "not ", "ok 10\n"); +print (($foo == 1) ? "" : "not ", "ok 11\n"); +print ((defined $lnk{Foo}) ? "" : "not ", "ok 12\n"); +print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n"); +print ((@ARGV == 1) ? "" : "not ", "ok 14\n"); +print (($ARGV[0] eq "bar") ? "" : "not ", "ok 15\n"); +print (!(exists $lnk{foo}) ? "" : "not ", "ok 16\n"); +print (!(exists $lnk{baR}) ? "" : "not ", "ok 17\n"); +print (!(exists $lnk{bar}) ? "" : "not ", "ok 18\n"); @@ -1822,28 +1822,13 @@ Perl_my_setenv(pTHX_ char *nam, char *val) safesysfree(environ[i]); environ[i] = (char*)safesysmalloc((strlen(nam)+strlen(val)+2) * sizeof(char)); -#ifndef MSDOS (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */ -#else - /* MS-DOS requires environment variable names to be in uppercase */ - /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but - * some utilities and applications may break because they only look - * for upper case strings. (Fixed strupr() bug here.)] - */ - strcpy(environ[i],nam); strupr(environ[i]); - (void)sprintf(environ[i] + strlen(nam),"=%s",val); -#endif /* MSDOS */ #else /* PERL_USE_SAFE_PUTENV */ char *new_env; new_env = (char*)safesysmalloc((strlen(nam) + strlen(val) + 2) * sizeof(char)); -#ifndef MSDOS (void)sprintf(new_env,"%s=%s",nam,val);/* all that work just for this */ -#else - strcpy(new_env,nam); strupr(new_env); - (void)sprintf(new_env + strlen(nam),"=%s",val); -#endif (void)putenv(new_env); #endif /* PERL_USE_SAFE_PUTENV */ } @@ -2635,6 +2620,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) /* Needs work for PerlIO ! */ FILE *f = PerlIO_findFILE(ptr); I32 result = pclose(f); +#if defined(DJGPP) + result = (result << 8) & 0xff00; +#endif PerlIO_releaseFILE(ptr,f); return result; } diff --git a/win32/Makefile b/win32/Makefile index 01159c7620..f700ada1b9 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -432,7 +432,8 @@ MICROCORE_SRC = \ ..\toke.c \ ..\universal.c \ ..\utf8.c \ - ..\util.c + ..\util.c \ + ..\xsutils.c EXTRACORE_SRC = $(EXTRACORE_SRC) perllib.c diff --git a/win32/makefile.mk b/win32/makefile.mk index 01f0d7d615..23dde72392 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -546,7 +546,8 @@ MICROCORE_SRC = \ ..\toke.c \ ..\universal.c \ ..\utf8.c \ - ..\util.c + ..\util.c \ + ..\xsutils.c EXTRACORE_SRC += perllib.c diff --git a/x2p/s2p.PL b/x2p/s2p.PL index 2f617e7381..be092c2aca 100644 --- a/x2p/s2p.PL +++ b/x2p/s2p.PL @@ -552,6 +552,11 @@ EOT substr($_,$i-1,1) = '$'; } } + elsif ($c eq '@') { + substr($_, $i, 0) = '\\'; + $i++; + $len++; + } elsif ($c eq '&' && $repl) { substr($_, $i, 0) = '$'; $i++; @@ -797,6 +802,7 @@ sub fetchpat { } } $addr =~ s/\t/\\t/g; + $addr =~ s/\@/\\@/g; &simplify($addr); $addr; } @@ -6,8 +6,43 @@ * Contributed by Spider Boardman (spider.boardman@orb.nashua.nh.us). */ -STATIC int -S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) +/* package attributes; */ +void XS_attributes__warn_reserved(pTHXo_ CV *cv); +void XS_attributes_reftype(pTHXo_ CV *cv); +void XS_attributes__modify_attrs(pTHXo_ CV *cv); +void XS_attributes__guess_stash(pTHXo_ CV *cv); +void XS_attributes__fetch_attrs(pTHXo_ CV *cv); +void XS_attributes_bootstrap(pTHXo_ CV *cv); + + +/* + * Note that only ${pkg}::bootstrap definitions should go here. + * This helps keep down the start-up time, which is especially + * relevant for users who don't invoke any features which are + * (partially) implemented here. + * + * The various bootstrap definitions can take care of doing + * package-specific newXS() calls. Since the layout of the + * bundled lib/*.pm files is in a version-specific directory, + * version checks in these bootstrap calls are optional. + */ + +void +Perl_boot_core_xsutils(pTHX) +{ + char *file = __FILE__; + + newXS("attributes::bootstrap", XS_attributes_bootstrap, file); +} + +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif /* PERL_OBJECT */ + +#include "XSUB.h" + +static int +modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs) { SV *attr; char *name; @@ -70,40 +105,6 @@ S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) } -/* package attributes; */ -void XS_attributes__warn_reserved(pTHXo_ CV *cv); -void XS_attributes_reftype(pTHXo_ CV *cv); -void XS_attributes__modify_attrs(pTHXo_ CV *cv); -void XS_attributes__guess_stash(pTHXo_ CV *cv); -void XS_attributes__fetch_attrs(pTHXo_ CV *cv); -void XS_attributes_bootstrap(pTHXo_ CV *cv); - - -/* - * Note that only ${pkg}::bootstrap definitions should go here. - * This helps keep down the start-up time, which is especially - * relevant for users who don't invoke any features which are - * (partially) implemented here. - * - * The various bootstrap definitions can take care of doing - * package-specific newXS() calls. Since the layout of the - * bundled lib/*.pm files is in a version-specific directory, - * version checks in these bootstrap calls are optional. - */ - -void -Perl_boot_core_xsutils(pTHX) -{ - char *file = __FILE__; - - newXS("attributes::bootstrap", XS_attributes_bootstrap, file); -} - -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#endif /* PERL_OBJECT */ - -#include "XSUB.h" /* package attributes; */ @@ -137,7 +138,7 @@ usage: goto usage; sv = SvRV(rv); if (items > 1) - XSRETURN(modify_SV_attributes(sv, &ST(0), &ST(1), items-1)); + XSRETURN(modify_SV_attributes(aTHXo_ sv, &ST(0), &ST(1), items-1)); XSRETURN(0); } |