v20i061: perl - The perl programming language, Patch09
Larry Wall
lwall at netlabs.com
Thu Jun 20 13:08:04 AEST 1991
Submitted-by: Larry Wall <lwall at netlabs.com>
Posting-number: Volume 20, Issue 61
Archive-name: perl/patch09
Patch-To: perl: Volume 18, Issue 19-54
System: perl version 4.0
Patch #: 9
Priority: High
Subject: patch #4, continued
Description:
See patch #4.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
Configure -d
make depend
make
make test
make install
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at netlabs.com
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 4.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
Index: patchlevel.h
Prereq: 8
1c1
< #define PATCHLEVEL 8
---
> #define PATCHLEVEL 9
Index: stab.h
Prereq: 4.0
*** stab.h.old Fri Jun 7 12:26:50 1991
--- stab.h Fri Jun 7 12:26:51 1991
***************
*** 1,11 ****
! /* $Header: stab.h,v 4.0 91/03/20 01:39:49 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: stab.h,v $
* Revision 4.0 91/03/20 01:39:49 lwall
* 4.0 baseline.
*
--- 1,15 ----
! /* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,99 ****
--- 97,106 ----
#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)))
Index: t/op/stat.t
Prereq: 4.0
*** t/op/stat.t.old Fri Jun 7 12:27:11 1991
--- t/op/stat.t Fri Jun 7 12:27:12 1991
***************
*** 1,11 ****
#!./perl
! # $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $
print "1..56\n";
chop($cwd = `pwd`);
unlink "Op.stat.tmp";
open(foo, ">Op.stat.tmp");
--- 1,13 ----
#!./perl
! # $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,96 ****
`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 (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
! if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
{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')
{print "ok 33\n";}
else
{print "not ok 33\n";}
--- 83,107 ----
`rm -f Op.stat.tmp Op.stat.tmp2`;
if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\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 ($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 ($DEV !~ /\nb.* (\S+)\n/)
! {print "ok 33\n";}
! elsif (-b "/dev/$1")
{print "ok 33\n";}
else
{print "not ok 33\n";}
Index: str.c
*** str.c.old Fri Jun 7 12:26:55 1991
--- str.c Fri Jun 7 12:26:56 1991
***************
*** 1,11 ****
! /* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $
*
! * Copyright (c) 1989, 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.
*
* $Log: str.c,v $
* 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
--- 1,15 ----
! /* $RCSfile: str.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:13 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,379 ****
STR *dstr;
register STR *sstr;
{
#ifdef TAINT
tainted |= sstr->str_tainted;
#endif
- if (!sstr)
- return;
if (!(sstr->str_pok))
(void)str_2ptr(sstr);
if (sstr)
--- 373,383 ----
STR *dstr;
register STR *sstr;
{
+ if (!sstr)
+ return;
#ifdef TAINT
tainted |= sstr->str_tainted;
#endif
if (!(sstr->str_pok))
(void)str_2ptr(sstr);
if (sstr)
Index: x2p/str.c
Prereq: 4.0
*** x2p/str.c.old Fri Jun 7 12:28:17 1991
--- x2p/str.c Fri Jun 7 12:28:17 1991
***************
*** 1,11 ****
! /* $Header: str.c,v 4.0 91/03/20 01:58:15 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: str.c,v $
* Revision 4.0 91/03/20 01:58:15 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:08 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: str.h
*** str.h.old Fri Jun 7 12:26:59 1991
--- str.h Fri Jun 7 12:27:01 1991
***************
*** 1,11 ****
! /* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $
*
! * Copyright (c) 1989, 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.
*
* $Log: str.h,v $
* Revision 4.0.1.1 91/04/12 09:16:12 lwall
* patch1: you may now use "die" and "caller" in a signal handler
*
--- 1,14 ----
! /* $RCSfile: str.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:33 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: x2p/str.h
Prereq: 4.0
*** x2p/str.h.old Fri Jun 7 12:28:20 1991
--- x2p/str.h Fri Jun 7 12:28:20 1991
***************
*** 1,11 ****
! /* $Header: str.h,v 4.0 91/03/20 01:58:21 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: str.h,v $
* Revision 4.0 91/03/20 01:58:21 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:22 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: hints/sunos_4_0_1.sh
*** hints/sunos_4_0_1.sh.old Fri Jun 7 12:24:51 1991
--- hints/sunos_4_0_1.sh Fri Jun 7 12:24:51 1991
***************
*** 1,4 ****
! 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
--- 1 ----
! $ccflags="$ccflags -DFPUTS_BOTCH"
Index: hints/sunos_4_0_2.sh
*** hints/sunos_4_0_2.sh.old Fri Jun 7 12:24:53 1991
--- hints/sunos_4_0_2.sh Fri Jun 7 12:24:54 1991
***************
*** 1,4 ****
! 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
--- 1 ----
! $ccflags="$ccflags -DFPUTS_BOTCH"
Index: hints/svr4.sh
*** hints/svr4.sh.old Fri Jun 7 12:24:56 1991
--- hints/svr4.sh Fri Jun 7 12:24:57 1991
***************
*** 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: toke.c
*** toke.c.old Fri Jun 7 12:27:17 1991
--- toke.c Fri Jun 7 12:27:19 1991
***************
*** 1,11 ****
! /* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $
*
! * Copyright (c) 1989, 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.
*
* $Log: toke.c,v $
* Revision 4.0.1.1 91/04/12 09:18:18 lwall
* patch1: perl -de "print" wouldn't stop at the first statement
*
--- 1,17 ----
! /* $RCSfile: toke.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:05:56 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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
*
***************
*** 25,30 ****
--- 31,40 ----
#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,338 ****
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();
--- 336,341 ----
***************
*** 947,953 ****
if (strEQ(d,"oct"))
UNI(O_OCT);
if (strEQ(d,"opendir"))
! FOP2(O_OPENDIR);
break;
case 'p': case 'P':
SNARFWORD;
--- 950,956 ----
if (strEQ(d,"oct"))
UNI(O_OCT);
if (strEQ(d,"opendir"))
! FOP2(O_OPEN_DIR);
break;
case 'p': case 'P':
SNARFWORD;
***************
*** 1417,1423 ****
}
STR *
! scanconst(string,len)
char *string;
int len;
{
--- 1420,1427 ----
}
STR *
! scanconst(spat,string,len)
! SPAT *spat;
char *string;
int len;
{
***************
*** 1425,1434 ****
register char *t;
register char *d;
register char *e;
! if (index(string,'|')) {
return Nullstr;
! }
retstr = Str_new(86,len);
str_nset(retstr,string,len);
t = str_get(retstr);
--- 1429,1441 ----
register char *t;
register char *d;
register char *e;
+ char *origstring = string;
+ static char *vert = "|";
! 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,1493 ****
--- 1495,1506 ----
}
*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,1532 ****
return s;
}
s++;
! while (*s == 'i' || *s == 'o') {
if (*s == 'i') {
s++;
sawi = TRUE;
--- 1539,1545 ----
return s;
}
s++;
! while (*s == 'i' || *s == 'o' || *s == 'g') {
if (*s == 'i') {
s++;
sawi = TRUE;
***************
*** 1536,1541 ****
--- 1549,1558 ----
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,1597 ****
#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;
! }
! }
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,
--- 1592,1598 ----
#else
(void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
#endif
! 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,1686 ****
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;
! }
get_repl:
s = scanstr(s);
if (s >= bufend) {
--- 1671,1677 ----
goto get_repl; /* skip compiling for now */
}
}
! scanconst(spat,str->str_ptr,len);
get_repl:
s = scanstr(s);
if (s >= bufend) {
***************
*** 1690,1696 ****
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) {
--- 1681,1686 ----
***************
*** 1719,1725 ****
}
if (*s == 'g') {
s++;
! spat->spat_flags &= ~SPAT_ONCE;
}
if (*s == 'i') {
s++;
--- 1709,1715 ----
}
if (*s == 'g') {
s++;
! spat->spat_flags |= SPAT_GLOBAL;
}
if (*s == 'i') {
s++;
***************
*** 1751,1757 ****
hoistmust(spat)
register SPAT *spat;
{
! if (spat->spat_regexp->regmust) { /* is there a better short-circuit? */
if (spat->spat_short &&
str_eq(spat->spat_short,spat->spat_regexp->regmust))
{
--- 1741,1754 ----
hoistmust(spat)
register SPAT *spat;
{
! 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,2124 ****
--- 2116,2122 ----
STR *tmpstr;
char *tmps;
+ CLINE;
multi_start = curcmd->c_line;
if (hereis)
multi_open = multi_close = '<';
Index: hints/ultrix_3.sh
*** hints/ultrix_3.sh.old Fri Jun 7 12:25:00 1991
--- hints/ultrix_3.sh Fri Jun 7 12:25:00 1991
***************
*** 1,2 ****
ccflags="$ccflags -DLANGUAGE_C"
! d_waitpid=$undef
--- 1,14 ----
ccflags="$ccflags -DLANGUAGE_C"
! 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: hints/ultrix_4.sh
*** hints/ultrix_4.sh.old Fri Jun 7 12:25:02 1991
--- hints/ultrix_4.sh Fri Jun 7 12:25:03 1991
***************
*** 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
+
Index: util.c
*** util.c.old Fri Jun 7 12:27:26 1991
--- util.c Fri Jun 7 12:27:27 1991
***************
*** 1,11 ****
! /* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $
*
! * Copyright (c) 1989, 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.
*
* $Log: util.c,v $
* Revision 4.0.1.1 91/04/12 09:19:25 lwall
* patch1: random cleanup in cpp namespace
*
--- 1,18 ----
! /* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,68 ****
#endif /* MSDOS */
{
char *ptr;
! #ifndef __STDC__
char *malloc();
! #endif /* ! __STDC__ */
#ifdef MSDOS
if (size > 0xffff) {
--- 67,75 ----
#endif /* MSDOS */
{
char *ptr;
! #ifndef STANDARD_C
char *malloc();
! #endif /* ! STANDARD_C */
#ifdef MSDOS
if (size > 0xffff) {
***************
*** 108,116 ****
#endif /* MSDOS */
{
char *ptr;
! #ifndef __STDC__
char *realloc();
! #endif /* ! __STDC__ */
#ifdef MSDOS
if (size > 0xffff) {
--- 115,123 ----
#endif /* MSDOS */
{
char *ptr;
! #ifndef STANDARD_C
char *realloc();
! #endif /* ! STANDARD_C */
#ifdef MSDOS
if (size > 0xffff) {
***************
*** 514,522 ****
register unsigned char *oldlittle;
#ifndef lint
! if (!(littlestr->str_pok & SP_FBM))
return ninstr((char*)big,(char*)bigend,
littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
#endif
littlelen = littlestr->str_cur;
--- 521,532 ----
register unsigned char *oldlittle;
#ifndef lint
! 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,861 ****
--- 861,873 ----
{
char *pat;
char *s;
+ #ifndef HAS_VPRINTF
#ifdef CHARVSPRINTF
char *vsprintf();
#else
int vsprintf();
#endif
+ #endif
s = buf;
#ifdef lint
***************
*** 1196,1201 ****
--- 1208,1219 ----
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,1226 ****
close(p[THIS]);
}
if (doexec) {
! #if !defined(I_FCNTL) || !defined(F_SETFD)
int fd;
#ifndef NOFILE
#define NOFILE 20
#endif
! for (fd = 3; fd < NOFILE; fd++)
close(fd);
#endif
do_exec(cmd); /* may or may not use the shell */
--- 1232,1244 ----
close(p[THIS]);
}
if (doexec) {
! #if !defined(HAS_FCNTL) || !defined(F_SETFD)
int fd;
#ifndef NOFILE
#define NOFILE 20
#endif
! for (fd = maxsysfd + 1; fd < NOFILE; fd++)
close(fd);
#endif
do_exec(cmd); /* may or may not use the shell */
***************
*** 1273,1279 ****
close(newfd);
fcntl(oldfd, F_DUPFD, newfd);
#else
! int fdtmp[20];
int fdx = 0;
int fd;
--- 1291,1297 ----
close(newfd);
fcntl(oldfd, F_DUPFD, newfd);
#else
! int fdtmp[256];
int fdx = 0;
int fd;
Index: x2p/util.c
Prereq: 4.0
*** x2p/util.c.old Fri Jun 7 12:28:22 1991
--- x2p/util.c Fri Jun 7 12:28:23 1991
***************
*** 1,11 ****
! /* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: util.c,v $
* Revision 4.0 91/03/20 01:58:25 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:35 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: util.h
Prereq: 4.0
*** util.h.old Fri Jun 7 12:27:31 1991
--- util.h Fri Jun 7 12:27:32 1991
***************
*** 1,11 ****
! /* $Header: util.h,v 4.0 91/03/20 01:56:48 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: util.h,v $
* Revision 4.0 91/03/20 01:56:48 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:11:00 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: x2p/util.h
Prereq: 4.0
*** x2p/util.h.old Fri Jun 7 12:28:25 1991
--- x2p/util.h Fri Jun 7 12:28:26 1991
***************
*** 1,11 ****
! /* $Header: util.h,v 4.0 91/03/20 01:58:29 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: util.h,v $
* Revision 4.0 91/03/20 01:58:29 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:43 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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: hints/vax.sh
*** hints/vax.sh.old Fri Jun 7 12:25:04 1991
--- hints/vax.sh Fri Jun 7 12:25:05 1991
***************
*** 0 ****
--- 1 ----
+ teval_cflags='case $cc in *gcc);; *) optimize="-O";; esac'
Index: x2p/walk.c
Prereq: 4.0
*** x2p/walk.c.old Fri Jun 7 12:28:29 1991
--- x2p/walk.c Fri Jun 7 12:28:30 1991
***************
*** 1,11 ****
! /* $Header: walk.c,v 4.0 91/03/20 01:58:36 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: walk.c,v $
* Revision 4.0 91/03/20 01:58:36 lwall
* 4.0 baseline.
*
--- 1,15 ----
! /* $RCSfile: walk.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:22:04 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,27 ****
--- 26,32 ----
bool subretnum = FALSE;
bool saw_FNR = FALSE;
bool saw_argv0 = FALSE;
+ bool saw_fh = FALSE;
int maxtmp = 0;
char *lparen;
char *rparen;
***************
*** 60,65 ****
--- 65,84 ----
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,134 ****
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);
--- 134,139 ----
***************
*** 584,594 ****
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
! strcpy(t,"_fh");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
do_opens = TRUE;
--- 589,601 ----
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");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
do_opens = TRUE;
***************
*** 1110,1120 ****
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
! strcpy(t,"_fh");
str_free(tmpstr);
safefree(s);
str_set(str,"close ");
--- 1117,1129 ----
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");
str_free(tmpstr);
safefree(s);
str_set(str,"close ");
***************
*** 1145,1155 ****
s = savestr(tokenbuf);
for (t = tokenbuf; *t; t++) {
*t &= 127;
if (!isalpha(*t) && !isdigit(*t))
*t = '_';
}
if (!index(tokenbuf,'_'))
! strcpy(t,"_fh");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
str_cat(opens,"open(");
--- 1154,1166 ----
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");
tmp3str = hfetch(symtab,tokenbuf);
if (!tmp3str) {
str_cat(opens,"open(");
***************
*** 1195,1203 ****
str_cat(str,"printf");
else
str_cat(str,"print");
if (len == 3 || do_fancy_opens) {
! if (*tokenbuf)
str_cat(str," ");
str_cat(str,tokenbuf);
}
tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
--- 1206,1217 ----
str_cat(str,"printf");
else
str_cat(str,"print");
+ saw_fh = 0;
if (len == 3 || do_fancy_opens) {
! 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,1230 ****
}
if (*tmpstr->str_ptr) {
str_cat(str," ");
! str_scat(str,tmpstr);
}
else {
str_cat(str," $_");
--- 1238,1250 ----
}
if (*tmpstr->str_ptr) {
str_cat(str," ");
! 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," $_");
Index: x2p/Makefile.SH
Prereq: 4.0
*** x2p/Makefile.SH.old Fri Jun 7 12:27:40 1991
--- x2p/Makefile.SH Fri Jun 7 12:27:41 1991
***************
*** 19,27 ****
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 $
#
# $Log: Makefile.SH,v $
# Revision 4.0 91/03/20 01:57:03 lwall
# 4.0 baseline.
#
--- 19,30 ----
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $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,39 ****
lib = $lib
mansrc = $mansrc
manext = $manext
- CFLAGS = $ccflags $optimize
LDFLAGS = $ldflags
SMALL = $small
LARGE = $large $split
--- 36,41 ----
***************
*** 45,50 ****
--- 47,54 ----
cat >>Makefile <<'!NO!SUBS!'
+ CCCMD = `sh cflags $@`
+
public = a2p s2p find2perl
private =
***************
*** 69,81 ****
SHELL = /bin/sh
.c.o:
! $(CC) -c $(CFLAGS) $(LARGE) $*.c
all: $(public) $(private) $(util)
touch all
a2p: $(obj) a2p.o
! $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
a2p.c: a2p.y
@ echo Expect 226 shift/reduce conflicts...
--- 73,85 ----
SHELL = /bin/sh
.c.o:
! $(CCCMD) $*.c
all: $(public) $(private) $(util)
touch all
a2p: $(obj) a2p.o
! $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
a2p.c: a2p.y
@ echo Expect 226 shift/reduce conflicts...
***************
*** 83,89 ****
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
install: a2p s2p
# won't work with csh
--- 87,93 ----
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
! $(CCCMD) $(LARGE) a2p.c
install: a2p s2p
# won't work with csh
***************
*** 95,110 ****
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); \
--- 99,104 ----
***************
*** 115,121 ****
rm -f a2p *.o
realclean: clean
! rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all
# The following lint has practically everything turned on. Unfortunately,
# you have to wade through a lot of mumbo jumbo that can't be suppressed.
--- 109,115 ----
rm -f a2p *.o
realclean: clean
! 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: README
*** README.old Fri Jun 7 12:22:37 1991
--- README Fri Jun 7 12:22:38 1991
***************
*** 2,27 ****
Perl Kit, Version 4.0
Copyright (c) 1989,1990,1991, Larry Wall
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.
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.
! You should 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
object code linked with uperl.o does not automatically fall under the
! terms of the License, 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
--- 2,36 ----
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 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 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 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.
! 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 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
***************
*** 31,46 ****
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
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.
--------------------------------------------------------------------------
Perl is a language that combines some of the features of C, sed, awk and shell.
! See the manual page for more hype.
Perl will probably not run on machines with a small address space.
--- 40,58 ----
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 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 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. 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 at ora.com.
Perl will probably not run on machines with a small address space.
***************
*** 107,113 ****
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 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.
--- 119,125 ----
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 -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.
***************
*** 114,119 ****
--- 126,132 ----
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,170 ****
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.
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
--- 177,184 ----
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. 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
*** End of Patch 9 ***
--
Kent Landfield INTERNET: kent at sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent at uunet.uu.net.
More information about the Comp.sources.misc
mailing list