perl 4.0 patch 9: patch #4, continued
authorLarry Wall <lwall@netlabs.com>
Thu, 6 Jun 1991 23:28:30 +0000 (23:28 +0000)
committerLarry Wall <lwall@netlabs.com>
Thu, 6 Jun 1991 23:28:30 +0000 (23:28 +0000)
See patch #4.

21 files changed:
README
hints/sunos_4_0_1.sh
hints/sunos_4_0_2.sh
hints/svr4.sh [new file with mode: 0644]
hints/ultrix_3.sh
hints/ultrix_4.sh
hints/vax.sh [new file with mode: 0644]
patchlevel.h
stab.h
str.c
str.h
t/op/stat.t
toke.c
util.c
util.h
x2p/Makefile.SH
x2p/str.c
x2p/str.h
x2p/util.c
x2p/util.h
x2p/walk.c

diff --git a/README b/README
index 3ff706d..0e55e7c 100644 (file)
--- a/README
+++ b/README
@@ -2,26 +2,35 @@
                        Perl Kit, Version 4.0
 
                Copyright (c) 1989,1990,1991, Larry Wall
+                         All rights reserved.
 
     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 1, or (at your option)
-    any later version.
+    it under the terms of either:
+    
+       a) the GNU General Public License as published by the Free
+       Software Foundation; either version 1, or (at your option) any
+       later version, or
+
+       b) the "Artistic License" which comes with this Kit.
 
     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
-    GNU General Public License for more details.
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this
+    Kit, in the file named "Artistic".  If not, I'll be glad to provide one.
 
-    You should have received a copy of the GNU General Public License
+    You should also have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
-    My interpretation of the GNU General Public License is that no Perl
-    script falls under the terms of the License unless you explicitly put
-    said script under the terms of the License yourself.  Furthermore, any
+    For those of you that choose to use the GNU General Public License,
+    my interpretation of the GNU General Public License is that no Perl
+    script falls under the terms of the GPL unless you explicitly put
+    said script under the terms of the GPL yourself.  Furthermore, any
     object code linked with uperl.o does not automatically fall under the
-    terms of the License, provided such object code only adds definitions
+    terms of the GPL, provided such object code only adds definitions
     of subroutines and variables, and does not otherwise impair the
     resulting interpreter from executing any standard Perl script.  I
     consider linking in C subroutines in this manner to be the moral
     Public License.  (This is merely an alternate way of specifying input
     to the program.)  You may also sell a binary produced by the dumping of
     a running Perl script that belongs to you, provided that you provide or
-    offer to provide the Perl source as specified by the License.  (The
+    offer to provide the Perl source as specified by the GPL.  (The
     fact that a Perl interpreter and your code are in the same binary file
     is, in this case, a form of mere aggregation.)  This is my interpretation
-    of the License.  If you still have concerns or difficulties understanding
-    my intent, feel free to contact me.
+    of the GPL.  If you still have concerns or difficulties understanding
+    my intent, feel free to contact me.  Of course, the Artistic License
+    spells all this out for your protection, so you may prefer to use that.
 
 --------------------------------------------------------------------------
 
 Perl is a language that combines some of the features of C, sed, awk and shell.
-See the manual page for more hype.
+See the manual page for more hype.  There's also a Nutshell Handbook published
+by O'Reilly & Assoc.  Their U.S. number is 1-800-338-6887 (dev-nuts) and
+their international number is 1-707-829-0515.  E-mail to nuts@ora.com.
 
 Perl will probably not run on machines with a small address space.
 
@@ -107,13 +119,14 @@ Installation
     AIX/RT may need a -a switch and -DCRIPPLED_CC.
     AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c.
     AIX RS/6000 needs -D_NO_PROTO.
-    SUNOS 4.0.[12] needs #define fputs(str,fp) fprintf(fp,"%s",str) in perl.h
+    SUNOS 4.0.[12] needs -DFPUTS_BOTCH.
     SUNOS 3.[45] should use the system malloc.
     SGI machines may need -Ddouble="long float" and -O1.
     Vax-based systems may need to hand assemble teval.s with a -J switch.
     Ultrix on MIPS machines may need -DLANGUAGE_C.
     Ultrix 4.0 on MIPS machines may need -Olimit 2900 or so.
     Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted.
+    MIPS machines need /bin before /bsd43/bin in PATH.
     MIPS machines may need to undef d_volatile.
     MIPS machines may need to turn off -O on cmd.c, perl.c and tperl.c.
     Some MIPS machines may need to undefine CASTNEGFLOAT.
@@ -164,7 +177,8 @@ Installation
 
     If possible, send in patches such that the patch program will apply them.
     Context diffs are the best, then normal diffs.  Don't send ed scripts--
-    I've probably changed my copy since the version you have.
+    I've probably changed my copy since the version you have.  It's also
+    helpful if you send the output of "uname -a".
 
     Watch for perl patches in comp.lang.perl.  Patches will generally be
     in a form usable by the patch program.  If you are just now bringing up
index 0cdff54..7fd8c88 100644 (file)
@@ -1,4 +1 @@
-echo ': work around botch in SunOS 4.0.1 and 4.0.2'    >>../perl.h
-echo '#ifndef fputs'                                   >>../perl.h
-echo '#define fputs(str,fp) fprintf(fp,"%s",str)'      >>../perl.h
-echo '#endif'                                          >>../perl.h
+$ccflags="$ccflags -DFPUTS_BOTCH"
index 0cdff54..7fd8c88 100644 (file)
@@ -1,4 +1 @@
-echo ': work around botch in SunOS 4.0.1 and 4.0.2'    >>../perl.h
-echo '#ifndef fputs'                                   >>../perl.h
-echo '#define fputs(str,fp) fprintf(fp,"%s",str)'      >>../perl.h
-echo '#endif'                                          >>../perl.h
+$ccflags="$ccflags -DFPUTS_BOTCH"
diff --git a/hints/svr4.sh b/hints/svr4.sh
new file mode 100644 (file)
index 0000000..eae477e
--- /dev/null
@@ -0,0 +1,6 @@
+cc='/bin/cc'
+test -f $cc || cc='/usr/ccs/bin/cc'
+ldflags='-L/usr/ucblib'
+mansrc='/usr/share/man/man1'
+ccflags='-I/usr/include -I/usr/ucbinclude'
+libswanted=`echo $libswanted | sed 's/ ucb/ c ucb/'`
index 2057bc6..0df4723 100644 (file)
@@ -1,2 +1,14 @@
 ccflags="$ccflags -DLANGUAGE_C"
-d_waitpid=$undef
+tmp="`(uname -a) 2>/dev/null`"
+case "$tmp" in
+*3.[01]*RISC) d_waitpid=$undef;;
+'') d_waitpid=$undef;;
+esac
+case "$tmp" in
+*RISC)
+    cmd_cflags='optimize="-g"'
+    perl_cflags='optimize="-g"'
+    tcmd_cflags='optimize="-g"'
+    tperl_cflags='optimize="-g"'
+    ;;
+esac
index 008e1ef..ffaf376 100644 (file)
@@ -1 +1,19 @@
 ccflags="$ccflags -DLANGUAGE_C -Olimit 2900"
+tmp=`(uname -a) 2>/dev/null`
+case "$tmp" in
+*RISC*) cat <<EOF
+Note that there is a bug in some versions of NFS on the DECStation that
+may cause utime() to work incorrectly.  If so, regression test io/fs
+may fail if run under NFS.  Ignore the failure.
+EOF
+;;
+esac
+case "$tmp" in
+*4.1*)
+    eval_cflags='optimize="-g"'
+    teval_cflags='optimize="-g"'
+    toke_cflags='optimize="-g"'
+    ttoke_cflags='optimize="-g"'
+    ;;
+esac
+
diff --git a/hints/vax.sh b/hints/vax.sh
new file mode 100644 (file)
index 0000000..ea8f224
--- /dev/null
@@ -0,0 +1 @@
+teval_cflags='case $cc in *gcc);; *) optimize="-O";; esac'
index a6997a9..618bca4 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 8
+#define PATCHLEVEL 9
diff --git a/stab.h b/stab.h
index 6fbe6cf..ddb7d38 100644 (file)
--- a/stab.h
+++ b/stab.h
@@ -1,11 +1,15 @@
-/* $Header: stab.h,v 4.0 91/03/20 01:39:49 lwall Locked $
+/* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       stab.h,v $
+ * Revision 4.0.1.1  91/06/07  11:56:35  lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * 
  * Revision 4.0  91/03/20  01:39:49  lwall
  * 4.0 baseline.
  * 
@@ -93,7 +97,10 @@ struct sub {
 
 #define Nullstab Null(STAB*)
 
+STRLEN stab_len();
+
 #define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab))
+#define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)->str_cur)
 #define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
 #define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
 
diff --git a/str.c b/str.c
index 8ffc553..5ff6a41 100644 (file)
--- a/str.c
+++ b/str.c
@@ -1,11 +1,15 @@
-/* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $
+/* $RCSfile: str.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:13 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       str.c,v $
+ * Revision 4.0.1.2  91/06/07  11:58:13  lwall
+ * patch4: new copyright notice
+ * patch4: taint check on undefined string could cause core dump
+ * 
  * Revision 4.0.1.1  91/04/12  09:15:30  lwall
  * patch1: fixed undefined environ problem
  * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
@@ -369,11 +373,11 @@ str_scat(dstr,sstr)
 STR *dstr;
 register STR *sstr;
 {
+    if (!sstr)
+       return;
 #ifdef TAINT
     tainted |= sstr->str_tainted;
 #endif
-    if (!sstr)
-       return;
     if (!(sstr->str_pok))
        (void)str_2ptr(sstr);
     if (sstr)
diff --git a/str.h b/str.h
index be04450..15c2c68 100644 (file)
--- a/str.h
+++ b/str.h
@@ -1,11 +1,14 @@
-/* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $
+/* $RCSfile: str.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:33 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       str.h,v $
+ * Revision 4.0.1.2  91/06/07  11:58:33  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0.1.1  91/04/12  09:16:12  lwall
  * patch1: you may now use "die" and "caller" in a signal handler
  * 
index 8ba8e54..92da97a 100644 (file)
@@ -1,11 +1,13 @@
 #!./perl
 
-# $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $
+# $RCSfile: stat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:02:42 $
 
 print "1..56\n";
 
 chop($cwd = `pwd`);
 
+$DEV = `ls -l /dev`;
+
 unlink "Op.stat.tmp";
 open(foo, ">Op.stat.tmp");
 
@@ -81,16 +83,25 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
 `rm -f Op.stat.tmp Op.stat.tmp2`;
 if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
 
-if (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
+if ($DEV !~ /\nc.* (\S+)\n/)
+    {print "ok 29\n";}
+elsif (-c "/dev/$1")
+    {print "ok 29\n";}
+else
+    {print "not ok 29\n";}
 if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
 
-if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
+if ($DEV !~ /\ns.* (\S+)\n/)
+    {print "ok 31\n";}
+elsif (-S "/dev/$1")
     {print "ok 31\n";}
 else
     {print "not ok 31\n";}
 if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
 
-if (! -e '/dev/mt0' || -b '/dev/mt0')
+if ($DEV !~ /\nb.* (\S+)\n/)
+    {print "ok 33\n";}
+elsif (-b "/dev/$1")
     {print "ok 33\n";}
 else
     {print "not ok 33\n";}
diff --git a/toke.c b/toke.c
index 29ee126..4411284 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,11 +1,17 @@
-/* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:05:56 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       toke.c,v $
+ * Revision 4.0.1.2  91/06/07  12:05:56  lwall
+ * patch4: new copyright notice
+ * patch4: debugger lost track of lines in eval
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * 
  * Revision 4.0.1.1  91/04/12  09:18:18  lwall
  * patch1: perl -de "print" wouldn't stop at the first statement
  * 
 #include <sys/file.h>
 #endif
 
+#ifdef f_next
+#undef f_next
+#endif
+
 /* which backslash sequences to keep in m// or s// */
 
 static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}";
@@ -326,13 +336,6 @@ yylex()
                s++;
            if (s < d)
                s++;
-           if (perldb) {
-               STR *str = Str_new(85,0);
-
-               str_nset(str,linestr->str_ptr, s - linestr->str_ptr);
-               astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
-               str_chop(linestr, s);
-           }
            if (in_format) {
                bufptr = s;
                yylval.formval = load_format();
@@ -947,7 +950,7 @@ yylex()
        if (strEQ(d,"oct"))
            UNI(O_OCT);
        if (strEQ(d,"opendir"))
-           FOP2(O_OPENDIR);
+           FOP2(O_OPEN_DIR);
        break;
     case 'p': case 'P':
        SNARFWORD;
@@ -1417,7 +1420,8 @@ char *dest;
 }
 
 STR *
-scanconst(string,len)
+scanconst(spat,string,len)
+SPAT *spat;
 char *string;
 int len;
 {
@@ -1425,10 +1429,13 @@ int len;
     register char *t;
     register char *d;
     register char *e;
+    char *origstring = string;
+    static char *vert = "|";
 
-    if (index(string,'|')) {
+    if (ninstr(string, string+len, vert, vert+1))
        return Nullstr;
-    }
+    if (*string == '^')
+       string++, len--;
     retstr = Str_new(86,len);
     str_nset(retstr,string,len);
     t = str_get(retstr);
@@ -1488,6 +1495,12 @@ int len;
     }
     *d = '\0';
     retstr->str_cur = d - t;
+    if (d == t+len)
+       spat->spat_flags |= SPAT_ALL;
+    if (*origstring != '^')
+       spat->spat_flags |= SPAT_SCANFIRST;
+    spat->spat_short = retstr;
+    spat->spat_slen = d - t;
     return retstr;
 }
 
@@ -1526,7 +1539,7 @@ register char *s;
        return s;
     }
     s++;
-    while (*s == 'i' || *s == 'o') {
+    while (*s == 'i' || *s == 'o' || *s == 'g') {
        if (*s == 'i') {
            s++;
            sawi = TRUE;
@@ -1536,6 +1549,10 @@ register char *s;
            s++;
            spat->spat_flags |= SPAT_KEEP;
        }
+       if (*s == 'g') {
+           s++;
+           spat->spat_flags |= SPAT_GLOBAL;
+       }
     }
     len = str->str_cur;
     e = str->str_ptr + len;
@@ -1575,23 +1592,7 @@ register char *s;
 #else
        (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
 #endif
-    if (*str->str_ptr == '^') {
-       spat->spat_short = scanconst(str->str_ptr+1,len-1);
-       if (spat->spat_short) {
-           spat->spat_slen = spat->spat_short->str_cur;
-           if (spat->spat_slen == len - 1)
-               spat->spat_flags |= SPAT_ALL;
-       }
-    }
-    else {
-       spat->spat_flags |= SPAT_SCANFIRST;
-       spat->spat_short = scanconst(str->str_ptr,len);
-       if (spat->spat_short) {
-           spat->spat_slen = spat->spat_short->str_cur;
-           if (spat->spat_slen == len)
-               spat->spat_flags |= SPAT_ALL;
-       }
-    }  
+    scanconst(spat,str->str_ptr,len);
     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
        fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
        spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
@@ -1670,17 +1671,7 @@ register char *s;
            goto get_repl;              /* skip compiling for now */
        }
     }
-    if (*str->str_ptr == '^') {
-       spat->spat_short = scanconst(str->str_ptr+1,len-1);
-       if (spat->spat_short)
-           spat->spat_slen = spat->spat_short->str_cur;
-    }
-    else {
-       spat->spat_flags |= SPAT_SCANFIRST;
-       spat->spat_short = scanconst(str->str_ptr,len);
-       if (spat->spat_short)
-           spat->spat_slen = spat->spat_short->str_cur;
-    }
+    scanconst(spat,str->str_ptr,len);
 get_repl:
     s = scanstr(s);
     if (s >= bufend) {
@@ -1690,7 +1681,6 @@ get_repl:
        return s;
     }
     spat->spat_repl = yylval.arg;
-    spat->spat_flags |= SPAT_ONCE;
     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
        spat->spat_flags |= SPAT_CONST;
     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
@@ -1719,7 +1709,7 @@ get_repl:
        }
        if (*s == 'g') {
            s++;
-           spat->spat_flags &= ~SPAT_ONCE;
+           spat->spat_flags |= SPAT_GLOBAL;
        }
        if (*s == 'i') {
            s++;
@@ -1751,7 +1741,14 @@ get_repl:
 hoistmust(spat)
 register SPAT *spat;
 {
-    if (spat->spat_regexp->regmust) {  /* is there a better short-circuit? */
+    if (!spat->spat_short && spat->spat_regexp->regstart &&
+       (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
+       ) {
+       spat->spat_short = spat->spat_regexp->regstart;
+       if (!(spat->spat_regexp->reganch & ROPT_ANCH))
+           spat->spat_flags |= SPAT_SCANFIRST;
+    }
+    else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
        if (spat->spat_short &&
          str_eq(spat->spat_short,spat->spat_regexp->regmust))
        {
@@ -2119,6 +2116,7 @@ register char *s;
            STR *tmpstr;
            char *tmps;
 
+           CLINE;
            multi_start = curcmd->c_line;
            if (hereis)
                multi_open = multi_close = '<';
diff --git a/util.c b/util.c
index 6947371..af1a2b7 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,11 +1,18 @@
-/* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $
+/* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.c,v $
+ * Revision 4.0.1.2  91/06/07  12:10:42  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * patch4: index() could blow up searching for null string
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: exec would close files even if you cleared close-on-exec flag
+ * 
  * Revision 4.0.1.1  91/04/12  09:19:25  lwall
  * patch1: random cleanup in cpp namespace
  * 
@@ -60,9 +67,9 @@ MEM_SIZE size;
 #endif /* MSDOS */
 {
     char *ptr;
-#ifndef __STDC__
+#ifndef STANDARD_C
     char *malloc();
-#endif /* ! __STDC__ */
+#endif /* ! STANDARD_C */
 
 #ifdef MSDOS
        if (size > 0xffff) {
@@ -108,9 +115,9 @@ unsigned long size;
 #endif /* MSDOS */
 {
     char *ptr;
-#ifndef __STDC__
+#ifndef STANDARD_C
     char *realloc();
-#endif /* ! __STDC__ */
+#endif /* ! STANDARD_C */
 
 #ifdef MSDOS
        if (size > 0xffff) {
@@ -514,9 +521,12 @@ STR *littlestr;
     register unsigned char *oldlittle;
 
 #ifndef lint
-    if (!(littlestr->str_pok & SP_FBM))
+    if (!(littlestr->str_pok & SP_FBM)) {
+       if (!littlestr->str_ptr)
+           return (char*)big;
        return ninstr((char*)big,(char*)bigend,
                littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
+    }
 #endif
 
     littlelen = littlestr->str_cur;
@@ -851,10 +861,12 @@ va_list args;
 {
     char *pat;
     char *s;
+#ifndef HAS_VPRINTF
 #ifdef CHARVSPRINTF
     char *vsprintf();
 #else
     int vsprintf();
+#endif
 #endif
 
     s = buf;
@@ -1196,6 +1208,12 @@ char     *mode;
        return Nullfp;
     this = (*mode == 'w');
     that = !this;
+#ifdef TAINT
+    if (doexec) {
+       taintenv();
+       taintproper("Insecure dependency in exec");
+    }
+#endif
     while ((pid = (doexec?vfork():fork())) < 0) {
        if (errno != EAGAIN) {
            close(p[this]);
@@ -1214,13 +1232,13 @@ char    *mode;
            close(p[THIS]);
        }
        if (doexec) {
-#if !defined(I_FCNTL) || !defined(F_SETFD)
+#if !defined(HAS_FCNTL) || !defined(F_SETFD)
            int fd;
 
 #ifndef NOFILE
 #define NOFILE 20
 #endif
-           for (fd = 3; fd < NOFILE; fd++)
+           for (fd = maxsysfd + 1; fd < NOFILE; fd++)
                close(fd);
 #endif
            do_exec(cmd);       /* may or may not use the shell */
@@ -1273,7 +1291,7 @@ int newfd;
     close(newfd);
     fcntl(oldfd, F_DUPFD, newfd);
 #else
-    int fdtmp[20];
+    int fdtmp[256];
     int fdx = 0;
     int fd;
 
diff --git a/util.h b/util.h
index 3b077ab..8d013ff 100644 (file)
--- a/util.h
+++ b/util.h
@@ -1,11 +1,14 @@
-/* $Header: util.h,v 4.0 91/03/20 01:56:48 lwall Locked $
+/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:11:00 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.h,v $
+ * Revision 4.0.1.1  91/06/07  12:11:00  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:56:48  lwall
  * 4.0 baseline.
  * 
index 82b1423..f4a1c66 100644 (file)
@@ -19,9 +19,12 @@ case "$mallocsrc" in
 esac
 echo "Extracting x2p/Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 4.0 91/03/20 01:57:03 lwall Locked $
+# $RCSfile: Makefile.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:14 $
 #
 # $Log:        Makefile.SH,v $
+# Revision 4.0.1.1  91/06/07  12:12:14  lwall
+# patch4: cflags now emits entire cc command except for the filename
+# 
 # Revision 4.0  91/03/20  01:57:03  lwall
 # 4.0 baseline.
 # 
@@ -33,7 +36,6 @@ bin = $bin
 lib = $lib
 mansrc = $mansrc
 manext = $manext
-CFLAGS = $ccflags $optimize
 LDFLAGS = $ldflags
 SMALL = $small
 LARGE = $large $split
@@ -45,6 +47,8 @@ libs = $libs
 
 cat >>Makefile <<'!NO!SUBS!'
 
+CCCMD = `sh cflags $@`
+
 public = a2p s2p find2perl
 
 private = 
@@ -69,13 +73,13 @@ addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
 SHELL = /bin/sh
 
 .c.o:
-       $(CC) -c $(CFLAGS) $(LARGE) $*.c
+       $(CCCMD) $*.c
 
 all: $(public) $(private) $(util)
        touch all
 
 a2p: $(obj) a2p.o
-       $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
+       $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
 
 a2p.c: a2p.y
        @ echo Expect 226 shift/reduce conflicts...
@@ -83,7 +87,7 @@ a2p.c: a2p.y
        mv y.tab.c a2p.c
 
 a2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
-       $(CC) -c $(CFLAGS) $(LARGE) a2p.c
+       $(CCCMD) $(LARGE) a2p.c
 
 install: a2p s2p
 # won't work with csh
@@ -95,16 +99,6 @@ install: a2p s2p
 for pub in $(public); do \
 chmod +x `basename $$pub`; \
 done
-#      chmod +x makedir
-#      - ./makedir `filexp $(lib)`
-#      - \
-#if test `pwd` != `filexp $(lib)`; then \
-#cp $(private) `filexp $(lib)`; \
-#fi
-#      cd `filexp $(lib)`; \
-#for priv in $(private); do \
-#chmod +x `basename $$priv`; \
-#done
        - if test `pwd` != $(mansrc); then \
 for page in $(manpages); do \
 cp $$page $(mansrc)/`basename $$page .man`.$(manext); \
@@ -115,7 +109,7 @@ clean:
        rm -f a2p *.o
 
 realclean: clean
-       rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all
+       rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p find2perl all cflags
 
 # The following lint has practically everything turned on.  Unfortunately,
 # you have to wade through a lot of mumbo jumbo that can't be suppressed.
index f928b77..5c25050 100644 (file)
--- a/x2p/str.c
+++ b/x2p/str.c
@@ -1,11 +1,14 @@
-/* $Header: str.c,v 4.0 91/03/20 01:58:15 lwall Locked $
+/* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:08 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       str.c,v $
+ * Revision 4.0.1.1  91/06/07  12:20:08  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:58:15  lwall
  * 4.0 baseline.
  * 
index 62c44a0..96d164d 100644 (file)
--- a/x2p/str.h
+++ b/x2p/str.h
@@ -1,11 +1,14 @@
-/* $Header: str.h,v 4.0 91/03/20 01:58:21 lwall Locked $
+/* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:22 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       str.h,v $
+ * Revision 4.0.1.1  91/06/07  12:20:22  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:58:21  lwall
  * 4.0 baseline.
  * 
index d1ba317..7c2485a 100644 (file)
@@ -1,11 +1,14 @@
-/* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $
+/* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:35 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.c,v $
+ * Revision 4.0.1.1  91/06/07  12:20:35  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:58:25  lwall
  * 4.0 baseline.
  * 
index d682ee1..f8a686b 100644 (file)
@@ -1,11 +1,14 @@
-/* $Header: util.h,v 4.0 91/03/20 01:58:29 lwall Locked $
+/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:43 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.h,v $
+ * Revision 4.0.1.1  91/06/07  12:20:43  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:58:29  lwall
  * 4.0 baseline.
  * 
index 3dd4a1a..f38968b 100644 (file)
@@ -1,11 +1,15 @@
-/* $Header: walk.c,v 4.0 91/03/20 01:58:36 lwall Locked $
+/* $RCSfile: walk.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:22:04 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       walk.c,v $
+ * Revision 4.0.1.1  91/06/07  12:22:04  lwall
+ * patch4: new copyright notice
+ * patch4: a2p didn't correctly implement -n switch
+ * 
  * Revision 4.0  91/03/20  01:58:36  lwall
  * 4.0 baseline.
  * 
@@ -22,6 +26,7 @@ bool saw_getline = FALSE;
 bool subretnum = FALSE;
 bool saw_FNR = FALSE;
 bool saw_argv0 = FALSE;
+bool saw_fh = FALSE;
 int maxtmp = 0;
 char *lparen;
 char *rparen;
@@ -60,6 +65,20 @@ int minprec;                 /* minimum precedence without parens */
     type &= 255;
     switch (type) {
     case OPROG:
+       arymax = 0;
+       if (namelist) {
+           while (isalpha(*namelist)) {
+               for (d = tokenbuf,s=namelist;
+                 isalpha(*s) || isdigit(*s) || *s == '_';
+                 *d++ = *s++) ;
+               *d = '\0';
+               while (*s && !isalpha(*s)) s++;
+               namelist = s;
+               nameary[++arymax] = savestr(tokenbuf);
+           }
+       }
+       if (maxfld < arymax)
+           maxfld = arymax;
        opens = str_new(0);
        subs = str_new(0);
        str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
@@ -115,20 +134,6 @@ int minprec;                       /* minimum precedence without parens */
                str_cat(str,"chop;\t# strip record separator\n");
                tab(str,level);
            }
-           arymax = 0;
-           if (namelist) {
-               while (isalpha(*namelist)) {
-                   for (d = tokenbuf,s=namelist;
-                     isalpha(*s) || isdigit(*s) || *s == '_';
-                     *d++ = *s++) ;
-                   *d = '\0';
-                   while (*s && !isalpha(*s)) s++;
-                   namelist = s;
-                   nameary[++arymax] = savestr(tokenbuf);
-               }
-           }
-           if (maxfld < arymax)
-               maxfld = arymax;
            if (do_split)
                emit_split(str,level);
            str_scat(str,fstr);
@@ -584,11 +589,13 @@ sub Pick {\n\
                s = savestr(tokenbuf);
                for (t = tokenbuf; *t; t++) {
                    *t &= 127;
+                   if (islower(*t))
+                       *t = toupper(*t);
                    if (!isalpha(*t) && !isdigit(*t))
                        *t = '_';
                }
                if (!index(tokenbuf,'_'))
-                   strcpy(t,"_fh");
+                   strcpy(t,"_FH");
                tmp3str = hfetch(symtab,tokenbuf);
                if (!tmp3str) {
                    do_opens = TRUE;
@@ -1110,11 +1117,13 @@ sub Pick {\n\
            s = savestr(tokenbuf);
            for (t = tokenbuf; *t; t++) {
                *t &= 127;
+               if (islower(*t))
+                   *t = toupper(*t);
                if (!isalpha(*t) && !isdigit(*t))
                    *t = '_';
            }
            if (!index(tokenbuf,'_'))
-               strcpy(t,"_fh");
+               strcpy(t,"_FH");
            str_free(tmpstr);
            safefree(s);
            str_set(str,"close ");
@@ -1145,11 +1154,13 @@ sub Pick {\n\
                s = savestr(tokenbuf);
                for (t = tokenbuf; *t; t++) {
                    *t &= 127;
+                   if (islower(*t))
+                       *t = toupper(*t);
                    if (!isalpha(*t) && !isdigit(*t))
                        *t = '_';
                }
                if (!index(tokenbuf,'_'))
-                   strcpy(t,"_fh");
+                   strcpy(t,"_FH");
                tmp3str = hfetch(symtab,tokenbuf);
                if (!tmp3str) {
                    str_cat(opens,"open(");
@@ -1195,9 +1206,12 @@ sub Pick {\n\
            str_cat(str,"printf");
        else
            str_cat(str,"print");
+       saw_fh = 0;
        if (len == 3 || do_fancy_opens) {
-           if (*tokenbuf)
+           if (*tokenbuf) {
                str_cat(str," ");
+               saw_fh = 1;
+           }
            str_cat(str,tokenbuf);
        }
        tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
@@ -1224,7 +1238,13 @@ sub Pick {\n\
        }
        if (*tmpstr->str_ptr) {
            str_cat(str," ");
-           str_scat(str,tmpstr);
+           if (!saw_fh && *tmpstr->str_ptr == '(') {
+               str_cat(str,"(");
+               str_scat(str,tmpstr);
+               str_cat(str,")");
+           }
+           else
+               str_scat(str,tmpstr);
        }
        else {
            str_cat(str," $_");