This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1m for perl5.001.
authorAndy Dougherty <doughera@lafcol.lafayette.edu>
Thu, 22 Jun 1995 00:43:21 +0000 (00:43 +0000)
committerAndy Dougherty <doughera@lafcol.lafayette.edu>
Thu, 22 Jun 1995 00:43:21 +0000 (00:43 +0000)
To apply, change to your perl directory, run the command above, then
apply with
    patch -p1 -N  < thispatch.

Highlights of this patch include:

1.  Fixes for $sitelib, $d_stdio_ptr_lval, and $d_stdio_cnt_lval
    when config.sh is re-used.

2.  Move embed.h, keywords.h, and opcode.h dependencies to
    a special  regen_headers target that is ordinarily not used.
    This is now analogous to the run_byacc target.  As a cosmetic
    side-effect, I transliterated embed_h.sh into embed.pl so that
    it can run on non-unix systems as well.

3.  Tests for gdbm_{sync,exists,setopt} in GDBM_File (needed for
    Slackware 2.1).

For good measure, I've also thrown in the following patches I pulled
off the list, mostly unmodified from the originals.

1.  Larry's "unofficial official" fix for the subroutine array context
    problem.

2.  Tim's __DATA__ patch.  (I kept forgetting about this one.)

3.  Malcom's  USE_OP_MASK patch to pave the way for his Safe extension.

4.  Spider's suggested renaming of regexec to pregexec and regcomp to
    pregcomp to avoid conflicts with POSIX symbols on Digital Unix.
    (I only added a brief explanatory comment to the relevant .c
    files.)

5.  Spider's installperl patch to avoid installing *.orig and and the
    .exists files.  (I changed this a little to include patch's ~
    suffix, which is used on systems with short file names (in some
    versions of patch)).

6.  Raphael's "safe_unlink" patch to installperl, in case a copy
    of perl is currently runniung.

7.  xsubpp 1.9.

8.  Tim's  lib.pm module (with patched corrected spelling of 2nd :-).

9.  Tim's Exporter module version patches.

10.  Tim's MakeMaker patches for make test when LINKTYPE=static.

11.  Randal's pod2html patches.

12.  Spider's "picky compiler" patches for x2p/util.[ch]

13.  Paul's updated source filtering patches.

Patch and enjoy.  I hope nothing breaks :-).

    Andy Dougherty doughera@lafcol.lafayette.edu
    Dept. of Physics
    Lafayette College, Easton PA 18042

35 files changed:
Configure
MANIFEST
Makefile.SH
embed.h
embed.pl [new file with mode: 0644]
embed_h.sh [deleted file]
ext/GDBM_File/GDBM_File.xs
global.sym
hints/freebsd.sh
installman
installperl
interp.sym
keywords.h
keywords.pl
lib/Exporter.pm
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/xsubpp
lib/lib.pm [new file with mode: 0644]
op.c
op.h
perl.c
perl.h
perldoc.SH
pod/perl.pod
pod/pod2html.SH
pp.c
pp_ctl.c
pp_hot.c
proto.h
regcomp.c
regcomp.h
regexec.c
toke.c
x2p/util.c
x2p/util.h

index 6148149..53649d5 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
 #
-# Generated on Tue Jun  6 12:25:20 EDT 1995 [metaconfig 3.0 PL55]
+# Generated on Thu Jun 22 10:38:35 EDT 1995 [metaconfig 3.0 PL55]
 
 cat >/tmp/c1$$ <<EOF
 ARGGGHHHH!!!!!
@@ -5478,7 +5478,8 @@ END
        fi
        echo "and it returns ($shmattype)." >&4
        : see if a prototype for shmat is available
-       $cppstdin $cppflags $cppminus < $usrinc/sys/shm.h > shmat.c 2>/dev/null
+       xxx=`./findhdr sys/shm.h`
+       $cppstdin $cppflags $cppminus < $xxx > shmat.c 2>/dev/null
        if $contains 'shmat.*(' shmat.c >/dev/null 2>&1; then
                val="$define"
        else
@@ -5523,7 +5524,10 @@ to search by default in addition to $privlib.
 If you don't want to use such an additional directory, answer 'none'.
 
 EOM
-dflt=none
+case "$sitelib" in
+'') dflt=none ;;
+*) dflt="$sitelib" ;;
+esac
 fn=d~+n
 rp='Local directory for additional library files?'
 . ./getfile
@@ -5533,27 +5537,32 @@ fi
 sitelib="$ans"
 sitelibexp="$ansexp"
 if $afs; then
-       $cat <<EOM
+    case "$sitelib" in
+       '') installsitelib="$sitelibexp"
+               ;;
+       *)      $cat <<EOM
 
 Since you are running AFS, I need to distinguish the directory in which
 private files reside from the directory in which they are installed (and from
 which they are presumably copied to the former directory by occult means).
 
 EOM
-       case "$installsitelib" in
-       '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
-       *) dflt="$installsitelib";;
+               case "$installsitelib" in
+               '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
+               *) dflt="$installsitelib";;
+               esac
+               fn=de~
+               rp='Where will additional local files be installed?'
+               . ./getfile
+               installsitelib="$ans"
+               ;;
        esac
-       fn=de~
-       rp='Where will additional local files be installed?'
-       . ./getfile
-       installsitelib="$ans"
 else
        installsitelib="$sitelibexp"
 fi
 
 case "$sitelibexp" in
-''|' ') d_sitelib=undef ;;
+'') d_sitelib=undef ;;
 *) d_sitelib=define ;;
 esac
 
@@ -5708,8 +5717,8 @@ eval $setvar
 
 : Can _ptr be used as an lvalue.  Only makes sense if we
 : have a known stdio implementation.
-case "$d_stdstdio" in
-$define) val=$ptr_lval ;;
+case "$d_stdstdio$ptr_lval" in
+$define$define) val=$define ;;
 *) val=$undef ;;
 esac
 set d_stdio_ptr_lval
@@ -5718,8 +5727,8 @@ eval $setvar
 
 : Can _cnt be used as an lvalue.  Only makes sense if we
 : have a known stdio implementation.
-case "$d_stdstdio" in
-$define) val=$cnt_lval ;;
+case "$d_stdstdio$cnt_lval" in
+$define$define) val=$define ;;
 *) val=$undef ;;
 esac
 set d_stdio_cnt_lval
index 3085736..c259e82 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -79,7 +79,7 @@ emacs/perldb.el               Emacs debugging
 emacs/perldb.pl                Emacs debugging
 emacs/tedstuff         Some optional patches
 embed.h                        Maps symbols to safer names
-embed_h.sh             Produces embed.h
+embed.pl               Produces embed.h
 ext/DB_File/DB_File.pm         Berkeley DB extension Perl module
 ext/DB_File/DB_File.xs         Berkeley DB extension external subroutines
 ext/DB_File/DB_File_BS         Berkeley DB extension mkbootstrap fodder
@@ -307,6 +307,7 @@ lib/hostname.pl             Old hostname code
 lib/importenv.pl       Perl routine to get environment into variables
 lib/integer.pm         For "use integer"
 lib/less.pm            For "use less"
+lib/lib.pm             For "use lib"
 lib/look.pl            A "look" equivalent
 lib/newgetopt.pl       A perl library supporting long option parsing
 lib/open2.pl           Open a two-ended pipe
index cdd6333..1dabfde 100644 (file)
@@ -185,7 +185,9 @@ all: makefile miniperl $(private) $(public) $(dynamic_ext)
 #      @echo " "; echo "       Making docs"; cd pod; $(MAKE) all;
 
 # Phony target to force checking subdirectories.
+# Apparently some makes require an action for the FORCE target.
 FORCE:
+       @true
 
 # The $& notation tells Sequent machines that it can do a parallel make,
 # and is harmless otherwise.
@@ -252,23 +254,6 @@ sperl.o: perl.c perly.h patchlevel.h $(h)
        $(CCCMD) -DIAMSUID sperl.c
        $(RMS) sperl.c
 
-# The following three header files are generated automatically
-# The correct versions should be already supplied with the perl kit,
-# in case you don't have perl or 'sh' available.
-# The - is to ignore error return codes in case you have the source
-# installed read-only or you don't have perl yet.
-keywords.h: keywords.pl
-       @echo "Don't worry if this fails."
-       - perl keywords.pl
-
-opcode.h: opcode.pl
-       @echo "Don't worry if this fails."
-       - perl opcode.pl
-
-embed.h: embed_h.sh global.sym interp.sym
-       @echo "Don't worry if this fails."
-       - sh embed_h.sh
-
 # We have to call our ./makedir because Ultrix 4.3 make can't handle the line
 #      test -d lib/auto || mkdir lib/auto
 #
@@ -321,6 +306,19 @@ perly.c: perly.y
 perly.h: perly.y
        -@touch perly.h
 
+# The following three header files are generated automatically
+#      keywords.h:     keywords.pl
+#      opcode.h:       opcode.pl
+#      embed.h:        embed.pl global.sym interp.sym
+# The correct versions should be already supplied with the perl kit,
+# in case you don't have perl available.
+# To force them to run, type
+#      make regen_headers
+regen_headers: FORCE
+       perl keywords.pl
+       perl opcode.pl
+       perl embed.pl
 # Extensions:
 # Names added to $(dynamic_ext) or $(static_ext) will automatically
 # get built.  There should ordinarily be no need to change any of
diff --git a/embed.h b/embed.h
index 4c5683a..5422d0a 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define doeval         Perl_doeval
 #define dofindlabel    Perl_dofindlabel
 #define dopoptoeval    Perl_dopoptoeval
+#define dowantarray    Perl_dowantarray
 #define dump_all       Perl_dump_all
 #define dump_eval      Perl_dump_eval
 #define dump_gv                Perl_dump_gv
 #define q              Perl_q
 #define ref            Perl_ref
 #define refkids                Perl_refkids
-#define regcomp                Perl_regcomp
+#define pregcomp       Perl_pregcomp
 #define regdump                Perl_regdump
-#define regexec                Perl_regexec
-#define regfree                Perl_regfree
+#define pregexec       Perl_pregexec
+#define pregfree       Perl_pregfree
 #define regnext                Perl_regnext
 #define regprop                Perl_regprop
 #define repeatcpy      Perl_repeatcpy
 #define ofslen         (curinterp->Iofslen)
 #define oldlastpm      (curinterp->Ioldlastpm)
 #define oldname                (curinterp->Ioldname)
+#define op_mask                (curinterp->Iop_mask)
 #define origargc       (curinterp->Iorigargc)
 #define origargv       (curinterp->Iorigargv)
 #define origfilename   (curinterp->Iorigfilename)
 #define Iofslen                ofslen
 #define Ioldlastpm     oldlastpm
 #define Ioldname       oldname
+#define Iop_mask       op_mask
 #define Iorigargc      origargc
 #define Iorigargv      origargv
 #define Iorigfilename  origfilename
diff --git a/embed.pl b/embed.pl
new file mode 100644 (file)
index 0000000..118b911
--- /dev/null
+++ b/embed.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+open(EM, ">embed.h") || die "Can't create embed.h: $!\n";
+
+print EM <<'END';
+/* This file is derived from global.sym and interp.sym */
+
+/* (Doing namespace management portably in C is really gross.) */
+
+#ifdef EMBED
+
+/* globals we need to hide from the world */
+END
+
+open(GL, "<global.sym") || die "Can't open global.sym: $!\n";
+
+while(<GL>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/(.*)/#define $1\t\tPerl_$1/;
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+
+close(GL) || warn "Can't close global.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* EMBED */
+
+/* Put interpreter specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+END
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/(.*)/#define $1\t\t(curinterp->I$1)/;
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#else  /* not multiple, so translate interpreter symbols the other way... */
+
+END
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/(.*)/#define I$1\t\t$1/;
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* MULTIPLICITY */
+END
+
diff --git a/embed_h.sh b/embed_h.sh
deleted file mode 100755 (executable)
index e098c1e..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-#!/bin/sh
-
-rm -f embed.h
-cat <<'END' >embed.h
-/* This file is derived from global.sym and interp.sym */
-
-/* (Doing namespace management portably in C is really gross.) */
-
-#ifdef EMBED
-
-/* globals we need to hide from the world */
-END
-
-sed <global.sym >>embed.h                                              \
-       -e 's/[         ]*#.*//'                                        \
-       -e '/^[         ]*$/d'                                          \
-       -e 's/\(.*\)/#define \1         Perl_\1/'                       \
-       -e 's/\(................        \)      /\1/'
-
-cat <<'END' >> embed.h
-
-#endif /* EMBED */
-
-/* Put interpreter specific symbols into a struct? */
-
-#ifdef MULTIPLICITY
-
-END
-
-
-sed <interp.sym >>embed.h                                              \
-       -e 's/[         ]*#.*//'                                        \
-       -e '/^[         ]*$/d'                                          \
-       -e 's/\(.*\)/#define \1         (curinterp->I\1)/'              \
-       -e 's/\(................        \)      /\1/'
-
-cat <<'END' >> embed.h
-
-#else  /* not multiple, so translate interpreter symbols the other way... */
-
-END
-
-sed <interp.sym >>embed.h                                              \
-       -e 's/[         ]*#.*//'                                        \
-       -e '/^[         ]*$/d'                                          \
-       -e 's/\(.*\)/#define I\1                \1/'                    \
-       -e 's/\(................        \)      /\1/'
-
-cat <<'END' >> embed.h
-
-#endif /* MULTIPLICITY */
-END
-
index 0a0b717..81b42d8 100644 (file)
@@ -29,6 +29,16 @@ char *s;
     return -1;
 }
 
+/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
+   gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
+   (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
+*/
+#ifndef GDBM_FAST
+#define gdbm_exists(db,key) not_here("gdbm_exists")
+#define gdbm_sync(db) (void) not_here("gdbm_sync")
+#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
+#endif
+
 static double
 constant(name, arg)
 char *name;
index e400760..ec0181a 100644 (file)
@@ -357,6 +357,7 @@ do_vop
 doeval
 dofindlabel
 dopoptoeval
+dowantarray
 dump_all
 dump_eval
 dump_gv
index 74bae05..756ad78 100644 (file)
@@ -14,9 +14,6 @@
 # Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net>
 # Date: Fri, 12 May 1995 14:30:38 +0200 (MET DST)
 #
-# FreeBSD has the dynamic loading dl*() functions in /usr/lib/crt0.o,
-# so Configure doesn't find them (unless you abandon the nm scan).
-#
 # The two flags "-fpic -DPIC" are used to indicate a
 # will-be-shared object.  Configure will guess the -fpic, (and the
 # -DPIC is not used by perl proper) but the full define is included to 
@@ -31,9 +28,7 @@ case "$osvers" in
 0.*|1.0*)
        usedl="$undef"
        ;;
-1.1*)  d_dlopen="$define"
-       cccdlflags='-DPIC -fpic'
-       lddlflags="-Bshareable $lddlflags"
+1.1*)
        malloctype='void *'
        groupstype='int'
        d_setregid='undef'
@@ -41,10 +36,7 @@ case "$osvers" in
        d_setrgid='undef'
        d_setruid='undef'
        ;;
-2.0-RELEASE*)
-       d_dlopen="$define"
-       cccdlflags='-DPIC -fpic'
-       lddlflags="-Bshareable $lddlflags"
+2.0-release*)
        d_setregid='undef'
        d_setreuid='undef'
        d_setrgid='undef'
@@ -55,17 +47,26 @@ case "$osvers" in
 # It does not covert all 2.1-current versions as the output of uname
 # changed a few times.
 #
-2.0.5*|2.0-BUILD|2.1*)
-       d_dlopen="$define"
-       cccdlflags='-DPIC -fpic'
+2.0.5*|2.0-built*|2.1*)
+       usevfork='true'
+       d_dosuid='define'
+       ;;
+#
+# Guesses at what will be needed after 2.1
+*)     usevfork='true'
+       d_dosuid='define'
+       ;;
+esac
+
+# Dynamic Loading flags have not changed much, so they are separated
+# out here to avoid duplicating them everywhere.
+case "$osvers" in
+0.*|1.0*) ;;
+*)     cccdlflags='-DPIC -fpic'
        lddlflags="-Bshareable $lddlflags"
-       # Are these defines necessary?  Doesn't Configure find them
-       # correctly?
-       d_setregid='define'
-       d_setreuid='define'
-       d_setrgid='define'
-       d_setruid='define'
+       ;;
 esac
+
 # Avoid telldir prototype conflict in pp_sys.c  (FreeBSD uses const DIR *)
 # Configure should test for this.  Volunteers?
 pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
index f184fd5..b676563 100644 (file)
@@ -64,8 +64,16 @@ sub runpod2man {
 
     # We insist on using the current version of pod2man in case there
     # are enhancements or changes from previous installed versions.
-    $pod2man = "../pod/pod2man";
-    -x  $pod2man       || die "Executable $pod2man not found.\n";
+    # The error message doesn't include the '..' because the user
+    # won't be aware that we've chdir to $poddir.
+    -x  "../pod/pod2man" || die "Executable pod/pod2man not found.\n";
+
+    # We want to be sure to use the current perl.  We can't rely on
+    # the installed perl because it might not be actually installed
+    # yet. (The user may have set the $install* Configure variables 
+    # to point to some temporary home, from which the executable gets
+    # installed by occult means.)
+    $pod2man = "../perl -I ../lib ../pod/pod2man";
 
     &makedir($mandir);
     # Make a list of all the .pm and .pod files in the directory.  We will
index 0530d15..87b81ac 100755 (executable)
@@ -69,10 +69,10 @@ if ($d_shrplib) {
 
 # First we install the version-numbered executables.
 
-&unlink("$installbin/perl$ver");
+&safe_unlink("$installbin/perl$ver");
 &cmd("cp perl $installbin/perl$ver");
 
-&unlink("$installbin/sperl$ver");
+&safe_unlink("$installbin/sperl$ver");
 if ($d_dosuid) {
     &cmd("cp suidperl $installbin/sperl$ver");
     &chmod(04711, "$installbin/sperl$ver");
@@ -83,13 +83,13 @@ exit 0 if $versiononly;
 # Make links to ordinary names if installbin directory isn't current directory.
 
 if (! &samepath($installbin, '.')) {
-    &unlink("$installbin/perl", "$installbin/suidperl");
+    &safe_unlink("$installbin/perl", "$installbin/suidperl");
     &link("$installbin/perl$ver", "$installbin/perl");
     &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid;
 }
 
 if (! &samepath($installbin, 'x2p')) {
-    &unlink("$installbin/a2p");
+    &safe_unlink("$installbin/a2p");
     &cmd("cp x2p/a2p $installbin/a2p");
     &chmod(0755, "$installbin/a2p");
 }
@@ -248,6 +248,22 @@ sub unlink {
     }
 }
 
+sub safe_unlink {
+    local(@names) = @_;
+
+    foreach $name (@names) {
+       next unless -e $name;
+       print STDERR "  unlink $name\n";
+       next if $nonono;
+       next if unlink($name);
+       warn "Couldn't unlink $name: $!\n";
+       if ($! =~ /busy/i) {
+           print STDERR "  mv $name $name.old\n";
+           &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n";
+       }
+    }
+}
+
 sub cmd {
     local($cmd) = @_;
     print STDERR "  $cmd\n";
@@ -257,6 +273,19 @@ sub cmd {
     }
 }
 
+sub rename {
+    local($from,$to) = @_;
+    unless (unlink($to)) {
+       my($i);
+       for ($i = 1; $i < 50; $i++) {
+           last if rename($to, "$to.$i");
+       }
+       return 0 if $i >= 50;   # Give up!
+    }
+    link($from,$to) || return 0;
+    unlink($from);
+}
+
 sub link {
     local($from,$to) = @_;
 
@@ -304,6 +333,10 @@ sub installlib {
     $dir =~ s#^\.(?![^/])/?##;
 
     my $name = $_;
+    
+    # ignore patch backups and the .exists files.
+    return if $name =~ m{\.orig$|~$|^\.exists};
+
     $name = "$dir/$name" if $dir ne '';
 
     my $installlib = $installprivlib;
index 8747e04..4bd3e72 100644 (file)
@@ -96,6 +96,7 @@ ofs
 ofslen
 oldlastpm
 oldname
+op_mask
 origargc
 origargv
 origfilename
index 49f4d20..a764b10 100644 (file)
 #define KEY_NULL               0
 #define KEY___LINE__           1
 #define KEY___FILE__           2
-#define KEY___END__            3
-#define KEY_AUTOLOAD           4
-#define KEY_BEGIN              5
-#define KEY_CORE               6
-#define KEY_DESTROY            7
-#define KEY_END                        8
-#define KEY_EQ                 9
-#define KEY_GE                 10
-#define KEY_GT                 11
-#define KEY_LE                 12
-#define KEY_LT                 13
-#define KEY_NE                 14
-#define KEY_abs                        15
-#define KEY_accept             16
-#define KEY_alarm              17
-#define KEY_and                        18
-#define KEY_atan2              19
-#define KEY_bind               20
-#define KEY_binmode            21
-#define KEY_bless              22
-#define KEY_caller             23
-#define KEY_chdir              24
-#define KEY_chmod              25
-#define KEY_chomp              26
-#define KEY_chop               27
-#define KEY_chown              28
-#define KEY_chr                        29
-#define KEY_chroot             30
-#define KEY_close              31
-#define KEY_closedir           32
-#define KEY_cmp                        33
-#define KEY_connect            34
-#define KEY_continue           35
-#define KEY_cos                        36
-#define KEY_crypt              37
-#define KEY_dbmclose           38
-#define KEY_dbmopen            39
-#define KEY_defined            40
-#define KEY_delete             41
-#define KEY_die                        42
-#define KEY_do                 43
-#define KEY_dump               44
-#define KEY_each               45
-#define KEY_else               46
-#define KEY_elsif              47
-#define KEY_endgrent           48
-#define KEY_endhostent         49
-#define KEY_endnetent          50
-#define KEY_endprotoent                51
-#define KEY_endpwent           52
-#define KEY_endservent         53
-#define KEY_eof                        54
-#define KEY_eq                 55
-#define KEY_eval               56
-#define KEY_exec               57
-#define KEY_exists             58
-#define KEY_exit               59
-#define KEY_exp                        60
-#define KEY_fcntl              61
-#define KEY_fileno             62
-#define KEY_flock              63
-#define KEY_for                        64
-#define KEY_foreach            65
-#define KEY_fork               66
-#define KEY_format             67
-#define KEY_formline           68
-#define KEY_ge                 69
-#define KEY_getc               70
-#define KEY_getgrent           71
-#define KEY_getgrgid           72
-#define KEY_getgrnam           73
-#define KEY_gethostbyaddr      74
-#define KEY_gethostbyname      75
-#define KEY_gethostent         76
-#define KEY_getlogin           77
-#define KEY_getnetbyaddr       78
-#define KEY_getnetbyname       79
-#define KEY_getnetent          80
-#define KEY_getpeername                81
-#define KEY_getpgrp            82
-#define KEY_getppid            83
-#define KEY_getpriority                84
-#define KEY_getprotobyname     85
-#define KEY_getprotobynumber   86
-#define KEY_getprotoent                87
-#define KEY_getpwent           88
-#define KEY_getpwnam           89
-#define KEY_getpwuid           90
-#define KEY_getservbyname      91
-#define KEY_getservbyport      92
-#define KEY_getservent         93
-#define KEY_getsockname                94
-#define KEY_getsockopt         95
-#define KEY_glob               96
-#define KEY_gmtime             97
-#define KEY_goto               98
-#define KEY_grep               99
-#define KEY_gt                 100
-#define KEY_hex                        101
-#define KEY_if                 102
-#define KEY_index              103
-#define KEY_int                        104
-#define KEY_ioctl              105
-#define KEY_join               106
-#define KEY_keys               107
-#define KEY_kill               108
-#define KEY_last               109
-#define KEY_lc                 110
-#define KEY_lcfirst            111
-#define KEY_le                 112
-#define KEY_length             113
-#define KEY_link               114
-#define KEY_listen             115
-#define KEY_local              116
-#define KEY_localtime          117
-#define KEY_log                        118
-#define KEY_lstat              119
-#define KEY_lt                 120
-#define KEY_m                  121
-#define KEY_map                        122
-#define KEY_mkdir              123
-#define KEY_msgctl             124
-#define KEY_msgget             125
-#define KEY_msgrcv             126
-#define KEY_msgsnd             127
-#define KEY_my                 128
-#define KEY_ne                 129
-#define KEY_next               130
-#define KEY_no                 131
-#define KEY_not                        132
-#define KEY_oct                        133
-#define KEY_open               134
-#define KEY_opendir            135
-#define KEY_or                 136
-#define KEY_ord                        137
-#define KEY_pack               138
-#define KEY_package            139
-#define KEY_pipe               140
-#define KEY_pop                        141
-#define KEY_pos                        142
-#define KEY_print              143
-#define KEY_printf             144
-#define KEY_push               145
-#define KEY_q                  146
-#define KEY_qq                 147
-#define KEY_quotemeta          148
-#define KEY_qw                 149
-#define KEY_qx                 150
-#define KEY_rand               151
-#define KEY_read               152
-#define KEY_readdir            153
-#define KEY_readline           154
-#define KEY_readlink           155
-#define KEY_readpipe           156
-#define KEY_recv               157
-#define KEY_redo               158
-#define KEY_ref                        159
-#define KEY_rename             160
-#define KEY_require            161
-#define KEY_reset              162
-#define KEY_return             163
-#define KEY_reverse            164
-#define KEY_rewinddir          165
-#define KEY_rindex             166
-#define KEY_rmdir              167
-#define KEY_s                  168
-#define KEY_scalar             169
-#define KEY_seek               170
-#define KEY_seekdir            171
-#define KEY_select             172
-#define KEY_semctl             173
-#define KEY_semget             174
-#define KEY_semop              175
-#define KEY_send               176
-#define KEY_setgrent           177
-#define KEY_sethostent         178
-#define KEY_setnetent          179
-#define KEY_setpgrp            180
-#define KEY_setpriority                181
-#define KEY_setprotoent                182
-#define KEY_setpwent           183
-#define KEY_setservent         184
-#define KEY_setsockopt         185
-#define KEY_shift              186
-#define KEY_shmctl             187
-#define KEY_shmget             188
-#define KEY_shmread            189
-#define KEY_shmwrite           190
-#define KEY_shutdown           191
-#define KEY_sin                        192
-#define KEY_sleep              193
-#define KEY_socket             194
-#define KEY_socketpair         195
-#define KEY_sort               196
-#define KEY_splice             197
-#define KEY_split              198
-#define KEY_sprintf            199
-#define KEY_sqrt               200
-#define KEY_srand              201
-#define KEY_stat               202
-#define KEY_study              203
-#define KEY_sub                        204
-#define KEY_substr             205
-#define KEY_symlink            206
-#define KEY_syscall            207
-#define KEY_sysread            208
-#define KEY_system             209
-#define KEY_syswrite           210
-#define KEY_tell               211
-#define KEY_telldir            212
-#define KEY_tie                        213
-#define KEY_time               214
-#define KEY_times              215
-#define KEY_tr                 216
-#define KEY_truncate           217
-#define KEY_uc                 218
-#define KEY_ucfirst            219
-#define KEY_umask              220
-#define KEY_undef              221
-#define KEY_unless             222
-#define KEY_unlink             223
-#define KEY_unpack             224
-#define KEY_unshift            225
-#define KEY_untie              226
-#define KEY_until              227
-#define KEY_use                        228
-#define KEY_utime              229
-#define KEY_values             230
-#define KEY_vec                        231
-#define KEY_wait               232
-#define KEY_waitpid            233
-#define KEY_wantarray          234
-#define KEY_warn               235
-#define KEY_while              236
-#define KEY_write              237
-#define KEY_x                  238
-#define KEY_xor                        239
-#define KEY_y                  240
+#define KEY___DATA__           3
+#define KEY___END__            4
+#define KEY_AUTOLOAD           5
+#define KEY_BEGIN              6
+#define KEY_CORE               7
+#define KEY_DESTROY            8
+#define KEY_END                        9
+#define KEY_EQ                 10
+#define KEY_GE                 11
+#define KEY_GT                 12
+#define KEY_LE                 13
+#define KEY_LT                 14
+#define KEY_NE                 15
+#define KEY_abs                        16
+#define KEY_accept             17
+#define KEY_alarm              18
+#define KEY_and                        19
+#define KEY_atan2              20
+#define KEY_bind               21
+#define KEY_binmode            22
+#define KEY_bless              23
+#define KEY_caller             24
+#define KEY_chdir              25
+#define KEY_chmod              26
+#define KEY_chomp              27
+#define KEY_chop               28
+#define KEY_chown              29
+#define KEY_chr                        30
+#define KEY_chroot             31
+#define KEY_close              32
+#define KEY_closedir           33
+#define KEY_cmp                        34
+#define KEY_connect            35
+#define KEY_continue           36
+#define KEY_cos                        37
+#define KEY_crypt              38
+#define KEY_dbmclose           39
+#define KEY_dbmopen            40
+#define KEY_defined            41
+#define KEY_delete             42
+#define KEY_die                        43
+#define KEY_do                 44
+#define KEY_dump               45
+#define KEY_each               46
+#define KEY_else               47
+#define KEY_elsif              48
+#define KEY_endgrent           49
+#define KEY_endhostent         50
+#define KEY_endnetent          51
+#define KEY_endprotoent                52
+#define KEY_endpwent           53
+#define KEY_endservent         54
+#define KEY_eof                        55
+#define KEY_eq                 56
+#define KEY_eval               57
+#define KEY_exec               58
+#define KEY_exists             59
+#define KEY_exit               60
+#define KEY_exp                        61
+#define KEY_fcntl              62
+#define KEY_fileno             63
+#define KEY_flock              64
+#define KEY_for                        65
+#define KEY_foreach            66
+#define KEY_fork               67
+#define KEY_format             68
+#define KEY_formline           69
+#define KEY_ge                 70
+#define KEY_getc               71
+#define KEY_getgrent           72
+#define KEY_getgrgid           73
+#define KEY_getgrnam           74
+#define KEY_gethostbyaddr      75
+#define KEY_gethostbyname      76
+#define KEY_gethostent         77
+#define KEY_getlogin           78
+#define KEY_getnetbyaddr       79
+#define KEY_getnetbyname       80
+#define KEY_getnetent          81
+#define KEY_getpeername                82
+#define KEY_getpgrp            83
+#define KEY_getppid            84
+#define KEY_getpriority                85
+#define KEY_getprotobyname     86
+#define KEY_getprotobynumber   87
+#define KEY_getprotoent                88
+#define KEY_getpwent           89
+#define KEY_getpwnam           90
+#define KEY_getpwuid           91
+#define KEY_getservbyname      92
+#define KEY_getservbyport      93
+#define KEY_getservent         94
+#define KEY_getsockname                95
+#define KEY_getsockopt         96
+#define KEY_glob               97
+#define KEY_gmtime             98
+#define KEY_goto               99
+#define KEY_grep               100
+#define KEY_gt                 101
+#define KEY_hex                        102
+#define KEY_if                 103
+#define KEY_index              104
+#define KEY_int                        105
+#define KEY_ioctl              106
+#define KEY_join               107
+#define KEY_keys               108
+#define KEY_kill               109
+#define KEY_last               110
+#define KEY_lc                 111
+#define KEY_lcfirst            112
+#define KEY_le                 113
+#define KEY_length             114
+#define KEY_link               115
+#define KEY_listen             116
+#define KEY_local              117
+#define KEY_localtime          118
+#define KEY_log                        119
+#define KEY_lstat              120
+#define KEY_lt                 121
+#define KEY_m                  122
+#define KEY_map                        123
+#define KEY_mkdir              124
+#define KEY_msgctl             125
+#define KEY_msgget             126
+#define KEY_msgrcv             127
+#define KEY_msgsnd             128
+#define KEY_my                 129
+#define KEY_ne                 130
+#define KEY_next               131
+#define KEY_no                 132
+#define KEY_not                        133
+#define KEY_oct                        134
+#define KEY_open               135
+#define KEY_opendir            136
+#define KEY_or                 137
+#define KEY_ord                        138
+#define KEY_pack               139
+#define KEY_package            140
+#define KEY_pipe               141
+#define KEY_pop                        142
+#define KEY_pos                        143
+#define KEY_print              144
+#define KEY_printf             145
+#define KEY_push               146
+#define KEY_q                  147
+#define KEY_qq                 148
+#define KEY_quotemeta          149
+#define KEY_qw                 150
+#define KEY_qx                 151
+#define KEY_rand               152
+#define KEY_read               153
+#define KEY_readdir            154
+#define KEY_readline           155
+#define KEY_readlink           156
+#define KEY_readpipe           157
+#define KEY_recv               158
+#define KEY_redo               159
+#define KEY_ref                        160
+#define KEY_rename             161
+#define KEY_require            162
+#define KEY_reset              163
+#define KEY_return             164
+#define KEY_reverse            165
+#define KEY_rewinddir          166
+#define KEY_rindex             167
+#define KEY_rmdir              168
+#define KEY_s                  169
+#define KEY_scalar             170
+#define KEY_seek               171
+#define KEY_seekdir            172
+#define KEY_select             173
+#define KEY_semctl             174
+#define KEY_semget             175
+#define KEY_semop              176
+#define KEY_send               177
+#define KEY_setgrent           178
+#define KEY_sethostent         179
+#define KEY_setnetent          180
+#define KEY_setpgrp            181
+#define KEY_setpriority                182
+#define KEY_setprotoent                183
+#define KEY_setpwent           184
+#define KEY_setservent         185
+#define KEY_setsockopt         186
+#define KEY_shift              187
+#define KEY_shmctl             188
+#define KEY_shmget             189
+#define KEY_shmread            190
+#define KEY_shmwrite           191
+#define KEY_shutdown           192
+#define KEY_sin                        193
+#define KEY_sleep              194
+#define KEY_socket             195
+#define KEY_socketpair         196
+#define KEY_sort               197
+#define KEY_splice             198
+#define KEY_split              199
+#define KEY_sprintf            200
+#define KEY_sqrt               201
+#define KEY_srand              202
+#define KEY_stat               203
+#define KEY_study              204
+#define KEY_sub                        205
+#define KEY_substr             206
+#define KEY_symlink            207
+#define KEY_syscall            208
+#define KEY_sysread            209
+#define KEY_system             210
+#define KEY_syswrite           211
+#define KEY_tell               212
+#define KEY_telldir            213
+#define KEY_tie                        214
+#define KEY_time               215
+#define KEY_times              216
+#define KEY_tr                 217
+#define KEY_truncate           218
+#define KEY_uc                 219
+#define KEY_ucfirst            220
+#define KEY_umask              221
+#define KEY_undef              222
+#define KEY_unless             223
+#define KEY_unlink             224
+#define KEY_unpack             225
+#define KEY_unshift            226
+#define KEY_untie              227
+#define KEY_until              228
+#define KEY_use                        229
+#define KEY_utime              230
+#define KEY_values             231
+#define KEY_vec                        232
+#define KEY_wait               233
+#define KEY_waitpid            234
+#define KEY_wantarray          235
+#define KEY_warn               236
+#define KEY_while              237
+#define KEY_write              238
+#define KEY_x                  239
+#define KEY_xor                        240
+#define KEY_y                  241
index d3426be..8cbaa83 100755 (executable)
@@ -26,6 +26,7 @@ __END__
 NULL
 __LINE__
 __FILE__
+__DATA__
 __END__
 AUTOLOAD
 BEGIN
index ca1ff35..0a7abc5 100644 (file)
@@ -36,6 +36,16 @@ Application says:
 You can set C<$Exporter::Verbose=1;> to see how the specifications are
 being processed and what is actually being imported into modules.
 
+=head2 Module Version Checking
+
+The Exporter module will convert an attempt to import a number from a
+module into a call to $module_name->require_version($value). This can
+be used to validate that the version of the module being used is
+greater than or equal to the required version.
+
+The Exporter module supplies a default require_version method which
+checks the value of $VERSION in the exporting module.
+
 =cut
 
 require 5.001;
@@ -111,7 +121,15 @@ sub export {
 
        foreach $sym (@imports) {
            if (!$exports{$sym}) {
-               if ($sym !~ s/^&// || !$exports{$sym}) {
+               if ($sym =~ m/^\d/) {
+                   $pkg->require_version($sym);
+                   # If the version number was the only thing specified
+                   # then we should act as if nothing was specified:
+                   if (@imports == 1) {
+                       @imports = @exports;
+                       last;
+                   }
+               } elsif ($sym !~ s/^&// || !$exports{$sym}) {
                    warn qq["$sym" is not exported by the $pkg module ],
                            "at $callfile line $callline\n";
                    $oops++;
@@ -152,4 +170,13 @@ sub export_tags {
        map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags);
 }
 
+sub require_version {
+    my($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = ${"${pkg}::VERSION"} || "(undef)";
+    Carp::croak("$pkg $wanted required--this is only version $version")
+               if $version < $wanted;
+    $version;
+}
+
 1;
index 06b4ab5..b073ffc 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::MakeMaker;
 
-$Version = 4.15; # Last edited $Date: 1995/06/06 14:04:00 $ by Andreas Koenig
+$Version = 4.16; # Last edited $Date: 1995/06/18 16:04:00 $ by Tim Bunce
 
 $Version_OK = 4.13;    # Makefiles older than $Version_OK will die
                        # (Will be checked from MakeMaker version 4.13 onwards)
@@ -263,13 +263,13 @@ sub help {print $Attrib_Help;}
     'clean'            => {},
     'realclean'                => {},
     'dist'             => {},
-    'test'             => {},
     'install'          => {},
     'force'            => {},
     'perldepend'       => {},
     'makefile'         => {},
-    'postamble'                => {},
-    'staticmake'       => {},
+    'staticmake'       => {},  # Sadly this defines more macros
+    'test'             => {},
+    'postamble'                => {},  # should always be last
 );
 %MM_Sections = @MM_Sections_spec; # looses section ordering
 @MM_Sections = grep(!ref, @MM_Sections_spec); # keeps order
@@ -765,7 +765,8 @@ sub init_dirscan {  # --- File and Directory Lists (.xs .pm .pod etc)
            $xs{$name} = $c;
            $c{$c} = 1;
        } elsif ($name =~ /\.c$/){
-           $c{$name} = 1;
+           $c{$name} = 1
+               unless $name =~ m/perlmain\.c/; # See MAP_TARGET
        } elsif ($name =~ /\.h$/){
            $h{$name} = 1;
        } elsif ($name =~ /\.(p[ml]|pod)$/){
@@ -1842,21 +1843,40 @@ sub test {
     my(@m);
     push(@m,"
 TEST_VERBOSE=0
+TEST_TYPE=test_$att{LINKTYPE}
 
-test :: all
+test :: \$(TEST_TYPE)
 ");
-    push(@m, <<"END") if $tests;
-       \$(FULLPERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -e 'use Test::Harness qw(&runtests \$\$verbose); \$\$verbose=\$(TEST_VERBOSE); runtests \@ARGV;' $tests
-END
-    push(@m, <<'END') if -f "test.pl";
-       $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl
-END
     push(@m, map("\tcd $_ && test -f $att{MAKEFILE} && \$(MAKE) test \$(PASTHRU2)\n",
                 @{$att{DIR}}));
-    push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n") unless @m > 1;
+    push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n")
+       unless $tests or -f "test.pl" or @{$att{DIR}};
+    push(@m, "\n");
+
+    push(@m, "test_dynamic :: all\n");
+    push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "\n");
+
+    push(@m, "test_static :: all \$(MAP_TARGET)\n");
+    push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests;
+    push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl";
+    push(@m, "\n");
+
     join("", @m);
 }
 
+sub test_via_harness {
+    my($self, $perl, $tests) = @_;
+    "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n";
+}
+
+sub test_via_script {
+    my($self, $perl, $script) = @_;
+    "\t$perl".' -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl
+';
+}
+
 
 sub install {
     my($self, %attribs) = @_;
@@ -2129,10 +2149,10 @@ inst_perl: pure_inst_perl doc_inst_perl
 pure_inst_perl: \$(MAP_TARGET)
        $att{CP} \$(MAP_TARGET) \$(INSTALLBIN)/\$(MAP_TARGET)
 
-realclean :: map_clean
+clean :: map_clean
 
 map_clean :
-       $att{RM_F} $tmp/perlmain.o $tmp/perlmain.c $makefilename extralibs.ld
+       $att{RM_F} $tmp/perlmain.o $tmp/perlmain.c \$(MAP_TARGET) extralibs.ld
 };
 
     join '', @m;
@@ -2761,6 +2781,25 @@ directories in LDLOADLIBS.
 
 Add -I$(PERL_ARCHLIB) -I$(PERL_LIB) to calls to xsubpp.
 
+=head v4.16 June 18, 1995, by Tim Bunce
+
+Split test: target into test_static: and test_dynamic: with automatic
+selection based on LINKTYPE. The test_static: target automatically
+builds a local ./perl binary containing the extension and executes the
+tests using that binary. This fixes problems that users were having
+dealing with building and testing static extensions. It also simplifies
+the process down to the standard: make + make test.
+
+MakeMaker no longer incorrectly considers a perlmain.c file to be part
+of an extensions source files. The map_clean target is now invoked by
+clean not realclean and now deletes MAP_TARGET but does not delete
+Makefile (since that's done properly elsewhere).
+
+Since the staticmake section defines macros that the test target now
+needs the test section is written into the makefile after the
+staticmake section.  The postamble section has been made last again, as
+it should be.
+
 =head1 TODO
 
 Needs more complete documentation.
index e46b732..dbfb352 100755 (executable)
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-C++>] [B<-except>] [B<-typemap typemap>] file.xs
+B<xsubpp> [B<-C++>] [B<-except>] [B<-typemap typemap>]... file.xs
 
 =head1 DESCRIPTION
 
@@ -156,21 +156,60 @@ When an error or warning message is printed C<xsubpp> will now attempt
 to identify the exact line in the C<.xs> file where the fault occurs.
 This can be achieved in the majority of cases.
 
+=head2 1.8 
+
+Changes by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>, 6 June 1995.
+
+Accept backslash-newline as in C.  Allow preprocessor directives
+anywhere.  Ignore whitespace in front of comments and on blank lines.
+
+=head2 1.9 
+
+Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 21 June 1995.
+
+=over 5
+
+=item 1.
+
+Changed duplicate function error to a warning.
+
+=item 2.
+
+Changed the comment placed at the top of the C<.c> file to be more like
+the comment used by MakeMaker.
+
+=item 3.
+
+When parsing the type for an XSUB parameter I<xsubpp> can now accept
+definitions like this:
+
+    char *fred
+
+i.e. the '*' is recognised as part of the type, rather than the first
+character of the variable.
+
+=item 4.
+
+Fixed a problem with command line parsing - I<xsubpp> was not properly
+detecting the case where there was no filename present on the command
+line.
+
+=back
+
 =head1 SEE ALSO
 
-perl(1)
+perl(1), perlapi(1)
 
 =cut
 
-use FileHandle ;
-
 # Global Constants
-$XSUBPP_version = "1.7" ;
+$XSUBPP_version = "1.9" ;
 
 $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n";
 
-SWITCH: while ($ARGV[0] =~ s/^-//) {
+SWITCH: while ($ARGV[0] =~ /^-/) {
     $flag = shift @ARGV;
+    $flag =~ s/^-// ;
     $spat = shift,     next SWITCH     if $flag eq 's';
     $cplusplus = 1,    next SWITCH     if $flag eq 'C++';
     $except = 1,       next SWITCH     if $flag eq 'except';
@@ -178,7 +217,7 @@ SWITCH: while ($ARGV[0] =~ s/^-//) {
     die $usage;
 }
 @ARGV == 1 or die $usage;
-chop($pwd = `pwd`);
+chomp($pwd = `pwd`);
 # Check for error message from VMS
 if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} }
 ($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
@@ -197,6 +236,7 @@ sub TidyType
 
     # rationalise any '*' by joining them into bunches and removing whitespace
     s#\s*(\*+)\s*#$1#g;
+    s#(\*+)# $1 #g ;
 
     # change multiple whitespace into a single space
     s/\s+/ /g ;
@@ -221,16 +261,16 @@ foreach $typemap (@tm) {
        unless -T $typemap ;
     open(TYPEMAP, $typemap) 
        or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
-    $mode = Typemap;
+    $mode = 'Typemap';
     $junk = "" ;
     $current = \$junk;
     while (<TYPEMAP>) {
-       next if /^#/;
-       if (/^INPUT\s*$/) { $mode = Input, next }
-       if (/^OUTPUT\s*$/) { $mode = Output, next }
-       if (/^TYPEMAP\s*$/) { $mode = Typemap, next }
-       if ($mode eq Typemap) {
-           chop;
+       next if /^\s*#/;
+       if (/^INPUT\s*$/)   { $mode = 'Input';   next; }
+       if (/^OUTPUT\s*$/)  { $mode = 'Output';  next; }
+       if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
+       if ($mode eq 'Typemap') {
+           chomp;
            my $line = $_ ;
             TrimWhitespace($_) ;
            # skip blank lines and comment lines
@@ -242,7 +282,7 @@ foreach $typemap (@tm) {
             TrimWhitespace($kind) ;
            $type_kind{TidyType("@words")} = $kind ;
        }
-       elsif ($mode eq Input) {
+       elsif ($mode eq 'Input') {
            if (/^\s/) {
                $$current .= $_;
            }
@@ -271,7 +311,7 @@ foreach $key (keys %input_expr) {
 }
 
 sub Q {
-    local $text = shift;
+    my($text) = @_;
     $text =~ tr/#//d;
     $text =~ s/\[\[/{/g;
     $text =~ s/\]\]/}/g;
@@ -281,77 +321,85 @@ sub Q {
 open(F, $filename) or die "cannot open $filename: $!\n";
 
 # Identify the version of xsubpp used
-$TimeStamp = localtime ;
 print <<EOM ;
-/* 
- * This file was generated automatically by xsubpp version $XSUBPP_version
- * from $filename on $TimeStamp
+/*
+ * This file was generated automatically by xsubpp version $XSUBPP_version from the 
+ * contents of $filename. Don't edit this file, edit $filename instead.
+ *
+ *     ANY CHANGES MADE HERE WILL BE LOST! 
  *
  */
+
 EOM
  
 
 while (<F>) {
-    last if ($Module, $foo, $Package, $foo1, $Prefix) =
-       /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/;
+    last if ($Module, $Package, $Prefix) =
+       /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
     print $_;
 }
-exit 0 if $_ eq "";
-$lastline = $_;
+&Exit unless defined $_;
+
+my $lastline   = $_;
+my $lastline_no = $.;
 
+
+# Read next xsub into @line from ($lastline, <F>).
 sub fetch_para {
     # parse paragraph
     @line = ();
     @line_no = () ;
-    if ($lastline ne "") {
-       if ($lastline =~
-    /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) {
-           $Module = $1;
-           $foo = $2;
-           $Package = $3;
-           $foo1 = $4;
-           $Prefix = $5;
-           ($Module_cname = $Module) =~ s/\W/_/g;
-           ($Packid = $Package) =~ s/:/_/g;
-           $Packprefix = $Package;
-           $Packprefix .= "::" if defined $Packprefix && $Packprefix ne "";
-           while (<F>) {
-               chop;
-               next if /^#/ &&
-                   !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/;
-               last if /^\S/;
-           }
-           push(@line, $_), push(@line_no, input_line_number F) if $_ ne "";
-       }
-       else {
-           push(@line, $lastline);
-            push(@line_no, $lastline_no) ;
-       }
+    return 0 unless defined $lastline;
+
+    if ($lastline =~
+       /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
+       $Module = $1;
+       $Package = $2;
+       $Prefix = $3;
+       ($Module_cname = $Module) =~ s/\W/_/g;
+       ($Packid = $Package) =~ s/:/_/g;
+       $Packprefix = $Package;
+       $Packprefix .= "::" if defined $Packprefix && $Packprefix ne "";
        $lastline = "";
-       while (<F>) {
-           next if /^#/ &&
-               !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/;
-           chop;
-           if (/^\S/ && @line && $line[-1] eq "") {
-               $lastline = $_;
-                $lastline_no = input_line_number F ;
-               last;
-           }
-           else {
-               push(@line, $_);
-                push(@line_no, input_line_number F) ;
-           }
+    }
+
+    for(;;) {
+       if ($lastline !~ /^\s*#/ ||
+           $lastline =~ /^#[ \t]*((if|ifn?def|else|elif|endif|define|undef|pragma)\b|include\s*["<].*[>"])/) {
+           last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
+           push(@line, $lastline);
+           push(@line_no, $lastline_no) ;
        }
-       pop(@line), pop(@line_no) while @line && $line[-1] =~ /^\s*$/;
+
+       # Read next line and continuation lines
+       last unless defined($lastline = <F>);
+       $lastline_no = $.;
+       my $tmp_line;
+       $lastline .= $tmp_line
+           while ($lastline =~ /\\\n$/ && defined($tmp_line = <F>));
+           
+       # chomp $lastline;
+       $lastline =~ s/^\s+$//;
     }
-    $PPCODE = grep(/PPCODE:/, @line);
-    scalar @line;
+    pop(@line), pop(@line_no) while @line && $line[-1] eq "";
+    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    1;
 }
 
 PARAGRAPH:
 while (&fetch_para) {
+    # Print initial preprocessor statements and blank lines
+    print shift(@line), "\n"
+       while @line && $line[0] !~ /^[^\#]/;
+
+    next PARAGRAPH unless @line;
+
+    death ("Code is not inside a function")
+       if $line[0] =~ /^\s/;
+
     # initialize info arrays
+    # my(%args_match,%var_types,%var_addr);
+    # my($class,$static,$elipsis,$wantRETVAL,%arg_list);
     undef(%args_match);
     undef(%var_types);
     undef(%var_addr);
@@ -363,9 +411,9 @@ while (&fetch_para) {
     undef(%arg_list) ;
 
     # extract return type, function name and arguments
-    $ret_type = TidyType(shift(@line));
+    my($ret_type) = TidyType(shift(@line));
 
-    if ($ret_type =~ /^BOOT:/) {
+    if ($ret_type =~ /^BOOT\s*:/) {
         push (@BootCode, @line, "", "") ;
         next PARAGRAPH ;
     }
@@ -391,7 +439,7 @@ while (&fetch_para) {
     ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
 
     # Check for duplicate function definition
-    blurt("Error: ignoring duplicate function definition '$func_name'"), next PARAGRAPH
+    Warn("Warning: duplicate function definition '$func_name' detected")
        if defined $Func_name{"${Packid}_$func_name"} ;
     $Func_name{"${Packid}_$func_name"} ++ ;
 
@@ -534,6 +582,15 @@ EOF
                 blurt("Error: invalid argument declaration '$line'"), next
                     unless @words >= 2 ;
                 my $var_name = pop @words ;
+
+               # move any *'s from the variable name to the type
+               push(@words, $1)
+                   if $var_name =~ s/^(\*+)// ;
+
+               # check that removing the *'s hasn't eaten the whole variable
+               blurt("Error: invalid argument declaration '$line'"), next
+                   if $var_name eq '' ;
+
                my $var_type = "@words" ;
 
                # catch many errors similar to: SV<tab>* name
@@ -593,7 +650,7 @@ EOF
                        $args_match{"RETVAL"} = 0;
                        $var_types{"RETVAL"} = $ret_type;
                }
-               if (/^\s*PPCODE:/) {
+               if (/^\s*PPCODE\s*:/) {
                        print $deferred;
                        while (@line) {
                                $_ = shift(@line);
@@ -602,7 +659,7 @@ EOF
                                print "$_\n";
                        }
                        print "\tPUTBACK;\n\treturn;\n";
-               } elsif (/^\s*CODE:/) {
+               } elsif (/^\s*CODE\s*:/) {
                        print $deferred;
                        while (@line) {
                                $_ = shift(@line);
@@ -618,6 +675,7 @@ EOF
                        print "\n\t";
                        if ($ret_type ne "void") {
                                print "RETVAL = ";
+                               $wantRETVAL = 1;
                        }
                        if (defined($static)) {
                            if ($func_name =~ /^new/) {
@@ -629,11 +687,9 @@ EOF
                        } elsif (defined($class)) {
                                print "THIS->";
                        }
-                       if (defined($spat) && $func_name =~ /^($spat)(.*)$/) {
-                               $func_name = $2;
-                       }
+                       $func_name =~ s/^($spat)//
+                           if defined($spat);
                        print "$func_name($func_args);\n";
-                       $wantRETVAL = 1 unless $ret_type eq "void";
                }
        }
 
@@ -644,7 +700,7 @@ EOF
                my %outargs ;
                while (@line) {
                        $_ = shift(@line);
-                       last if /^\s*CLEANUP|CASE\s*:/;
+                       last if /^\s*(CLEANUP|CASE)\s*:/;
                        TrimWhitespace($_) ;
                        next if /^$/ ;
                        my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ;
@@ -746,9 +802,14 @@ if (@BootCode)
     print "    /* End of Initialisation Section */\n\n" ;
 }
 
-print "    ST(0) = &sv_yes;\n";
-print "    XSRETURN(1);\n";
-print "}\n";
+print Q<<"EOF";;
+#    ST(0) = &sv_yes;
+#    XSRETURN(1);
+#]]
+EOF
+
+&Exit;
+
 
 sub output_init {
     local($type, $num, $init) = @_;
@@ -874,7 +935,7 @@ sub generate_output {
 }
 
 sub map_type {
-    local($type) = @_;
+    my($type) = @_;
 
     $type =~ s/:/_/g;
     if ($type =~ /^array\(([^,]*),(.*)\)/) {
@@ -884,7 +945,10 @@ sub map_type {
     }
 }
 
+
+sub Exit {
 # If this is VMS, the exit status has meaning to the shell, so we
 # use a predictable value (SS$_Abort) rather than an arbitrary
 # number.
-exit ($Is_VMS ? 44 : $errors) ;
+    exit ($Is_VMS ? 44 : $errors) ;
+}
diff --git a/lib/lib.pm b/lib/lib.pm
new file mode 100644 (file)
index 0000000..a0fe89b
--- /dev/null
@@ -0,0 +1,103 @@
+package lib;
+
+@ORIG_INC = ();                # (avoid typo warning)
+@ORIG_INC = @INC;      # take a handy copy of 'original' value
+
+
+sub import {
+    shift;
+    unshift(@INC, @_);
+}
+
+
+sub unimport {
+    shift;
+    my $mode = shift if $_[0] =~ m/^:[A-Z]+/;
+
+    my %names;
+    foreach(@_) { ++$names{$_} };
+
+    if ($mode and $mode eq ':ALL') {
+       # Remove ALL instances of each named directory.
+       @INC = grep { !exists $names{$_} } @INC;
+    } else {
+       # Remove INITIAL instance(s) of each named directory.
+       @INC = grep { --$names{$_} < 0   } @INC;
+    }
+}
+
+__END__
+
+=head1 NAME
+
+lib - manipulate @INC at compile time
+
+=head1 SYNOPSIS
+
+    use lib LIST;
+
+    no lib LIST;
+
+=head1 DESCRIPTION
+
+This is a small simple module which simplifies the manipulation of @INC
+at compile time.
+
+It is typically used to add extra directories to perl's search path so
+that later C<use> or C<require> statements will find modules which are
+not located on perl's default search path.
+
+
+=head2 ADDING DIRECTORIES TO @INC
+
+The parameters to C<use lib> are added to the start of the perl search
+path. Saying
+
+    use lib LIST;
+
+is the same as saying
+
+    BEGIN { unshift(@INC, LIST) }
+
+
+=head2 DELETING DIRECTORIES FROM @INC
+
+You should normally only add directories to @INC.  If you need to
+delete directories from @INC take care to only delete those which you
+added yourself or which you are certain are not needed by other modules
+in your script.  Other modules may have added directories which they
+need for correct operation.
+
+By default the C<no lib> statement deletes the I<first> instance of
+each named directory from @INC.  To delete multiple instances of the
+same name from @INC you can specify the name multiple times.
+
+To delete I<all> instances of I<all> the specified names from @INC you can
+specify ':ALL' as the first parameter of C<no lib>. For example:
+
+    no lib qw(:ALL .);
+
+
+=head2 RESTORING ORIGINAL @INC
+
+When the lib module is first loaded it records the current value of @INC
+in an array C<@lib::ORIG_INC>. To restore @INC to that value you
+can say either
+
+    @INC = @lib::ORIG_INC;
+
+or
+
+    no  lib @INC;
+    use lib @lib::ORIG_INC;
+
+=head1 SEE ALSO
+
+AddINC - optional module which deals with paths relative to the source file.
+
+=head1 AUTHOR
+
+Tim Bunce, 2nd June 1995.
+
+=cut
+
diff --git a/op.c b/op.c
index 09edb0e..9a617d2 100644 (file)
--- a/op.c
+++ b/op.c
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef USE_OP_MASK
+/*
+ * In the following definition, the ", (OP *) op" is just to make the compiler
+ * think the expression is of the right type: croak actually does a longjmp.
+ */
+#define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \
+    (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \
+    : (*check[type])((OP *) op))
+#else
+#define CHECKOP(type,op) (*check[type])(op)
+#endif /* USE_OP_MASK */
+
 static I32 list_assignment _((OP *op));
 static OP *bad_type _((I32 n, char *t, OP *op, OP *kid));
 static OP *modkids _((OP *op, I32 type));
@@ -410,7 +422,7 @@ OP *op;
        /* FALL THROUGH */
     case OP_PUSHRE:
     case OP_MATCH:
-       regfree(cPMOP->op_pmregexp);
+       pregfree(cPMOP->op_pmregexp);
        SvREFCNT_dec(cPMOP->op_pmshort);
        break;
     default:
@@ -1441,7 +1453,7 @@ OP* op;
     op->op_ppaddr = ppaddr[type];
     op->op_flags |= flags;
 
-    op = (*check[type])(op);
+    op = CHECKOP(type, op);
     if (op->op_type != type)
        return op;
 
@@ -1617,7 +1629,7 @@ I32 flags;
        scalar(op);
     if (opargs[type] & OA_TARGET)
        op->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])(op);
+    return CHECKOP(type, op);
 }
 
 OP *
@@ -1640,7 +1652,7 @@ OP* first;
     unop->op_flags = flags | OPf_KIDS;
     unop->op_private = 1;
 
-    unop = (UNOP*)(*check[type])((OP*)unop);
+    unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
        return (OP*)unop;
 
@@ -1673,7 +1685,7 @@ OP* last;
        first->op_sibling = last;
     }
 
-    binop = (BINOP*)(*check[type])((OP*)binop);
+    binop = (BINOP*)CHECKOP(type, binop);
     if (binop->op_next)
        return (OP*)binop;
 
@@ -1794,7 +1806,7 @@ OP *repl;
            p = SvPV(pat, plen);
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
-       pm->op_pmregexp = regcomp(p, p + plen, pm);
+       pm->op_pmregexp = pregcomp(p, p + plen, pm);
        if (strEQ("\\s+", pm->op_pmregexp->precomp)) 
            pm->op_pmflags |= PMf_WHITE;
        hoistmust(pm);
@@ -1905,7 +1917,7 @@ SV *sv;
        scalar((OP*)svop);
     if (opargs[type] & OA_TARGET)
        svop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)svop);
+    return CHECKOP(type, svop);
 }
 
 OP *
@@ -1925,7 +1937,7 @@ GV *gv;
        scalar((OP*)gvop);
     if (opargs[type] & OA_TARGET)
        gvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)gvop);
+    return CHECKOP(type, gvop);
 }
 
 OP *
@@ -1945,7 +1957,7 @@ char *pv;
        scalar((OP*)pvop);
     if (opargs[type] & OA_TARGET)
        pvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)pvop);
+    return CHECKOP(type, pvop);
 }
 
 OP *
@@ -1967,7 +1979,7 @@ OP *cont;
        scalar((OP*)cvop);
     if (opargs[type] & OA_TARGET)
        cvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)cvop);
+    return CHECKOP(type, cvop);
 }
 
 void
diff --git a/op.h b/op.h
index f3ef541..a4704ba 100644 (file)
--- a/op.h
+++ b/op.h
@@ -41,7 +41,7 @@ typedef U16 PADOFFSET;
     U8         op_flags;               \
     U8         op_private;
 
-#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : cxstack[cxstack_ix].blk_gimme & G_ARRAY)
+#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray())
 
 /* Public flags */
 #define OPf_LIST       1       /* Do operator in list context. */
diff --git a/perl.c b/perl.c
index 537d5a8..334c504 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -996,7 +996,7 @@ char *s;
        return s;
     case 'v':
        printf("\nThis is perl, version %s\n\n",patchlevel);
-       fputs("\tUnofficial patchlevel 1l.\n",stdout);
+       fputs("\tUnofficial patchlevel 1m.\n",stdout);
        fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
 #ifdef MSDOS
        fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
diff --git a/perl.h b/perl.h
index 5656d25..df94c4b 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1294,6 +1294,7 @@ IEXT bool Idirty;         /* In the middle of tearing things down? */
 IEXT U8                Ilocalizing;    /* are we processing a local() list? */
 IEXT bool      Itainted;       /* using variables controlled by $< */
 IEXT bool      Itainting;      /* doing taint checks */
+IEXT char *    Iop_mask IINIT(NULL);   /* masked operations for safe evals */
 
 /* trace state */
 IEXT I32       Idlevel;
index f184d93..54d4bfc 100644 (file)
@@ -97,7 +97,7 @@ if(@ARGV<1) {
        die <<EOF;
 Usage: $0 [-h] PageName|ModuleName
 
-We suggest you use C<perldoc perldoc> to get aquainted 
+We suggest you use "perldoc perldoc" to get aquainted 
 with the system.
 EOF
 }
index 1f54df7..bab8a91 100644 (file)
@@ -31,6 +31,8 @@ of sections:
     perlguts   Perl internal functions for those doing extensions 
     perlcall   Perl calling conventions from C
     perlovl    Perl overloading semantics
+    perlembed  Perl how to embed perl in your C or C++ app
+    perlpod    Perl plain old documentation
     perlbook   Perl book information
 
 (If you're intending to read these straight through for the first time,
index 6aaa5d2..af51613 100755 (executable)
@@ -92,7 +92,7 @@ for $count (0,1){
            <!-- \$Log\$ -->
            <HTML>
 HTML__EOQ
-           <TITLE> \U$pod\E </TITLE>
+           <TITLE>\U$pod\E</TITLE>
 HTML__EOQQ
        }
 
@@ -341,11 +341,11 @@ sub picrefs {
        } 
     }
     if ($char =~ /[IF]/) {
-       return "<EM> $bigkey </EM>";
+       return "<EM>$bigkey</EM>";
     } elsif($char =~ /C/) {
-       return "<CODE> $bigkey </CODE>";
+       return "<CODE>$bigkey</CODE>";
     } else {
-       return "<STRONG> $bigkey </STRONG>";
+       return "<STRONG>$bigkey</STRONG>";
     }
 } 
 
@@ -380,18 +380,18 @@ sub lrefs {
     $item =~ s/\(\)$//;
     if (!$item) {
        if (!defined $section && defined $Podnames{$page}) {
-           return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n";
+           return "\n$type$page.html\">\nthe <EM>$page</EM> manpage<\/A>\n";
        } else {
            (warn "Bizarre entry $page/$item") if $Debug;
-           return "the <EM> $_[0] </EM>  manpage\n";
+           return "the <EM>$_[0]</EM>  manpage\n";
        } 
     } 
 
     if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
-       $text = "<EM> $item </EM>";
+       $text = "<EM>$item</EM>";
        $ref = "Headers";
     } else {
-       $text = "<EM> $item </EM>";
+       $text = "<EM>$item</EM>";
        $ref = "Items";
     } 
     for $podname ($pod, @inclusions){
@@ -429,7 +429,7 @@ sub varrefs {
        }
     }
     Debug( "vars", "bummer, $var not a var");
-    return "<STRONG> $var </STRONG>";
+    return "<STRONG>$var</STRONG>";
 } 
 
 sub gensym {
diff --git a/pp.c b/pp.c
index 16e47b6..15c697c 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3391,7 +3391,7 @@ PP(pp_split)
     else {
        maxiters += (strend - s) * rx->nparens;
        while (s < strend && --limit &&
-           regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
+           pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
            if (rx->subbase
              && rx->subbase != orig) {
                m = s;
index cb521b4..a3a34e2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -68,11 +68,11 @@ PP(pp_regcomp) {
     t = SvPV(tmpstr, len);
 
     if (pm->op_pmregexp) {
-       regfree(pm->op_pmregexp);
+       pregfree(pm->op_pmregexp);
        pm->op_pmregexp = Null(REGEXP*);        /* crucial if regcomp aborts */
     }
 
-    pm->op_pmregexp = regcomp(t, t + len, pm);
+    pm->op_pmregexp = pregcomp(t, t + len, pm);
 
     if (!pm->op_pmregexp->prelen && curpm)
        pm = curpm;
@@ -108,7 +108,7 @@ PP(pp_substcont)
        rx->subbase = cx->sb_subbase;
 
        /* Are we done */
-       if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig,
+       if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
                                s == m, Nullsv, cx->sb_safebase))
        {
            SV *targ = cx->sb_targ;
@@ -780,6 +780,21 @@ char *label;
     return i;
 }
 
+I32
+dowantarray()
+{
+    I32 cxix;
+
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0)
+       return G_SCALAR;
+
+    if (cxstack[cxix].blk_gimme == G_ARRAY)
+       return G_ARRAY;
+    else
+       return G_SCALAR;
+}
+
 static I32
 dopoptosub(startingblock)
 I32 startingblock;
@@ -2045,6 +2060,11 @@ PP(pp_require)
     ENTER;
     SAVETMPS;
     lex_start(sv_2mortal(newSVpv("",0)));
+    if (rsfp_filters){
+       save_aptr(&rsfp_filters);
+       rsfp_filters = NULL;
+    }
+
     rsfp = tryrsfp;
     name = savepv(name);
     SAVEFREEPV(name);
index 31983f1..2798507 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -752,7 +752,7 @@ play_it_again:
            pm->op_pmshort = Nullsv;    /* opt is being useless */
        }
     }
-    if (regexec(rx, s, strend, truebase, minmatch,
+    if (pregexec(rx, s, strend, truebase, minmatch,
       SvSCREAM(TARG) ? TARG : Nullsv,
       safebase)) {
        curpm = pm;
@@ -1311,7 +1311,7 @@ PP(pp_subst)
        c = SvPV(dstr, clen);
        if (clen <= rx->minlen) {
                                        /* can do inplace substitution */
-           if (regexec(rx, s, strend, orig, 0,
+           if (pregexec(rx, s, strend, orig, 0,
              SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
                if (force_on_match) {
                    force_on_match = 0;
@@ -1392,7 +1392,7 @@ PP(pp_subst)
                        d += clen;
                    }
                    s = rx->endp[0];
-               } while (regexec(rx, s, strend, orig, s == m,
+               } while (pregexec(rx, s, strend, orig, s == m,
                    Nullsv, TRUE));     /* (don't match same null twice) */
                if (s != d) {
                    i = strend - s;
@@ -1410,7 +1410,7 @@ PP(pp_subst)
     }
     else
        c = Nullch;
-    if (regexec(rx, s, strend, orig, 0,
+    if (pregexec(rx, s, strend, orig, 0,
       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
     long_way:
        if (force_on_match) {
@@ -1443,7 +1443,7 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (regexec(rx, s, strend, orig, s == m, Nullsv,
+       } while (pregexec(rx, s, strend, orig, s == m, Nullsv,
            safebase));
        sv_catpvn(dstr, s, strend - s);
 
diff --git a/proto.h b/proto.h
index 14d8567..07eb0af 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -95,6 +95,7 @@ long  do_tell _((GV* gv));
 I32    do_trans _((SV* sv, OP* arg));
 void   do_vecset _((SV* sv));
 void   do_vop _((I32 optype, SV* sv, SV* left, SV* right));
+I32    dowantarray _((void));
 void   dump_all _((void));
 void   dump_eval _((void));
 #ifdef DUMP_FDS  /* See util.c */
@@ -323,12 +324,12 @@ void      pop_scope _((void));
 OP*    prepend_elem _((I32 optype, OP* head, OP* tail));
 void   push_return _((OP* op));
 void   push_scope _((void));
-regexp*        regcomp _((char* exp, char* xend, PMOP* pm));
+regexp*        pregcomp _((char* exp, char* xend, PMOP* pm));
 OP*    ref _((OP* op, I32 type));
 OP*    refkids _((OP* op, I32 type));
 void   regdump _((regexp* r));
-I32    regexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase));
-void   regfree _((struct regexp* r));
+I32    pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase));
+void   pregfree _((struct regexp* r));
 char*  regnext _((char* p));
 char*  regprop _((char* op));
 void   repeatcpy _((char* to, char* from, I32 len, I32 count));
index c6f48a4..409d03d 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
  * blame Henry for some of the lack of readability.
  */
 
+/* The names of the functions have been changed from regcomp and
+ * regexec to  pregcomp and pregexec in order to avoid conflicts
+ * with the POSIX routines of the same names.
+*/
+
 /*SUPPRESS 112*/
 /*
- * regcomp and regexec -- regsub and regerror are not used in perl
+ * pregcomp and pregexec -- regsub and regerror are not used in perl
  *
  *     Copyright (c) 1986 by University of Toronto.
  *     Written by Henry Spencer.  Not derived from licensed software.
@@ -88,7 +93,7 @@
 #define TRYAGAIN       0x8     /* Weeded out a declaration. */
 
 /*
- * Forward declarations for regcomp()'s friends.
+ * Forward declarations for pregcomp()'s friends.
  */
 
 static char *reg _((I32, I32 *));
@@ -107,7 +112,7 @@ static void regtail _((char *, char *));
 static char* nextchar _((void));
 
 /*
- - regcomp - compile a regular expression into internal code
+ - pregcomp - compile a regular expression into internal code
  *
  * We can't allocate space until we know how big the compiled form will be,
  * but we can't compile it (and thus know how big it is) until we've got a
@@ -122,7 +127,7 @@ static char* nextchar _((void));
  * of the structure of the compiled regexp.  [I'll say.]
  */
 regexp *
-regcomp(exp,xend,pm)
+pregcomp(exp,xend,pm)
 char* exp;
 char* xend;
 PMOP* pm;
@@ -1608,7 +1613,7 @@ char *op;
 #endif /* DEBUGGING */
 
 void
-regfree(r)
+pregfree(r)
 struct regexp *r;
 {
     if (!r)
index a8ecf90..b2d9b84 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
  * Regstart and reganch permit very fast decisions on suitable starting points
  * for a match, cutting down the work a lot.  Regmust permits fast rejection
  * of lines that cannot possibly match.  The regmust tests are costly enough
- * that regcomp() supplies a regmust only if the r.e. contains something
+ * that pregcomp() supplies a regmust only if the r.e. contains something
  * potentially expensive (at present, the only such thing detected is * or +
  * at the start of the r.e., which can involve a lot of backup).  Regmlen is
- * supplied because the test in regexec() needs it and regcomp() is computing
+ * supplied because the test in pregexec() needs it and pregcomp() is computing
  * it anyway.
  * [regmust is now supplied always.  The tests that use regmust have a
  * heuristic that disables the test if it usually matches.]
index 4621990..6d2123f 100644 (file)
--- a/regexec.c
+++ b/regexec.c
  * blame Henry for some of the lack of readability.
  */
 
+/* The names of the functions have been changed from regcomp and
+ * regexec to  pregcomp and pregexec in order to avoid conflicts
+ * with the POSIX routines of the same names.
+*/
+
 /*SUPPRESS 112*/
 /*
- * regcomp and regexec -- regsub and regerror are not used in perl
+ * pregcomp and pregexec -- regsub and regerror are not used in perl
  *
  *     Copyright (c) 1986 by University of Toronto.
  *     Written by Henry Spencer.  Not derived from licensed software.
@@ -132,7 +137,7 @@ regcppop()
 #define regcpblow(cp) leave_scope(cp)
 
 /*
- * regexec and friends
+ * pregexec and friends
  */
 
 /*
@@ -144,10 +149,10 @@ static I32 regrepeat _((char *p, I32 max));
 static I32 regtry _((regexp *prog, char *startpos));
 
 /*
- - regexec - match a regexp against a string
+ - pregexec - match a regexp against a string
  */
 I32
-regexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
+pregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
 register regexp *prog;
 char *stringarg;
 register char *strend; /* pointer to null at end of string */
diff --git a/toke.c b/toke.c
index 0d3f74a..445ec9a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1018,7 +1018,8 @@ filter_add(funcp, datasv)
     IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
     if (filter_debug)
        warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na));
-    av_push(rsfp_filters, datasv);
+    av_unshift(rsfp_filters, 1);
+    av_store(rsfp_filters, 0, datasv) ;
     return(datasv);
 }
  
@@ -1033,8 +1034,10 @@ filter_del(funcp)
     if (!rsfp_filters || AvFILL(rsfp_filters)<0)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
-    if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){
-       sv_free(av_pop(rsfp_filters));
+    if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
+       /* sv_free(av_pop(rsfp_filters)); */
+       sv_free(av_shift(rsfp_filters));
+
         return;
     }
     /* we need to search for the correct entry and clear it    */
@@ -1051,12 +1054,12 @@ filter_read(idx, buf_sv, maxlen)
 {
     filter_t funcp;
     SV *datasv = NULL;
+
     if (!rsfp_filters)
        return -1;
     if (idx > AvFILL(rsfp_filters)){       /* Any more filters?        */
        /* Provide a default input filter to make life easy.    */
        /* Note that we append to the line. This is handy.      */
-       /* We ignore maxlen here                                */
        if (filter_debug)
            warn("filter_read %d: from rsfp\n", idx);
        if (maxlen) { 
@@ -2417,12 +2420,18 @@ yylex()
            TERM(THING);
        }
 
+       case KEY___DATA__:
        case KEY___END__: {
            GV *gv;
 
            /*SUPPRESS 560*/
-           if (!in_eval) {
-               gv = gv_fetchpv("main::DATA",TRUE, SVt_PVIO);
+           if (!in_eval || tokenbuf[2] == 'D') {
+               char dname[256];
+               char *pname = "main";
+               if (tokenbuf[2] == 'D')
+                   pname = HvNAME(curstash ? curstash : defstash);
+               sprintf(dname,"%s::DATA", pname);
+               gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
                SvMULTI_on(gv);
                if (!GvIO(gv))
                    GvIOp(gv) = newIO();
@@ -3308,6 +3317,7 @@ I32 len;
        if (d[1] == '_') {
            if (strEQ(d,"__LINE__"))            return -KEY___LINE__;
            if (strEQ(d,"__FILE__"))            return -KEY___FILE__;
+           if (strEQ(d,"__DATA__"))            return KEY___DATA__;
            if (strEQ(d,"__END__"))             return KEY___END__;
        }
        break;
index aa8a7a3..5c3554b 100644 (file)
@@ -190,7 +190,7 @@ int newlen;
 }
 
 /*VARARGS1*/
-int
+void
 croak(pat,a1,a2,a3,a4)
 char *pat;
 int a1,a2,a3,a4;
@@ -200,7 +200,7 @@ int a1,a2,a3,a4;
 }
 
 /*VARARGS1*/
-int
+void
 fatal(pat,a1,a2,a3,a4)
 char *pat;
 int a1,a2,a3,a4;
index f3ee2a0..35f7961 100644 (file)
@@ -24,10 +24,10 @@ int makedir();
 
 char * cpy2 _(( char *to, char *from, int delim ));
 char * cpytill _(( char *to, char *from, int delim ));
-int croak _(( char *pat, int a1, int a2, int a3, int a4 ));
+void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
 void growstr _(( char **strptr, int *curlen, int newlen ));
 char * instr _(( char *big, char *little ));
-int Myfatal ();
+void Myfatal ();
 char * safecpy _(( char *to, char *from, int len ));
 char * savestr _(( char *str ));
 void warn ();