diff options
| -rw-r--r-- | doSH | 36 | ||||
| -rw-r--r-- | doarg.c | 56 | ||||
| -rw-r--r-- | doio.c | 100 | ||||
| -rw-r--r-- | dolist.c | 73 | ||||
| -rw-r--r-- | dump.c | 11 | ||||
| -rw-r--r-- | eval.c | 48 | ||||
| -rw-r--r-- | form.c | 30 | ||||
| -rw-r--r-- | form.h | 11 | ||||
| -rw-r--r-- | h2pl/getioctlsizes | 2 | ||||
| -rw-r--r-- | handy.h | 11 | ||||
| -rw-r--r-- | hash.c | 11 | ||||
| -rw-r--r-- | lib/find.pl | 105 | ||||
| -rw-r--r-- | lib/finddepth.pl | 105 | ||||
| -rw-r--r-- | msdos/dir.h | 9 | ||||
| -rw-r--r-- | msdos/directory.c | 11 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | t/op/groups.t | 10 | ||||
| -rw-r--r-- | x2p/find2perl.SH | 134 | ||||
| -rw-r--r-- | x2p/handy.h | 11 |
19 files changed, 557 insertions, 219 deletions
@@ -0,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 @@ -1,11 +1,21 @@ -/* $RCSfile: doarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:40:14 $ +/* $RCSfile: doarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:42:17 $ * - * 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: 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,6 +77,12 @@ int sp; 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,7 +92,7 @@ int sp; #endif safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) && !sawampersand); - if (!*spat->spat_regexp->precomp && lastspat) + if (!spat->spat_regexp->prelen && lastspat) spat = lastspat; orig = m = s; if (hint) { @@ -122,7 +138,7 @@ int sp; spat->spat_short = Nullstr; /* opt is being useless */ } } - once = ((rspat->spat_flags & SPAT_ONCE) != 0); + 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,7 +1303,7 @@ int *arglast; if (type == O_ARRAY || type == O_LARRAY) { stab = arg[1].arg_ptr.arg_stab; afree(stab_xarray(stab)); - stab_xarray(stab) = Null(ARRAY*); + 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,14 +1458,16 @@ register STR *str; 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); + 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,6 +1490,8 @@ STR *right; (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,7 +1526,7 @@ int *arglast; register STR **st = stack->ary_array; register int sp = arglast[1]; register int items = arglast[2] - sp; - long arg[8]; + unsigned long arg[8]; register int i = 0; int retval = -1; @@ -1527,10 +1547,10 @@ int *arglast; */ while (items--) { if (st[++sp]->str_nok || !i) - arg[i++] = (long)str_gnum(st[sp]); + arg[i++] = (unsigned long)str_gnum(st[sp]); #ifndef lint else - arg[i++] = (long)st[sp]->str_ptr; + arg[i++] = (unsigned long)st[sp]->str_ptr; #endif /* lint */ } sp = arglast[1]; @@ -1,11 +1,19 @@ -/* $RCSfile: doio.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:41:06 $ +/* $RCSfile: doio.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:53:39 $ * - * 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: 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,6 +83,9 @@ int len; 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,10 +95,16 @@ int len; 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 == '-') + 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,7 +115,7 @@ int len; } else result = fclose(stio->ifp); - if (result == EOF && fd > 2) + if (result == EOF && fd > maxsysfd) fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", stab_name(stab)); stio->ofp = stio->ifp = Nullfp; @@ -143,8 +160,12 @@ int len; fd = atoi(name); else { stab = stabent(name,FALSE); - if (!stab || !stab_io(stab)) - return 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,14 +230,14 @@ int len; } Safefree(myname); if (!fp) - return FALSE; + goto say_false; if (stio->type && stio->type != '|' && stio->type != '-') { if (fstat(fileno(fp),&statbuf) < 0) { (void)fclose(fp); - return FALSE; + goto say_false; } - if (S_ISSOCK(statbuf.st_mode)) + 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,8 +246,23 @@ int len; } #if defined(HAS_FCNTL) && defined(F_SETFD) fd = fileno(fp); - fcntl(fd,F_SETFD,fd >= 3); -#endif + 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,9 +271,16 @@ int len; 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,11 +1216,6 @@ char *cmd; register char *s; char flags[10]; -#ifdef TAINT - taintenv(); - taintproper("Insecure dependency in exec"); -#endif - /* save an extra exec if possible */ #ifdef CSH @@ -1400,7 +1438,7 @@ STAB *gstab; else if (nstio->ifp) do_close(nstab,FALSE); - fd = accept(fileno(gstio->ifp),buf,&len); + fd = accept(fileno(gstio->ifp),(struct sockaddr *)buf,&len); if (fd < 0) goto badexit; nstio->ifp = fdopen(fd, "r"); @@ -2142,18 +2180,20 @@ int *arglast; #ifndef telldir long telldir(); #endif +#ifndef apollo struct DIRENT *readdir(); +#endif register struct DIRENT *dp; if (!stab) goto nope; if (!(stio = stab_io(stab))) stio = stab_io(stab) = stio_new(); - if (!stio->dirp && optype != O_OPENDIR) + if (!stio->dirp && optype != O_OPEN_DIR) goto nope; st[sp] = &str_yes; switch (optype) { - case O_OPENDIR: + case O_OPEN_DIR: if (stio->dirp) closedir(stio->dirp); if (!(stio->dirp = opendir(str_get(st[sp+1])))) @@ -2522,11 +2562,9 @@ int *arglast; 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 + infosize = semds.sem_nsems * sizeof(short); + /* "short" is technically wrong but much more portable + than guessing about u_?short(_t)? */ } break; #endif @@ -2665,7 +2703,7 @@ int *arglast; return -1; } errno = 0; - return semop(id, opbuf, opsize/sizeof(struct sembuf)); + return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf)); #else fatal("semop not implemented"); #endif @@ -2683,7 +2721,9 @@ int *arglast; 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,7 +2736,7 @@ int *arglast; errno = EFAULT; /* can't do as caller requested */ return -1; } - shm = shmat(id, (char *)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0); + 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); @@ -1,11 +1,19 @@ -/* $Header: dolist.c,v 4.0 91/03/20 01:08:03 lwall Locked $ +/* $RCSfile: dolist.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:28 $ * - * 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: 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,6 +43,8 @@ int *arglast; char *strend = s + st[sp]->str_cur; STR *tmpstr; char *myhint = hint; + int global; + int safebase; hint = Nullch; if (!spat) { @@ -45,6 +55,8 @@ int *arglast; 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,19 +88,30 @@ int *arglast; } spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, spat->spat_flags & SPAT_FOLD); - if (!*spat->spat_regexp->precomp && lastspat) + 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]; + } } - if (!spat->spat_regexp->nparens) + 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, - gimme == G_ARRAY)) { - if (spat->spat_regexp->subbase) + safebase)) { + if (spat->spat_regexp->subbase || global) curspat = spat; lastspat = spat; goto gotcha; @@ -114,9 +137,12 @@ int *arglast; deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch); } #endif - if (!*spat->spat_regexp->precomp && lastspat) + 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,12 +189,12 @@ int *arglast; spat->spat_short = Nullstr; /* opt is being useless */ } } - if (!spat->spat_regexp->nparens) + 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, - gimme == G_ARRAY)) { - if (spat->spat_regexp->subbase) + safebase)) { + if (spat->spat_regexp->subbase || global) curspat = spat; lastspat = spat; if (spat->spat_flags & SPAT_ONCE) @@ -191,12 +217,16 @@ int *arglast; int iters, i, len; iters = spat->spat_regexp->nparens; - if (sp + iters >= stack->ary_max) { - astore(stack,sp + iters, Nullstr); + 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 = 1; i <= iters; i++) { + 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,6 +234,8 @@ int *arglast; str_nset(st[sp],s,len); } } + if (global) + goto play_it_again; return sp; } else { @@ -218,12 +250,19 @@ yup: 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; 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,6 +274,7 @@ yup: return sp; nope: + spat->spat_regexp->startp[0] = Nullch; ++spat->spat_short->str_u.str_useful; if (gimme == G_ARRAY) return sp; @@ -1592,7 +1632,10 @@ int *arglast; 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*); @@ -1,11 +1,14 @@ -/* $Header: dump.c,v 4.0 91/03/20 01:08:25 lwall Locked $ +/* $RCSfile: dump.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:44 $ * - * 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: 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. * @@ -1,11 +1,20 @@ -/* $RCSfile: eval.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:43:48 $ +/* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $ * - * 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: 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,6 +217,16 @@ register int sp; } #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,6 +638,10 @@ register int sp; 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,7 +950,7 @@ register int sp; break; } format(&outrec,form,sp); - do_write(&outrec,stab_io(stab),sp); + do_write(&outrec,stab,sp); if (stab_io(stab)->flags & IOF_FLUSH) (void)fflush(fp); str_set(str, Yes); @@ -1087,7 +1110,7 @@ register int sp; else if (stab_hash(tmpstab)->tbl_dbm) str_magic(str, tmpstab, 'D', tmps, anum); #endif - else if (perldb && tmpstab == DBline) + else if (tmpstab == DBline) str_magic(str, tmpstab, 'L', tmps, anum); break; case O_LSLICE: @@ -1961,6 +1984,11 @@ register int sp; 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,7 +2288,13 @@ donumset: 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,7 +2886,7 @@ donumset: fatal("Unsupported function getlogin"); #endif break; - case O_OPENDIR: + case O_OPEN_DIR: case O_READDIR: case O_TELLDIR: case O_SEEKDIR: @@ -1,11 +1,15 @@ -/* $Header: form.c,v 4.0 91/03/20 01:19:23 lwall Locked $ +/* $RCSfile: form.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:07:59 $ * - * 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: 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,11 +329,12 @@ register int size; return count; } -do_write(orec,stio,sp) +do_write(orec,stab,sp) struct outrec *orec; -register STIO *stio; +STAB *stab; int sp; { + register STIO *stio = stab_io(stab); FILE *ofp = stio->ofp; #ifdef DEBUGGING @@ -340,9 +345,18 @@ int sp; if (stio->lines_left < orec->o_lines) { if (!stio->top_stab) { STAB *topstab; + char tmpbuf[256]; - if (!stio->top_name) - stio->top_name = savestr("top"); + 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; @@ -1,11 +1,14 @@ -/* $Header: form.h,v 4.0 91/03/20 01:19:37 lwall Locked $ +/* $RCSfile: form.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:08:20 $ * - * 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: 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. * diff --git a/h2pl/getioctlsizes b/h2pl/getioctlsizes index b7d4a0dfb5..403fffaf86 100644 --- a/h2pl/getioctlsizes +++ b/h2pl/getioctlsizes @@ -3,7 +3,7 @@ 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*([^)]+)/) { + if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\('?\w+'?,\s*\w+,\s*([^)]+)/) { $need{$2}++; } } @@ -1,11 +1,14 @@ -/* $Header: handy.h,v 4.0 91/03/20 01:22:15 lwall Locked $ +/* $RCSfile: handy.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:09: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: 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. * @@ -1,11 +1,14 @@ -/* $Header: hash.c,v 4.0 91/03/20 01:22:26 lwall Locked $ +/* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:11 $ * - * 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: 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. * diff --git a/lib/find.pl b/lib/find.pl new file mode 100644 index 0000000000..b853d12f40 --- /dev/null +++ b/lib/find.pl @@ -0,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; diff --git a/lib/finddepth.pl b/lib/finddepth.pl new file mode 100644 index 0000000000..15e4daf561 --- /dev/null +++ b/lib/finddepth.pl @@ -0,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; diff --git a/msdos/dir.h b/msdos/dir.h index d7536372a3..1395f81570 100644 --- a/msdos/dir.h +++ b/msdos/dir.h @@ -1,11 +1,14 @@ -/* $Header: dir.h,v 4.0 91/03/20 01:34:20 lwall Locked $ +/* $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 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: 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. * diff --git a/msdos/directory.c b/msdos/directory.c index cc469d07fd..802614bbbc 100644 --- a/msdos/directory.c +++ b/msdos/directory.c @@ -1,11 +1,14 @@ -/* $Header: directory.c,v 4.0 91/03/20 01:34:24 lwall Locked $ +/* $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 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: 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,7 +47,7 @@ #define PATHLEN 65 #ifndef lint -static char rcsid[] = "$Header: directory.c,v 4.0 91/03/20 01:34:24 lwall Locked $"; +static char rcsid[] = "$RCSfile: directory.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:24 $"; #endif DIR * diff --git a/patchlevel.h b/patchlevel.h index 51d80f3b8e..fb8ed65ede 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 5 +#define PATCHLEVEL 6 diff --git a/t/op/groups.t b/t/op/groups.t index 73ec3a0d9a..f8cb4cad58 100644 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -9,10 +9,16 @@ print "1..1\n"; for (split(' ', $()) { next if $seen{$_}++; - push(@gr, (getgrgid($_))[0]); + ($group) = getgrgid($_); + if (defined $group) { + push(@gr, $group); + } + else { + push(@gr, $_); + } } $gr1 = join(' ',sort @gr); -$gr2 = join(' ', sort split(' ',`groups`)); +$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"; diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH index f850247391..9161f7ba98 100644 --- a/x2p/find2perl.SH +++ b/x2p/find2perl.SH @@ -128,11 +128,25 @@ while (@ARGV) { elsif ($_ eq 'exec') { for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { } shift; - for (@cmd) { s/'/\\'/g; } - $" = "','"; - $out .= &tab . "&exec(0, '@cmd')"; - $" = ' '; - $initexec++; + $_ = "@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,9 +216,9 @@ while (@ARGV) { } if (@ARGV) { if ($ARGV[0] eq '-o') { + { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; } $statdone = 0 if $indent == 1 && $delayedstat; $saw_or++; - $out .= "\n" . &tab . "||\n"; shift; } else { @@ -246,10 +260,13 @@ print $initnewer, "\n" if $initnewer; print $initfile, "\n" if $initfile; +$find = $depth ? "finddepth" : "find"; print <<"END"; +require "$find.pl"; + # Traverse desired filesystems -&dodirs($roots); +&$find($roots); $flushall exit; @@ -259,109 +276,6 @@ $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 - if ($initexec) { print <<'END'; sub exec { diff --git a/x2p/handy.h b/x2p/handy.h index e50cbc3866..25a1bdac1e 100644 --- a/x2p/handy.h +++ b/x2p/handy.h @@ -1,11 +1,14 @@ -/* $RCSfile: handy.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:29:08 $ +/* $RCSfile: handy.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:15: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: 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 * |