This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate with Sarathy.
authorJarkko Hietaniemi <jhi@iki.fi>
Sat, 11 Sep 1999 20:50:37 +0000 (20:50 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 11 Sep 1999 20:50:37 +0000 (20:50 +0000)
p4raw-id: //depot/cfgperl@4127

47 files changed:
AUTHORS
Changes
MANIFEST
README.dos
XSUB.h
av.h
cop.h
djgpp/config.over
djgpp/configure.bat
djgpp/djgpp.c
djgpp/djgppsed.sh
dosish.h
embed.h
embed.pl
ext/B/B/C.pm
ext/Data/Dumper/Dumper.pm
lib/ExtUtils/MM_Unix.pm
lib/Getopt/Long.pm
lib/Pod/Html.pm
objXSUB.h
op.c
patchlevel.h
perl.c
perlapi.c
pod/Makefile
pod/buildtoc
pod/perl.pod
pod/perlcompile.pod [new file with mode: 0644]
pod/perlre.pod
pod/pod2usage.PL
pod/podchecker.PL
pod/podselect.PL
pod/roffitall
pp.c
pp.h
pp_hot.c
proto.h
sv.h
t/io/openpid.t
t/lib/gol-basic.t [new file with mode: 0755]
t/lib/gol-compat.t [new file with mode: 0755]
t/lib/gol-linkage.t [new file with mode: 0755]
util.c
win32/Makefile
win32/makefile.mk
x2p/s2p.PL
xsutils.c

diff --git a/AUTHORS b/AUTHORS
index ed52400..3ed8133 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -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
diff --git a/Changes b/Changes
index 2b3fc57..6fd3e3c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -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
index c007d65..3b0f7ae 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 56d78df..95ab911 100644 (file)
@@ -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
 
diff --git a/XSUB.h b/XSUB.h
index 241ac40..509a1d6 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -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
diff --git a/av.h b/av.h
index bacf614..f537d9e 100644 (file)
--- a/av.h
+++ b/av.h
@@ -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*)
diff --git a/cop.h b/cop.h
index d0a59a0..6ea045a 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -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))                  \
index 4895cf1..c624386 100644 (file)
@@ -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")
index e7d41d7..6073f44 100644 (file)
@@ -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
 
index 5c1d3c4..5a8fc5f 100644 (file)
@@ -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;
         }
index 5276f4f..a25e894 100644 (file)
@@ -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
index 822182d..7e72d67 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -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
diff --git a/embed.h b/embed.h
index 266a691..ab68e0e 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
 #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)
 #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
index 63d5fdd..5f0711f 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -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)
index c7547ad..3230ebd 100644 (file)
@@ -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,
index 4705669..c37e6b5 100644 (file)
@@ -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) =
index 7c9657a..0909cc1 100644 (file)
@@ -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 ;
index c125ccf..479efca 100644 (file)
@@ -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
index 5238a1a..e9c640c 100644 (file)
@@ -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:
index 02ad66e..437a219 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #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/op.c b/op.c
index babe0d7..0053bdd 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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;
                    }
                    
index 5b07ae6..02a9689 100644 (file)
@@ -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
-
diff --git a/perl.c b/perl.c
index 3c3a629..ed88bc3 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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
index 0e54575..f04706c 100755 (executable)
--- a/perlapi.c
+++ b/perlapi.c
@@ -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
index f28b9d4..8a96236 100644 (file)
@@ -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     \
index 2574b10..1a9a24b 100644 (file)
@@ -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
          );
 
index 0275543..abf3a7b 100644 (file)
@@ -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 (file)
index 0000000..0ba9418
--- /dev/null
@@ -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
index 468bf9f..4bc042d 100644 (file)
@@ -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 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
 
index fdaa955..adf49bd 100644 (file)
@@ -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;
index 1ca0d79..0d31763 100644 (file)
@@ -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;
index 0df8304..a76f6a0 100644 (file)
@@ -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;
index afb4432..bcf5864 100644 (file)
@@ -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        \
diff --git a/pp.c b/pp.c
index c98206a..6b71e8c 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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 */
            }
diff --git a/pp.h b/pp.h
index 11dd9d0..ec701f3 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -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
 
index 7be8607..de0434e 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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);
diff --git a/proto.h b/proto.h
index 5ae0636..ddb3142 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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)
diff --git a/sv.h b/sv.h
index 476c941..1aab997 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -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
index 21ec083..0e8b934 100755 (executable)
 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 (executable)
index 0000000..4b25322
--- /dev/null
@@ -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 (executable)
index 0000000..a4f807c
--- /dev/null
@@ -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 (executable)
index 0000000..a1b2c05
--- /dev/null
@@ -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");
diff --git a/util.c b/util.c
index 628b956..552c092 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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;
 }
index 01159c7..f700ada 100644 (file)
@@ -432,7 +432,8 @@ MICROCORE_SRC       =               \
                ..\toke.c       \
                ..\universal.c  \
                ..\utf8.c       \
-               ..\util.c
+               ..\util.c       \
+               ..\xsutils.c
 
 EXTRACORE_SRC  = $(EXTRACORE_SRC) perllib.c
 
index 01f0d7d..23dde72 100644 (file)
@@ -546,7 +546,8 @@ MICROCORE_SRC       =               \
                ..\toke.c       \
                ..\universal.c  \
                ..\utf8.c       \
-               ..\util.c
+               ..\util.c       \
+               ..\xsutils.c
 
 EXTRACORE_SRC  += perllib.c
 
index 2f617e7..be092c2 100644 (file)
@@ -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;
 }
index 14f9d0f..ea717d9 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -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);
 }