v20i058: perl - The perl programming language, Patch06
Larry Wall
lwall at netlabs.com
Thu Jun 20 13:05:16 AEST 1991
Submitted-by: Larry Wall <lwall at netlabs.com>
Posting-number: Volume 20, Issue 58
Archive-name: perl/patch06
Patch-To: perl: Volume 18, Issue 19-54
System: perl version 4.0
Patch #: 6
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:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #09 FIRST ***
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: 5
1c1
< #define PATCHLEVEL 5
---
> #define PATCHLEVEL 6
Index: msdos/dir.h
Prereq: 4.0
*** msdos/dir.h.old Fri Jun 7 12:25:39 1991
--- msdos/dir.h Fri Jun 7 12:25:40 1991
***************
*** 1,11 ****
! /* $Header: dir.h,v 4.0 91/03/20 01:34:20 lwall Locked $
*
* (C) Copyright 1987, 1990 Diomidis Spinellis.
*
! * 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: dir.h,v $
* Revision 4.0 91/03/20 01:34:20 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: dir.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:10 $
*
* (C) Copyright 1987, 1990 Diomidis Spinellis.
*
! * You may distribute under the terms of either the GNU General Public
! * License or the Artistic License, as specified in the README file.
*
* $Log: dir.h,v $
+ * Revision 4.0.1.1 91/06/07 11:22:10 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:34:20 lwall
* 4.0 baseline.
*
Index: msdos/directory.c
Prereq: 4.0
*** msdos/directory.c.old Fri Jun 7 12:25:42 1991
--- msdos/directory.c Fri Jun 7 12:25:42 1991
***************
*** 1,11 ****
! /* $Header: directory.c,v 4.0 91/03/20 01:34:24 lwall Locked $
*
* (C) Copyright 1987, 1988, 1990 Diomidis Spinellis.
*
! * 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: directory.c,v $
* Revision 4.0 91/03/20 01:34:24 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: directory.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:24 $
*
* (C) Copyright 1987, 1988, 1990 Diomidis Spinellis.
*
! * You may distribute under the terms of either the GNU General Public
! * License or the Artistic License, as specified in the README file.
*
* $Log: directory.c,v $
+ * Revision 4.0.1.1 91/06/07 11:22:24 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:34:24 lwall
* 4.0 baseline.
*
***************
*** 44,50 ****
#define PATHLEN 65
#ifndef lint
! static char rcsid[] = "$Header: directory.c,v 4.0 91/03/20 01:34:24 lwall Locked $";
#endif
DIR *
--- 47,53 ----
#define PATHLEN 65
#ifndef lint
! static char rcsid[] = "$RCSfile: directory.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:24 $";
#endif
DIR *
Index: doSH
*** doSH.old Fri Jun 7 12:23:19 1991
--- doSH Fri Jun 7 12:23:20 1991
***************
*** 0 ****
--- 1,36 ----
+ #!/bin/sh
+
+ : if this fails, just run all the .SH files by hand
+ . ./config.sh
+
+ echo " "
+ echo "Doing variable substitutions on .SH files..."
+ set x `awk '{print $1}' <MANIFEST | grep '\.SH'`
+ shift
+ case $# in
+ 0) set x *.SH; shift;;
+ esac
+ if test ! -f $1; then
+ shift
+ fi
+ for file in $*; do
+ set X
+ shift
+ chmod +x $file
+ case "$file" in
+ */*)
+ dir=`expr X$file : 'X\(.*\)/'`
+ file=`expr X$file : 'X.*/\(.*\)'`
+ (cd $dir && . $file)
+ ;;
+ *)
+ . $file
+ ;;
+ esac
+ done
+ if test -f config.h.SH; then
+ if test ! -f config.h; then
+ : oops, they left it out of MANIFEST, probably, so do it anyway.
+ . config.h.SH
+ fi
+ fi
Index: doarg.c
*** doarg.c.old Fri Jun 7 12:23:23 1991
--- doarg.c Fri Jun 7 12:23:24 1991
***************
*** 1,11 ****
! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:40:14 $
*
! * 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: doarg.c,v $
* Revision 4.0.1.1 91/04/11 17:40:14 lwall
* patch1: fixed undefined environ problem
* patch1: fixed debugger coredump on subroutines
--- 1,21 ----
! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:42:17 $
*
! * 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: doarg.c,v $
+ * Revision 4.0.1.2 91/06/07 10:42:17 lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * patch4: undef @array disabled "@array" interpolation
+ * patch4: chop("") was returning "\0" rather than ""
+ * patch4: vector logical operations &, | and ^ sometimes returned null string
+ * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
+ *
* Revision 4.0.1.1 91/04/11 17:40:14 lwall
* patch1: fixed undefined environ problem
* patch1: fixed debugger coredump on subroutines
***************
*** 67,72 ****
--- 77,88 ----
if (spat->spat_flags & SPAT_KEEP) {
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
+ scanconst(spat, m, dstr->str_cur);
+ hoistmust(spat);
+ if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+ curcmd->c_flags &= ~CF_OPTIMIZE;
+ opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+ }
}
}
#ifdef DEBUGGING
***************
*** 76,82 ****
#endif
safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
!sawampersand);
! if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
orig = m = s;
if (hint) {
--- 92,98 ----
#endif
safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
!sawampersand);
! if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
orig = m = s;
if (hint) {
***************
*** 122,128 ****
spat->spat_short = Nullstr; /* opt is being useless */
}
}
! once = ((rspat->spat_flags & SPAT_ONCE) != 0);
if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
dstr = rspat->spat_repl[1].arg_ptr.arg_str;
--- 138,144 ----
spat->spat_short = Nullstr; /* opt is being useless */
}
}
! once = !(rspat->spat_flags & SPAT_GLOBAL);
if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
dstr = rspat->spat_repl[1].arg_ptr.arg_str;
***************
*** 1287,1293 ****
if (type == O_ARRAY || type == O_LARRAY) {
stab = arg[1].arg_ptr.arg_stab;
afree(stab_xarray(stab));
! stab_xarray(stab) = Null(ARRAY*);
}
else if (type == O_HASH || type == O_LHASH) {
stab = arg[1].arg_ptr.arg_stab;
--- 1303,1309 ----
if (type == O_ARRAY || type == O_LARRAY) {
stab = arg[1].arg_ptr.arg_stab;
afree(stab_xarray(stab));
! stab_xarray(stab) = anew(stab); /* so "@array" still works */
}
else if (type == O_HASH || type == O_LHASH) {
stab = arg[1].arg_ptr.arg_stab;
***************
*** 1442,1455 ****
return;
}
tmps = str_get(str);
! if (!tmps)
! return;
! tmps += str->str_cur - (str->str_cur != 0);
! str_nset(astr,tmps,1); /* remember last char */
! *tmps = '\0'; /* wipe it out */
! str->str_cur = tmps - str->str_ptr;
! str->str_nok = 0;
! STABSET(str);
}
do_vop(optype,str,left,right)
--- 1458,1473 ----
return;
}
tmps = str_get(str);
! if (tmps && str->str_cur) {
! tmps += str->str_cur - 1;
! str_nset(astr,tmps,1); /* remember last char */
! *tmps = '\0'; /* wipe it out */
! str->str_cur = tmps - str->str_ptr;
! str->str_nok = 0;
! STABSET(str);
! }
! else
! str_nset(astr,"",0);
}
do_vop(optype,str,left,right)
***************
*** 1472,1477 ****
--- 1490,1497 ----
(void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
str->str_cur = len;
}
+ str->str_pok = 1;
+ str->str_nok = 0;
s = str->str_ptr;
if (!s) {
str_nset(str,"",0);
***************
*** 1506,1512 ****
register STR **st = stack->ary_array;
register int sp = arglast[1];
register int items = arglast[2] - sp;
! long arg[8];
register int i = 0;
int retval = -1;
--- 1526,1532 ----
register STR **st = stack->ary_array;
register int sp = arglast[1];
register int items = arglast[2] - sp;
! unsigned long arg[8];
register int i = 0;
int retval = -1;
***************
*** 1527,1536 ****
*/
while (items--) {
if (st[++sp]->str_nok || !i)
! arg[i++] = (long)str_gnum(st[sp]);
#ifndef lint
else
! arg[i++] = (long)st[sp]->str_ptr;
#endif /* lint */
}
sp = arglast[1];
--- 1547,1556 ----
*/
while (items--) {
if (st[++sp]->str_nok || !i)
! arg[i++] = (unsigned long)str_gnum(st[sp]);
#ifndef lint
else
! arg[i++] = (unsigned long)st[sp]->str_ptr;
#endif /* lint */
}
sp = arglast[1];
Index: doio.c
*** doio.c.old Fri Jun 7 12:23:30 1991
--- doio.c Fri Jun 7 12:23:31 1991
***************
*** 1,11 ****
! /* $RCSfile: doio.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:41:06 $
*
! * 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: doio.c,v $
* Revision 4.0.1.1 91/04/11 17:41:06 lwall
* patch1: hopefully straightened out some of the Xenix mess
*
--- 1,19 ----
! /* $RCSfile: doio.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:53:39 $
*
! * 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: doio.c,v $
+ * Revision 4.0.1.2 91/06/07 10:53:39 lwall
+ * patch4: new copyright notice
+ * patch4: system fd's are now treated specially
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: character special files now opened with bidirectional stdio buffers
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: many, many itty-bitty portability fixes
+ *
* Revision 4.0.1.1 91/04/11 17:41:06 lwall
* patch1: hopefully straightened out some of the Xenix mess
*
***************
*** 75,80 ****
--- 83,91 ----
int fd;
int writing = 0;
char mode[3]; /* stdio file mode ("r\0" or "r+\0") */
+ FILE *saveifp = Nullfp;
+ FILE *saveofp = Nullfp;
+ char savetype = ' ';
name = myname;
forkprocess = 1; /* assume true if no fork */
***************
*** 84,93 ****
stio = stab_io(stab) = stio_new();
else if (stio->ifp) {
fd = fileno(stio->ifp);
! if (stio->type == '|')
! result = mypclose(stio->ifp);
! else if (stio->type == '-')
result = 0;
else if (stio->ifp != stio->ofp) {
if (stio->ofp) {
result = fclose(stio->ofp);
--- 95,110 ----
stio = stab_io(stab) = stio_new();
else if (stio->ifp) {
fd = fileno(stio->ifp);
! if (stio->type == '-')
result = 0;
+ else if (fd <= maxsysfd) {
+ saveifp = stio->ifp;
+ saveofp = stio->ofp;
+ savetype = stio->type;
+ result = 0;
+ }
+ else if (stio->type == '|')
+ result = mypclose(stio->ifp);
else if (stio->ifp != stio->ofp) {
if (stio->ofp) {
result = fclose(stio->ofp);
***************
*** 98,104 ****
}
else
result = fclose(stio->ifp);
! if (result == EOF && fd > 2)
fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
stab_name(stab));
stio->ofp = stio->ifp = Nullfp;
--- 115,121 ----
}
else
result = fclose(stio->ifp);
! if (result == EOF && fd > maxsysfd)
fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
stab_name(stab));
stio->ofp = stio->ifp = Nullfp;
***************
*** 143,150 ****
fd = atoi(name);
else {
stab = stabent(name,FALSE);
! if (!stab || !stab_io(stab))
! return FALSE;
if (stab_io(stab) && stab_io(stab)->ifp) {
fd = fileno(stab_io(stab)->ifp);
if (stab_io(stab)->type == 's')
--- 160,171 ----
fd = atoi(name);
else {
stab = stabent(name,FALSE);
! if (!stab || !stab_io(stab)) {
! #ifdef EINVAL
! errno = EINVAL;
! #endif
! goto say_false;
! }
if (stab_io(stab) && stab_io(stab)->ifp) {
fd = fileno(stab_io(stab)->ifp);
if (stab_io(stab)->type == 's')
***************
*** 209,222 ****
}
Safefree(myname);
if (!fp)
! return FALSE;
if (stio->type &&
stio->type != '|' && stio->type != '-') {
if (fstat(fileno(fp),&statbuf) < 0) {
(void)fclose(fp);
! return FALSE;
}
! if (S_ISSOCK(statbuf.st_mode))
stio->type = 's'; /* in case a socket was passed in to us */
#ifdef S_IFMT
else if (!(statbuf.st_mode & S_IFMT))
--- 230,243 ----
}
Safefree(myname);
if (!fp)
! goto say_false;
if (stio->type &&
stio->type != '|' && stio->type != '-') {
if (fstat(fileno(fp),&statbuf) < 0) {
(void)fclose(fp);
! goto say_false;
}
! if (S_ISSOCK(statbuf.st_mode) || (S_ISCHR(statbuf.st_mode) && writing))
stio->type = 's'; /* in case a socket was passed in to us */
#ifdef S_IFMT
else if (!(statbuf.st_mode & S_IFMT))
***************
*** 225,232 ****
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fd = fileno(fp);
! fcntl(fd,F_SETFD,fd >= 3);
#endif
stio->ifp = fp;
if (writing) {
if (stio->type != 's')
--- 246,268 ----
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fd = fileno(fp);
! fcntl(fd,F_SETFD,fd > maxsysfd);
#endif
+ if (saveifp) { /* must use old fp? */
+ fd = fileno(saveifp);
+ if (saveofp) {
+ fflush(saveofp); /* emulate fclose() */
+ if (saveofp != saveifp) { /* was a socket? */
+ fclose(saveofp);
+ Safefree(saveofp);
+ }
+ }
+ if (fd != fileno(fp)) {
+ dup2(fileno(fp), fd);
+ fclose(fp);
+ }
+ fp = saveifp;
+ }
stio->ifp = fp;
if (writing) {
if (stio->type != 's')
***************
*** 235,243 ****
--- 271,286 ----
if (!(stio->ofp = fdopen(fileno(fp),"w"))) {
fclose(fp);
stio->ifp = Nullfp;
+ goto say_false;
}
}
return TRUE;
+
+ say_false:
+ stio->ifp = saveifp;
+ stio->ofp = saveofp;
+ stio->type = savetype;
+ return FALSE;
}
FILE *
***************
*** 1173,1183 ****
register char *s;
char flags[10];
- #ifdef TAINT
- taintenv();
- taintproper("Insecure dependency in exec");
- #endif
-
/* save an extra exec if possible */
#ifdef CSH
--- 1216,1221 ----
***************
*** 1400,1406 ****
else if (nstio->ifp)
do_close(nstab,FALSE);
! fd = accept(fileno(gstio->ifp),buf,&len);
if (fd < 0)
goto badexit;
nstio->ifp = fdopen(fd, "r");
--- 1438,1444 ----
else if (nstio->ifp)
do_close(nstab,FALSE);
! fd = accept(fileno(gstio->ifp),(struct sockaddr *)buf,&len);
if (fd < 0)
goto badexit;
nstio->ifp = fdopen(fd, "r");
***************
*** 2142,2148 ****
--- 2180,2188 ----
#ifndef telldir
long telldir();
#endif
+ #ifndef apollo
struct DIRENT *readdir();
+ #endif
register struct DIRENT *dp;
if (!stab)
***************
*** 2149,2159 ****
goto nope;
if (!(stio = stab_io(stab)))
stio = stab_io(stab) = stio_new();
! if (!stio->dirp && optype != O_OPENDIR)
goto nope;
st[sp] = &str_yes;
switch (optype) {
! case O_OPENDIR:
if (stio->dirp)
closedir(stio->dirp);
if (!(stio->dirp = opendir(str_get(st[sp+1]))))
--- 2189,2199 ----
goto nope;
if (!(stio = stab_io(stab)))
stio = stab_io(stab) = stio_new();
! if (!stio->dirp && optype != O_OPEN_DIR)
goto nope;
st[sp] = &str_yes;
switch (optype) {
! case O_OPEN_DIR:
if (stio->dirp)
closedir(stio->dirp);
if (!(stio->dirp = opendir(str_get(st[sp+1]))))
***************
*** 2522,2532 ****
if (semctl(id, 0, IPC_STAT, &semds) == -1)
return -1;
getinfo = (cmd == GETALL);
! #ifdef _POSIX_SOURCE
! infosize = semds.sem_nsems * sizeof(ushort_t);
! #else
! infosize = semds.sem_nsems * sizeof(ushort);
! #endif
}
break;
#endif
--- 2562,2570 ----
if (semctl(id, 0, IPC_STAT, &semds) == -1)
return -1;
getinfo = (cmd == GETALL);
! infosize = semds.sem_nsems * sizeof(short);
! /* "short" is technically wrong but much more portable
! than guessing about u_?short(_t)? */
}
break;
#endif
***************
*** 2665,2671 ****
return -1;
}
errno = 0;
! return semop(id, opbuf, opsize/sizeof(struct sembuf));
#else
fatal("semop not implemented");
#endif
--- 2703,2709 ----
return -1;
}
errno = 0;
! return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
#else
fatal("semop not implemented");
#endif
***************
*** 2683,2689 ****
--- 2721,2729 ----
char *mbuf, *shm;
int id, mpos, msize;
struct shmid_ds shmds;
+ #ifndef VOIDSHMAT
extern char *shmat();
+ #endif
id = (int)str_gnum(st[++sp]);
mstr = st[++sp];
***************
*** 2696,2702 ****
errno = EFAULT; /* can't do as caller requested */
return -1;
}
! shm = shmat(id, (char *)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
if (shm == (char *)-1) /* I hate System V IPC, I really do */
return -1;
mbuf = str_get(mstr);
--- 2736,2742 ----
errno = EFAULT; /* can't do as caller requested */
return -1;
}
! shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
if (shm == (char *)-1) /* I hate System V IPC, I really do */
return -1;
mbuf = str_get(mstr);
Index: dolist.c
Prereq: 4.0
*** dolist.c.old Fri Jun 7 12:23:36 1991
--- dolist.c Fri Jun 7 12:23:37 1991
***************
*** 1,11 ****
! /* $Header: dolist.c,v 4.0 91/03/20 01:08:03 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: dolist.c,v $
* Revision 4.0 91/03/20 01:08:03 lwall
* 4.0 baseline.
*
--- 1,19 ----
! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:28 $
*
! * 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: dolist.c,v $
+ * Revision 4.0.1.1 91/06/07 10:58:28 lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: $` was busted inside s///
+ * patch4: caller($arg) didn't work except under debugger
+ *
* Revision 4.0 91/03/20 01:08:03 lwall
* 4.0 baseline.
*
***************
*** 35,40 ****
--- 43,50 ----
char *strend = s + st[sp]->str_cur;
STR *tmpstr;
char *myhint = hint;
+ int global;
+ int safebase;
hint = Nullch;
if (!spat) {
***************
*** 45,50 ****
--- 55,62 ----
st[sp] = str;
return sp;
}
+ global = spat->spat_flags & SPAT_GLOBAL;
+ safebase = (gimme == G_ARRAY) || global;
if (!s)
fatal("panic: do_match");
if (spat->spat_flags & SPAT_USED) {
***************
*** 76,94 ****
}
spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
spat->spat_flags & SPAT_FOLD);
! if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
if (spat->spat_runtime)
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
}
! if (!spat->spat_regexp->nparens)
gimme = G_SCALAR; /* accidental array context? */
if (regexec(spat->spat_regexp, s, strend, s, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
! gimme == G_ARRAY)) {
! if (spat->spat_regexp->subbase)
curspat = spat;
lastspat = spat;
goto gotcha;
--- 88,117 ----
}
spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
spat->spat_flags & SPAT_FOLD);
! if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
if (spat->spat_runtime)
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
+ scanconst(spat, t, tmpstr->str_cur);
+ hoistmust(spat);
+ if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+ curcmd->c_flags &= ~CF_OPTIMIZE;
+ opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+ }
}
! if (global) {
! if (spat->spat_regexp->startp[0]) {
! s = spat->spat_regexp->endp[0];
! }
! }
! else if (!spat->spat_regexp->nparens)
gimme = G_SCALAR; /* accidental array context? */
if (regexec(spat->spat_regexp, s, strend, s, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
! safebase)) {
! if (spat->spat_regexp->subbase || global)
curspat = spat;
lastspat = spat;
goto gotcha;
***************
*** 114,122 ****
deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
}
#endif
! if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
t = s;
if (myhint) {
if (myhint < s || myhint > strend)
fatal("panic: hint in do_match");
--- 137,148 ----
deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
}
#endif
! if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
t = s;
+ play_it_again:
+ if (global && spat->spat_regexp->startp[0])
+ s = spat->spat_regexp->endp[0];
if (myhint) {
if (myhint < s || myhint > strend)
fatal("panic: hint in do_match");
***************
*** 163,174 ****
spat->spat_short = Nullstr; /* opt is being useless */
}
}
! if (!spat->spat_regexp->nparens)
gimme = G_SCALAR; /* accidental array context? */
if (regexec(spat->spat_regexp, s, strend, t, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
! gimme == G_ARRAY)) {
! if (spat->spat_regexp->subbase)
curspat = spat;
lastspat = spat;
if (spat->spat_flags & SPAT_ONCE)
--- 189,200 ----
spat->spat_short = Nullstr; /* opt is being useless */
}
}
! if (!spat->spat_regexp->nparens && !global)
gimme = G_SCALAR; /* accidental array context? */
if (regexec(spat->spat_regexp, s, strend, t, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
! safebase)) {
! if (spat->spat_regexp->subbase || global)
curspat = spat;
lastspat = spat;
if (spat->spat_flags & SPAT_ONCE)
***************
*** 191,202 ****
int iters, i, len;
iters = spat->spat_regexp->nparens;
! if (sp + iters >= stack->ary_max) {
! astore(stack,sp + iters, Nullstr);
st = stack->ary_array; /* possibly realloced */
}
! for (i = 1; i <= iters; i++) {
st[++sp] = str_mortal(&str_no);
if (s = spat->spat_regexp->startp[i]) {
len = spat->spat_regexp->endp[i] - s;
--- 217,232 ----
int iters, i, len;
iters = spat->spat_regexp->nparens;
! if (global && !iters)
! i = 1;
! else
! i = 0;
! if (sp + iters + i >= stack->ary_max) {
! astore(stack,sp + iters + i, Nullstr);
st = stack->ary_array; /* possibly realloced */
}
! for (i = !i; i <= iters; i++) {
st[++sp] = str_mortal(&str_no);
if (s = spat->spat_regexp->startp[i]) {
len = spat->spat_regexp->endp[i] - s;
***************
*** 204,209 ****
--- 234,241 ----
str_nset(st[sp],s,len);
}
}
+ if (global)
+ goto play_it_again;
return sp;
}
else {
***************
*** 218,223 ****
--- 250,261 ----
lastspat = spat;
if (spat->spat_flags & SPAT_ONCE)
spat->spat_flags |= SPAT_USED;
+ if (global) {
+ spat->spat_regexp->startp[0] = s;
+ spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
+ curspat = spat;
+ goto gotcha;
+ }
if (sawampersand) {
char *tmps;
***************
*** 224,229 ****
--- 262,268 ----
if (spat->spat_regexp->subbase)
Safefree(spat->spat_regexp->subbase);
tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
+ spat->spat_regexp->subbeg = tmps;
spat->spat_regexp->subend = tmps + (strend-t);
tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
***************
*** 235,240 ****
--- 274,280 ----
return sp;
nope:
+ spat->spat_regexp->startp[0] = Nullch;
++spat->spat_short->str_u.str_useful;
if (gimme == G_ARRAY)
return sp;
***************
*** 1592,1598 ****
--- 1632,1641 ----
str_2mortal(str_nmake((double)csv->wantarray)) );
if (csv->hasargs) {
ARRAY *ary = csv->argarray;
+ STAB *tmpstab;
+ if (!dbargs)
+ dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
if (dbargs->ary_max < ary->ary_fill)
astore(dbargs,ary->ary_fill,Nullstr);
Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
Index: dump.c
Prereq: 4.0
*** dump.c.old Fri Jun 7 12:23:41 1991
--- dump.c Fri Jun 7 12:23:42 1991
***************
*** 1,11 ****
! /* $Header: dump.c,v 4.0 91/03/20 01:08: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: dump.c,v $
* Revision 4.0 91/03/20 01:08:25 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: dump.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:44 $
*
! * 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: dump.c,v $
+ * Revision 4.0.1.1 91/06/07 10:58:44 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:08:25 lwall
* 4.0 baseline.
*
Index: eval.c
*** eval.c.old Fri Jun 7 12:23:50 1991
--- eval.c Fri Jun 7 12:23:52 1991
***************
*** 1,11 ****
! /* $RCSfile: eval.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:43:48 $
*
! * 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: eval.c,v $
* Revision 4.0.1.1 91/04/11 17:43:48 lwall
* patch1: fixed failed fork to return undef as documented
* patch1: reduced maximum branch distance in eval.c
--- 1,20 ----
! /* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $
*
! * 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: eval.c,v $
+ * Revision 4.0.1.2 91/06/07 11:07:23 lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: assignment wasn't correctly de-tainting the assigned variable.
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: many, many itty-bitty portability fixes
+ *
* Revision 4.0.1.1 91/04/11 17:43:48 lwall
* patch1: fixed failed fork to return undef as documented
* patch1: reduced maximum branch distance in eval.c
***************
*** 208,213 ****
--- 217,232 ----
}
#endif
break;
+ case A_LENSTAB:
+ str_numset(str, (double)STAB_LEN(argptr.arg_stab));
+ st[++sp] = str;
+ #ifdef DEBUGGING
+ if (debug & 8) {
+ (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
+ tmps = buf;
+ }
+ #endif
+ break;
case A_LEXPR:
#ifdef DEBUGGING
if (debug & 8) {
***************
*** 619,624 ****
--- 638,647 ----
goto array_return;
case O_SASSIGN:
sassign:
+ #ifdef TAINT
+ if (tainted && !st[2]->str_tainted)
+ tainted = 0;
+ #endif
STR_SSET(str, st[2]);
STABSET(str);
break;
***************
*** 927,933 ****
break;
}
format(&outrec,form,sp);
! do_write(&outrec,stab_io(stab),sp);
if (stab_io(stab)->flags & IOF_FLUSH)
(void)fflush(fp);
str_set(str, Yes);
--- 950,956 ----
break;
}
format(&outrec,form,sp);
! do_write(&outrec,stab,sp);
if (stab_io(stab)->flags & IOF_FLUSH)
(void)fflush(fp);
str_set(str, Yes);
***************
*** 1087,1093 ****
else if (stab_hash(tmpstab)->tbl_dbm)
str_magic(str, tmpstab, 'D', tmps, anum);
#endif
! else if (perldb && tmpstab == DBline)
str_magic(str, tmpstab, 'L', tmps, anum);
break;
case O_LSLICE:
--- 1110,1116 ----
else if (stab_hash(tmpstab)->tbl_dbm)
str_magic(str, tmpstab, 'D', tmps, anum);
#endif
! else if (tmpstab == DBline)
str_magic(str, tmpstab, 'L', tmps, anum);
break;
case O_LSLICE:
***************
*** 1961,1966 ****
--- 1984,1994 ----
else if (arglast[2] - arglast[1] != 1)
value = (double)do_aexec(Nullstr,arglast);
else {
+ #ifdef TAINT
+ taintenv();
+ tainted |= st[2]->str_tainted;
+ taintproper("Insecure dependency in exec");
+ #endif
value = (double)do_exec(str_get(str_mortal(st[2])));
}
goto donumset;
***************
*** 2260,2266 ****
--- 2288,2300 ----
anum = 0;
else
anum = (int)str_gnum(st[1]);
+ #ifdef _POSIX_SOURCE
+ if (anum != 0)
+ fatal("POSIX getpgrp can't take an argument");
+ value = (double)getpgrp();
+ #else
value = (double)getpgrp(anum);
+ #endif
goto donumset;
#else
fatal("The getpgrp() function is unimplemented on this machine");
***************
*** 2852,2858 ****
fatal("Unsupported function getlogin");
#endif
break;
! case O_OPENDIR:
case O_READDIR:
case O_TELLDIR:
case O_SEEKDIR:
--- 2886,2892 ----
fatal("Unsupported function getlogin");
#endif
break;
! case O_OPEN_DIR:
case O_READDIR:
case O_TELLDIR:
case O_SEEKDIR:
Index: lib/find.pl
*** lib/find.pl.old Fri Jun 7 12:25:10 1991
--- lib/find.pl Fri Jun 7 12:25:11 1991
***************
*** 0 ****
--- 1,105 ----
+ # Usage:
+ # require "find.pl";
+ #
+ # &find('/foo','/bar');
+ #
+ # sub wanted { ... }
+ # where wanted does whatever you want. $dir contains the
+ # current directory name, and $_ the current filename within
+ # that directory. $name contains "$dir/$_". You are cd'ed
+ # to $dir when the function is called. The function may
+ # set $prune to prune the tree.
+ #
+ # This library is primarily for find2perl, which, when fed
+ #
+ # find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+ #
+ # spits out something like this
+ #
+ # sub wanted {
+ # /^\.nfs.*$/ &&
+ # (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ # int(-M _) > 7 &&
+ # unlink($_)
+ # ||
+ # ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+ # $dev < 0 &&
+ # ($prune = 1);
+ # }
+
+ sub find {
+ chop($cwd = `pwd`);
+ foreach $topdir (@_) {
+ (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+ || (warn("Can't stat $topdir: $!\n"), next);
+ if (-d _) {
+ if (chdir($topdir)) {
+ ($dir,$_) = ($topdir,'.');
+ $name = $topdir;
+ &wanted;
+ $topdir =~ s,/$,, ;
+ &finddir($topdir,$topnlink);
+ }
+ else {
+ warn "Can't cd to $topdir: $!\n";
+ }
+ }
+ else {
+ unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+ ($dir,$_) = ('.', $topdir);
+ }
+ chdir $dir && &wanted;
+ }
+ chdir $cwd;
+ }
+ }
+
+ sub finddir {
+ local($dir,$nlink) = @_;
+ local($dev,$ino,$mode,$subcount);
+ local($name);
+
+ # Get the list of files in the current directory.
+
+ opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+ local(@filenames) = readdir(DIR);
+ closedir(DIR);
+
+ if ($nlink == 2) { # This dir has no subdirectories.
+ for (@filenames) {
+ next if $_ eq '.';
+ next if $_ eq '..';
+ $name = "$dir/$_";
+ $nlink = 0;
+ &wanted;
+ }
+ }
+ else { # This dir has subdirectories.
+ $subcount = $nlink - 2;
+ for (@filenames) {
+ next if $_ eq '.';
+ next if $_ eq '..';
+ $nlink = $prune = 0;
+ $name = "$dir/$_";
+ &wanted;
+ if ($subcount > 0) { # Seen all the subdirs?
+
+ # Get link count and check for directoriness.
+
+ ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+
+ if (-d _) {
+
+ # It really is a directory, so do it recursively.
+
+ if (!$prune && chdir $_) {
+ &finddir($name,$nlink);
+ chdir '..';
+ }
+ --$subcount;
+ }
+ }
+ }
+ }
+ }
+ 1;
Index: x2p/find2perl.SH
*** x2p/find2perl.SH.old Fri Jun 7 12:27:57 1991
--- x2p/find2perl.SH Fri Jun 7 12:27:58 1991
***************
*** 128,138 ****
elsif ($_ eq 'exec') {
for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
shift;
! for (@cmd) { s/'/\\'/g; }
! $" = "','";
! $out .= &tab . "&exec(0, '@cmd')";
! $" = ' ';
! $initexec++;
}
elsif ($_ eq 'ok') {
for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
--- 128,152 ----
elsif ($_ eq 'exec') {
for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
shift;
! $_ = "@cmd";
! if (m#^(/bin/)?rm -f {}$#) {
! if (!@ARGV) {
! $out .= &tab . 'unlink($_)';
! }
! else {
! $out .= &tab . '(unlink($_) || 1)';
! }
! }
! elsif (m#^(/bin/)?rm {}$#) {
! $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
! }
! else {
! for (@cmd) { s/'/\\'/g; }
! $" = "','";
! $out .= &tab . "&exec(0, '@cmd')";
! $" = ' ';
! $initexec++;
! }
}
elsif ($_ eq 'ok') {
for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
***************
*** 202,210 ****
}
if (@ARGV) {
if ($ARGV[0] eq '-o') {
$statdone = 0 if $indent == 1 && $delayedstat;
$saw_or++;
- $out .= "\n" . &tab . "||\n";
shift;
}
else {
--- 216,224 ----
}
if (@ARGV) {
if ($ARGV[0] eq '-o') {
+ { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
$statdone = 0 if $indent == 1 && $delayedstat;
$saw_or++;
shift;
}
else {
***************
*** 246,363 ****
print $initfile, "\n" if $initfile;
print <<"END";
# Traverse desired filesystems
! &dodirs($roots);
$flushall
exit;
sub wanted {
$out;
- }
-
- END
-
- print <<'END';
- sub dodirs {
- chop($cwd = `pwd`);
- foreach $topdir (@_) {
- (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
- || (warn("Can't stat $topdir: $!\n"), next);
- if (-d _) {
- if (chdir($topdir)) {
- END
- if ($depth) {
- print <<'END';
- $topdir = '' if $topdir eq '/';
- &dodir($topdir,$topnlink);
- ($dir,$_) = ($topdir,'.');
- $name = $topdir;
- &wanted;
- END
- }
- else {
- print <<'END';
- ($dir,$_) = ($topdir,'.');
- $name = $topdir;
- &wanted;
- $topdir = '' if $topdir eq '/';
- &dodir($topdir,$topnlink);
- END
- }
- print <<'END';
- }
- else {
- warn "Can't cd to $topdir: $!\n";
- }
- }
- else {
- unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
- ($dir,$_) = ('.', $topdir);
- }
- chdir $dir && &wanted;
- }
- chdir $cwd;
- }
- }
-
- sub dodir {
- local($dir,$nlink) = @_;
- local($dev,$ino,$mode,$subcount);
- local($name);
-
- # Get the list of files in the current directory.
-
- opendir(DIR,'.') || warn "Can't open $dir: $!\n";
- local(@filenames) = readdir(DIR);
- closedir(DIR);
-
- if ($nlink == 2) { # This dir has no subdirectories.
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $name = "$dir/$_";
- $nlink = 0;
- &wanted;
- }
- }
- else { # This dir has subdirectories.
- $subcount = $nlink - 2;
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $nlink = $prune = 0;
- $name = "$dir/$_";
- END
- print <<'END' unless $depth;
- &wanted;
- END
- print <<'END';
- if ($subcount > 0) { # Seen all the subdirs?
-
- # Get link count and check for directoriness.
-
- ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
-
- if (-d _) {
-
- # It really is a directory, so do it recursively.
-
- if (!$prune && chdir $_) {
- &dodir($name,$nlink);
- chdir '..';
- }
- --$subcount;
- }
- }
- END
- print <<'END' if $depth;
- &wanted;
- END
- print <<'END';
- }
- }
}
END
--- 260,277 ----
print $initfile, "\n" if $initfile;
+ $find = $depth ? "finddepth" : "find";
print <<"END";
+ require "$find.pl";
+
# Traverse desired filesystems
! &$find($roots);
$flushall
exit;
sub wanted {
$out;
}
END
Index: lib/finddepth.pl
*** lib/finddepth.pl.old Fri Jun 7 12:25:13 1991
--- lib/finddepth.pl Fri Jun 7 12:25:14 1991
***************
*** 0 ****
--- 1,105 ----
+ # Usage:
+ # require "finddepth.pl";
+ #
+ # &finddepth('/foo','/bar');
+ #
+ # sub wanted { ... }
+ # where wanted does whatever you want. $dir contains the
+ # current directory name, and $_ the current filename within
+ # that directory. $name contains "$dir/$_". You are cd'ed
+ # to $dir when the function is called. The function may
+ # set $prune to prune the tree.
+ #
+ # This library is primarily for find2perl, which, when fed
+ #
+ # find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+ #
+ # spits out something like this
+ #
+ # sub wanted {
+ # /^\.nfs.*$/ &&
+ # (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ # int(-M _) > 7 &&
+ # unlink($_)
+ # ||
+ # ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+ # $dev < 0 &&
+ # ($prune = 1);
+ # }
+
+ sub finddepth {
+ chop($cwd = `pwd`);
+ foreach $topdir (@_) {
+ (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+ || (warn("Can't stat $topdir: $!\n"), next);
+ if (-d _) {
+ if (chdir($topdir)) {
+ $topdir =~ s,/$,, ;
+ &finddepthdir($topdir,$topnlink);
+ ($dir,$_) = ($topdir,'.');
+ $name = $topdir;
+ &wanted;
+ }
+ else {
+ warn "Can't cd to $topdir: $!\n";
+ }
+ }
+ else {
+ unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+ ($dir,$_) = ('.', $topdir);
+ }
+ chdir $dir && &wanted;
+ }
+ chdir $cwd;
+ }
+ }
+
+ sub finddepthdir {
+ local($dir,$nlink) = @_;
+ local($dev,$ino,$mode,$subcount);
+ local($name);
+
+ # Get the list of files in the current directory.
+
+ opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+ local(@filenames) = readdir(DIR);
+ closedir(DIR);
+
+ if ($nlink == 2) { # This dir has no subdirectories.
+ for (@filenames) {
+ next if $_ eq '.';
+ next if $_ eq '..';
+ $name = "$dir/$_";
+ $nlink = 0;
+ &wanted;
+ }
+ }
+ else { # This dir has subdirectories.
+ $subcount = $nlink - 2;
+ for (@filenames) {
+ next if $_ eq '.';
+ next if $_ eq '..';
+ $nlink = $prune = 0;
+ $name = "$dir/$_";
+ if ($subcount > 0) { # Seen all the subdirs?
+
+ # Get link count and check for directoriness.
+
+ ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+
+ if (-d _) {
+
+ # It really is a directory, so do it recursively.
+
+ if (!$prune && chdir $_) {
+ &finddepthdir($name,$nlink);
+ chdir '..';
+ }
+ --$subcount;
+ }
+ }
+ &wanted;
+ }
+ }
+ }
+ 1;
Index: form.c
Prereq: 4.0
*** form.c.old Fri Jun 7 12:23:57 1991
--- form.c Fri Jun 7 12:23:58 1991
***************
*** 1,11 ****
! /* $Header: form.c,v 4.0 91/03/20 01:19:23 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: form.c,v $
* Revision 4.0 91/03/20 01:19:23 lwall
* 4.0 baseline.
*
--- 1,15 ----
! /* $RCSfile: form.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:07:59 $
*
! * 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: form.c,v $
+ * Revision 4.0.1.1 91/06/07 11:07:59 lwall
+ * patch4: new copyright notice
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ *
* Revision 4.0 91/03/20 01:19:23 lwall
* 4.0 baseline.
*
***************
*** 325,335 ****
return count;
}
! do_write(orec,stio,sp)
struct outrec *orec;
! register STIO *stio;
int sp;
{
FILE *ofp = stio->ofp;
#ifdef DEBUGGING
--- 329,340 ----
return count;
}
! do_write(orec,stab,sp)
struct outrec *orec;
! STAB *stab;
int sp;
{
+ register STIO *stio = stab_io(stab);
FILE *ofp = stio->ofp;
#ifdef DEBUGGING
***************
*** 340,348 ****
if (stio->lines_left < orec->o_lines) {
if (!stio->top_stab) {
STAB *topstab;
! if (!stio->top_name)
! stio->top_name = savestr("top");
topstab = stabent(stio->top_name,FALSE);
if (!topstab || !stab_form(topstab)) {
stio->lines_left = 100000000;
--- 345,362 ----
if (stio->lines_left < orec->o_lines) {
if (!stio->top_stab) {
STAB *topstab;
+ char tmpbuf[256];
! if (!stio->top_name) {
! if (!stio->fmt_name)
! stio->fmt_name = savestr(stab_name(stab));
! sprintf(tmpbuf, "%s_TOP", stio->fmt_name);
! topstab = stabent(tmpbuf,FALSE);
! if (topstab && stab_form(topstab))
! stio->top_name = savestr(tmpbuf);
! else
! stio->top_name = savestr("top");
! }
topstab = stabent(stio->top_name,FALSE);
if (!topstab || !stab_form(topstab)) {
stio->lines_left = 100000000;
Index: form.h
Prereq: 4.0
*** form.h.old Fri Jun 7 12:24:01 1991
--- form.h Fri Jun 7 12:24:01 1991
***************
*** 1,11 ****
! /* $Header: form.h,v 4.0 91/03/20 01:19:37 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: form.h,v $
* Revision 4.0 91/03/20 01:19:37 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: form.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:08:20 $
*
! * 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: form.h,v $
+ * Revision 4.0.1.1 91/06/07 11:08:20 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:19:37 lwall
* 4.0 baseline.
*
Index: h2pl/getioctlsizes
*** h2pl/getioctlsizes.old Fri Jun 7 12:24:03 1991
--- h2pl/getioctlsizes Fri Jun 7 12:24:04 1991
***************
*** 3,9 ****
open (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed";
while (<IOCTLS>) {
! if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\(\w+,\s*\w+,\s*([^)]+)/) {
$need{$2}++;
}
}
--- 3,9 ----
open (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed";
while (<IOCTLS>) {
! if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\('?\w+'?,\s*\w+,\s*([^)]+)/) {
$need{$2}++;
}
}
Index: t/op/groups.t
*** t/op/groups.t.old Fri Jun 7 12:27:06 1991
--- t/op/groups.t Fri Jun 7 12:27:06 1991
***************
*** 9,18 ****
for (split(' ', $()) {
next if $seen{$_}++;
! push(@gr, (getgrgid($_))[0]);
}
$gr1 = join(' ',sort @gr);
! $gr2 = join(' ', sort split(' ',`groups`));
#print "gr1 is <$gr1>\n";
#print "gr2 is <$gr2>\n";
print +($gr1 eq $gr2) ? "ok 1\n" : "not ok 1\n";
--- 9,24 ----
for (split(' ', $()) {
next if $seen{$_}++;
! ($group) = getgrgid($_);
! if (defined $group) {
! push(@gr, $group);
! }
! else {
! push(@gr, $_);
! }
}
$gr1 = join(' ',sort @gr);
! $gr2 = join(' ', sort split(' ',`/usr/ucb/groups`));
#print "gr1 is <$gr1>\n";
#print "gr2 is <$gr2>\n";
print +($gr1 eq $gr2) ? "ok 1\n" : "not ok 1\n";
Index: handy.h
Prereq: 4.0
*** handy.h.old Fri Jun 7 12:24:09 1991
--- handy.h Fri Jun 7 12:24:09 1991
***************
*** 1,11 ****
! /* $Header: handy.h,v 4.0 91/03/20 01:22: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: handy.h,v $
* Revision 4.0 91/03/20 01:22:15 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: handy.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:09: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: handy.h,v $
+ * Revision 4.0.1.1 91/06/07 11:09:56 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:22:15 lwall
* 4.0 baseline.
*
Index: x2p/handy.h
*** x2p/handy.h.old Fri Jun 7 12:28:01 1991
--- x2p/handy.h Fri Jun 7 12:28:02 1991
***************
*** 1,11 ****
! /* $RCSfile: handy.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:29:08 $
*
! * 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: handy.h,v $
* Revision 4.0.1.1 91/04/12 09:29:08 lwall
* patch1: random cleanup in cpp namespace
*
--- 1,14 ----
! /* $RCSfile: handy.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:15: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: handy.h,v $
+ * Revision 4.0.1.2 91/06/07 12:15:43 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0.1.1 91/04/12 09:29:08 lwall
* patch1: random cleanup in cpp namespace
*
Index: hash.c
Prereq: 4.0
*** hash.c.old Fri Jun 7 12:24:12 1991
--- hash.c Fri Jun 7 12:24:12 1991
***************
*** 1,11 ****
! /* $Header: hash.c,v 4.0 91/03/20 01:22:26 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: hash.c,v $
* Revision 4.0 91/03/20 01:22:26 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:11 $
*
! * 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: hash.c,v $
+ * Revision 4.0.1.1 91/06/07 11:10:11 lwall
+ * patch4: new copyright notice
+ *
* Revision 4.0 91/03/20 01:22:26 lwall
* 4.0 baseline.
*
*** End of Patch 6 ***
exit 0 # Just in case...
--
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