From: Larry Wall Date: Mon, 13 Aug 1990 09:45:26 +0000 (+0000) Subject: perl 3.0 patch #28 (combined patch) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6eb13c3b624098fc688ac86672bc30e26cbf8fd4;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #28 (combined patch) Certain systems, notable Ultrix, set the close-on-exec flag by default on dup'ed file descriptors. This is anti-social when you're creating a new STDOUT. The flag is now forced off for STDIN, STDOUT and STDERR. Some yaccs report 29 shift/reduce conflicts and 59 reduce/reduce conflicts, while other yaccs and bison report 27 and 61. The Makefile now says to expect either thing. I'm not sure if there's a bug lurking there somewhere. The defined(@array) and defined(%array) ended up defining the arrays they were trying to determine the status of. Oops. Using the status of NSIG to determine whether had been included didn't work right on Xenix. A fix seems to be beyond Configure at the moment, so we've got some OS dependent #ifdefs in there. There were some syntax errors in the new code to determine whether it is safe to emulate rename() with unlink/link/unlink. Obviously heavily tested code... :-) Patch 27 introduced the possibility of using identifiers as unquoted strings, but the code to warn against the use of totally lowercase identifiers looped infinitely. I documented that you can't interpolate $) or $| in pattern. It was actually implied under s///, but it should have been more explicit. Patterns with {m} rather than {m,n} didn't work right. Tests io.fs and op.stat had difficulties under AFS. They now ignore the tests in question if they think they're running under /afs. The shift/reduce expectation message was off for a2p's Makefile. --- diff --git a/Configure b/Configure index 41ad39c..9d5f032 100755 --- a/Configure +++ b/Configure @@ -8,7 +8,7 @@ # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # -# $Header: Configure,v 3.0.1.8 90/08/09 01:47:24 lwall Locked $ +# $Header: Configure,v 3.0.1.9 90/08/13 21:48:46 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than @@ -262,7 +262,7 @@ attrlist="$attrlist i186 __m88k__ m88k DGUX __DGUX__" pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /usr/plx /usr/5bin /vol/local/bin /etc /usr/lib /lib /usr/local/lib /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/bin /bsd4.3/usr/ucb" d_newshome="/usr/NeWS" defvoidused=7 -libswanted="net_s net nsl_s nsl socket nm ndir ndbm dbm sun bsd BSD x c_s" +libswanted="net_s net nsl_s nsl socket nm ndir ndbm dbm sun m bsd BSD x c_s" inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan' : some greps do not return status, grrr. echo "grimblepritz" >grimble diff --git a/Makefile.SH b/Makefile.SH index 33ba8ab..cccdc72 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -25,9 +25,12 @@ esac echo "Extracting Makefile (with variable substitutions)" cat >Makefile <ary_max / 5; - resize: - Renew(ar->ary_alloc,newmax+1, STR*); - Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*); + if (ar->ary_alloc) { + newmax = key + ar->ary_max / 5; + resize: + Renew(ar->ary_alloc,newmax+1, STR*); + Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*); + } + else { + newmax = key < 4 ? 4 : key; + Newz(2,ar->ary_alloc, newmax+1, STR*); + } ar->ary_array = ar->ary_alloc; ar->ary_max = newmax; } @@ -100,12 +109,10 @@ STAB *stab; register ARRAY *ar; New(1,ar,1,ARRAY); - Newz(2,ar->ary_alloc,5,STR*); - ar->ary_array = ar->ary_alloc; ar->ary_magic = Str_new(7,0); + ar->ary_alloc = ar->ary_array = 0; str_magic(ar->ary_magic, stab, '#', Nullch, 0); - ar->ary_fill = -1; - ar->ary_max = 4; + ar->ary_max = ar->ary_fill = -1; ar->ary_flags = ARF_REAL; return ar; } @@ -136,7 +143,7 @@ register ARRAY *ar; { register int key; - if (!ar || !(ar->ary_flags & ARF_REAL)) + if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0) return; if (key = ar->ary_array - ar->ary_alloc) { ar->ary_max += key; diff --git a/doarg.c b/doarg.c index 48b614e..151bcb4 100644 --- a/doarg.c +++ b/doarg.c @@ -1,4 +1,4 @@ -/* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $ +/* $Header: doarg.c,v 3.0.1.7 90/08/13 22:14:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doarg.c,v $ + * Revision 3.0.1.7 90/08/13 22:14:15 lwall + * patch28: the NSIG hack didn't work on Xenix + * patch28: defined(@array) and defined(%array) didn't work right + * * Revision 3.0.1.6 90/08/09 02:48:38 lwall * patch19: fixed double include of * patch19: pack/unpack can now do native float and double @@ -49,7 +53,7 @@ #include "EXTERN.h" #include "perl.h" -#ifndef NSIG +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif @@ -1155,22 +1159,24 @@ int *arglast; register int type; register int retarg = arglast[0] + 1; int retval; + ARRAY *ary; + HASH *hash; if ((arg[1].arg_type & A_MASK) != A_LEXPR) fatal("Illegal argument to defined()"); arg = arg[1].arg_ptr.arg_arg; type = arg->arg_type; - if (type == O_ARRAY || type == O_LARRAY) - retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; - else if (type == O_HASH || type == O_LHASH) - retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; - else if (type == O_ASLICE || type == O_LASLICE) - retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0; - else if (type == O_HSLICE || type == O_LHSLICE) - retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0; - else if (type == O_SUBR || type == O_DBSUBR) + if (type == O_SUBR || type == O_DBSUBR) retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0; + else if (type == O_ARRAY || type == O_LARRAY || + type == O_ASLICE || type == O_LASLICE ) + retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0 + && ary->ary_max >= 0 ); + else if (type == O_HASH || type == O_LHASH || + type == O_HSLICE || type == O_LHSLICE ) + retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0 + && hash->tbl_array); else retval = FALSE; str_numset(str,(double)retval); diff --git a/doio.c b/doio.c index 88c0f4c..40ac26c 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $Header: doio.c,v 3.0.1.9 90/08/09 02:56:19 lwall Locked $ +/* $Header: doio.c,v 3.0.1.10 90/08/13 22:14:29 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.10 90/08/13 22:14:29 lwall + * patch28: close-on-exec problems on dup'ed file descriptors + * patch28: F_FREESP wasn't implemented the way I thought + * * Revision 3.0.1.9 90/08/09 02:56:19 lwall * patch19: various MSDOS and OS/2 patches folded in * patch19: prints now check error status better @@ -67,6 +71,10 @@ #include #endif +#if defined(SELECT) && (defined(M_UNIX) || defined(M_XENIX)) +#include +#endif + #ifdef I_PWD #include #endif @@ -237,8 +245,7 @@ int len; } #if defined(FCNTL) && defined(F_SETFD) fd = fileno(fp); - if (fd >= 3) - fcntl(fd,F_SETFD,1); + fcntl(fd,F_SETFD,fd >= 3); #endif stio->ifp = fp; if (writing) { @@ -657,6 +664,58 @@ int *arglast; return sp; } +#if !defined(TRUNCATE) && !defined(CHSIZE) && defined(F_FREESP) + /* code courtesy of Pim Zandbergen */ +#define CHSIZE + +int chsize(fd, length) +int fd; /* file descriptor */ +off_t length; /* length to set file to */ +{ + extern long lseek(); + struct flock fl; + struct stat filebuf; + + if (fstat(fd, &filebuf) < 0) + return -1; + + if (filebuf.st_size < length) { + + /* extend file length */ + + if ((lseek(fd, (length - 1), 0)) < 0) + return -1; + + /* write a "0" byte */ + + if ((write(fd, "", 1)) != 1) + return -1; + } + else { + /* truncate length */ + + fl.l_whence = 0; + fl.l_len = 0; + fl.l_start = length; + fl.l_type = F_WRLCK; /* write lock on file space */ + + /* + * This relies on the UNDOCUMENTED F_FREESP argument to + * fcntl(2), which truncates the file so that it ends at the + * position indicated by fl.l_start. + * + * Will minor miracles never cease? + */ + + if (fcntl(fd, F_FREESP, &fl) < 0) + return -1; + + } + + return 0; +} +#endif /* F_FREESP */ + int do_truncate(str,arg,gimme,arglast) STR *str; @@ -670,7 +729,7 @@ int *arglast; int result = 1; STAB *tmpstab; -#if defined(TRUNCATE) || defined(CHSIZE) || defined(F_FREESP) +#if defined(TRUNCATE) || defined(CHSIZE) #ifdef TRUNCATE if ((arg[1].arg_type & A_MASK) == A_WORD) { tmpstab = arg[1].arg_ptr.arg_stab; @@ -681,9 +740,6 @@ int *arglast; else if (truncate(str_get(ary->ary_array[sp]), len) < 0) result = 0; #else -#ifndef CHSIZE -#define chsize(f,l) fcntl(f,F_FREESP,l) -#endif if ((arg[1].arg_type & A_MASK) == A_WORD) { tmpstab = arg[1].arg_ptr.arg_stab; if (!stab_io(tmpstab) || diff --git a/dolist.c b/dolist.c index 3d32d98..dbdcaa7 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.8 90/08/09 03:15:56 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.9 90/08/13 22:15:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.9 90/08/13 22:15:35 lwall + * patch28: defined(@array) and defined(%array) didn't work right + * * Revision 3.0.1.8 90/08/09 03:15:56 lwall * patch19: certain kinds of matching cause "panic: hint" * patch19: $' broke on embedded nulls @@ -1109,6 +1112,10 @@ int *arglast; if (after < 0) { /* not that much array */ length += after; /* offset+length now in array */ after = 0; + if (!ary->ary_alloc) { + afill(ary,0); + afill(ary,-1); + } } /* At this point, sp .. max-1 is our new LIST */ diff --git a/eval.c b/eval.c index 42436e4..7bd5342 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.7 90/08/09 03:33:44 lwall Locked $ +/* $Header: eval.c,v 3.0.1.8 90/08/13 22:17:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.8 90/08/13 22:17:14 lwall + * patch28: the NSIG hack didn't work right on Xenix + * patch28: defined(@array) and defined(%array) didn't work right + * patch28: rename was busted on systems without rename system call + * * Revision 3.0.1.7 90/08/09 03:33:44 lwall * patch19: made ~ do vector operation on strings like &, | and ^ * patch19: dbmopen(%name...) didn't work right @@ -60,7 +65,7 @@ #include "EXTERN.h" #include "perl.h" -#ifndef NSIG +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif @@ -1539,7 +1544,7 @@ register int sp; #ifdef RENAME value = (double)(rename(tmps,tmps2) >= 0); #else - if (same_dirent(tmps2, tmps) /* can always rename to same name */ + if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { if (euid || stat(tmps2,&statbuf) < 0 || diff --git a/hash.c b/hash.c index ffeaf1d..a30b01f 100644 --- a/hash.c +++ b/hash.c @@ -1,4 +1,4 @@ -/* $Header: hash.c,v 3.0.1.4 90/08/09 03:50:22 lwall Locked $ +/* $Header: hash.c,v 3.0.1.5 90/08/13 22:18:27 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.c,v $ + * Revision 3.0.1.5 90/08/13 22:18:27 lwall + * patch28: defined(@array) and defined(%array) didn't work right + * * Revision 3.0.1.4 90/08/09 03:50:22 lwall * patch19: dbmopen(name, 'filename', undef) now refrains from creating * @@ -55,6 +58,12 @@ int lval; if (!tb) return Nullstr; + if (!tb->tbl_array) { + if (lval) + Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*); + else + return Nullstr; + } /* The hash function we use on symbols has to be equal to the first * character when taken modulo 128, so that str_reset() can be implemented @@ -141,6 +150,9 @@ register int hash; } } + if (!tb->tbl_array) + Newz(505,tb->tbl_array, tb->tbl_max + 1, HENT*); + oentry = &(tb->tbl_array[hash & tb->tbl_max]); i = 1; @@ -210,7 +222,7 @@ int klen; datum dkey; #endif - if (!tb) + if (!tb || !tb->tbl_array) return Nullstr; if (!tb->tbl_coeffsize) hash = *key + 128 * key[1] + 128 * key[klen-1]; @@ -314,7 +326,6 @@ unsigned int lookat; tb->tbl_max = 127; /* it's a symbol table */ tb->tbl_dosplit = 128; /* so never split */ } - Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*); tb->tbl_fill = 0; #ifdef SOME_DBM tb->tbl_dbm = 0; @@ -352,7 +363,7 @@ register HASH *tb; register HENT *hent; register HENT *ohent = Null(HENT*); - if (!tb) + if (!tb || !tb->tbl_array) return; (void)hiterinit(tb); while (hent = hiternext(tb)) { /* concise but not very efficient */ @@ -438,6 +449,8 @@ register HASH *tb; return entry; } #endif + if (!tb->tbl_array) + Newz(506,tb->tbl_array, tb->tbl_max + 1, HENT*); do { if (entry) entry = entry->hent_next; diff --git a/patchlevel.h b/patchlevel.h index 466db5f..afbe4bd 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 27 +#define PATCHLEVEL 28 diff --git a/perl.man.2 b/perl.man.2 index 12891036..2f7b514 100644 --- a/perl.man.2 +++ b/perl.man.2 @@ -1,7 +1,10 @@ ''' Beginning of part 2 -''' $Header: perl_man.2,v 3.0.1.7 90/08/09 04:27:04 lwall Locked $ +''' $Header: perl_man.2,v 3.0.1.8 90/08/13 22:21:00 lwall Locked $ ''' ''' $Log: perl.man.2,v $ +''' Revision 3.0.1.8 90/08/13 22:21:00 lwall +''' patch28: documented that you can't interpolate $) or $| in pattern +''' ''' Revision 3.0.1.7 90/08/09 04:27:04 lwall ''' patch19: added require operator ''' @@ -1074,6 +1077,7 @@ If the final delimiter is followed by the optional letter \*(L'i\*(R', the match done in a case-insensitive manner. PATTERN may contain references to scalar variables, which will be interpolated (and the pattern recompiled) every time the pattern search is evaluated. +(Note that $) and $| may not be interpolated because they look like end-of-string tests.) If you want such a pattern to be compiled only once, add an \*(L"o\*(R" after the trailing delimiter. This avoids expensive run-time recompilations, and diff --git a/perl.y b/perl.y index d76623e..4b086cf 100644 --- a/perl.y +++ b/perl.y @@ -1,4 +1,4 @@ -/* $Header: perl.y,v 3.0.1.7 90/08/09 04:17:44 lwall Locked $ +/* $Header: perl.y,v 3.0.1.8 90/08/13 22:19:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.8 90/08/13 22:19:55 lwall + * patch28: lowercase unquoted strings caused infinite loop + * * Revision 3.0.1.7 90/08/09 04:17:44 lwall * patch19: did preliminary work toward debugging packages and evals * patch19: added require operator @@ -776,17 +779,16 @@ hshword : WORD */ bareword: WORD - { char *s = $1; + { char *s; $$ = op_new(1); $$->arg_type = O_ITEM; $$[1].arg_type = A_SINGLE; $$[1].arg_ptr.arg_str = str_make($1,0); - while (*s) { - if (!islower(*s)) - break; - } + for (s = $1; *s && islower(*s); s++) ; if (dowarn && !*s) - warn("\"%s\" may clash with future reserved word", $1); + warn( + "\"%s\" may clash with future reserved word", + $1 ); } %% /* PROGRAM */ diff --git a/perly.c b/perly.c index b5c1465..33b4a32 100644 --- a/perly.c +++ b/perly.c @@ -1,4 +1,4 @@ -char rcsid[] = "$Header: perly.c,v 3.0.1.6 90/08/09 04:55:50 lwall Locked $\nPatch level: ###\n"; +char rcsid[] = "$Header: perly.c,v 3.0.1.7 90/08/13 22:22:22 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.6 90/08/09 04:55:50 lwall Locked $\nPat * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.7 90/08/13 22:22:22 lwall + * patch28: defined(@array) and defined(%array) didn't work right + * * Revision 3.0.1.6 90/08/09 04:55:50 lwall * patch19: added -x switch to extract script from input trash * patch19: Added -c switch to do compilation only @@ -571,6 +574,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); savestack = anew(Nullstab); /* for saving non-local values */ stack = anew(Nullstab); /* for saving non-local values */ stack->ary_flags = 0; /* not a real array */ + afill(stack,63); afill(stack,-1); /* preextend stack */ + afill(savestack,63); afill(savestack,-1); /* now parse the script */ @@ -845,7 +850,7 @@ int *arglast; if (instr(tokenbuf,".h ")) strcat(tokenbuf," (change .h to .ph maybe?)"); if (instr(tokenbuf,".ph ")) - strcat(tokenbuf," (did you run makelib?)"); + strcat(tokenbuf," (did you run h2ph?)"); fatal("%s",tokenbuf); } if (gimme != G_ARRAY) diff --git a/regcomp.c b/regcomp.c index 68da52e..e3ef1ba 100644 --- a/regcomp.c +++ b/regcomp.c @@ -7,9 +7,12 @@ * blame Henry for some of the lack of readability. */ -/* $Header: regcomp.c,v 3.0.1.4 90/08/09 05:05:33 lwall Locked $ +/* $Header: regcomp.c,v 3.0.1.5 90/08/13 22:23:29 lwall Locked $ * * $Log: regcomp.c,v $ + * Revision 3.0.1.5 90/08/13 22:23:29 lwall + * patch28: /x{m}/ didn't work right + * * Revision 3.0.1.4 90/08/09 05:05:33 lwall * patch19: sped up /x+y/ patterns greatly by not retrying on every x * patch19: inhibited backoff on patterns anchored to the end like /\s+$/ @@ -474,6 +477,8 @@ int *flagp; reginsert(CURLY, ret); if (*max == ',') max++; + else + max = regparse; tmp = atoi(max); if (tmp && tmp < iter) fatal("Can't do {n,m} with n > m"); diff --git a/stab.c b/stab.c index 15ae9b3..00cee82 100644 --- a/stab.c +++ b/stab.c @@ -1,4 +1,4 @@ -/* $Header: stab.c,v 3.0.1.7 90/08/09 05:17:48 lwall Locked $ +/* $Header: stab.c,v 3.0.1.8 90/08/13 22:30:17 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.8 90/08/13 22:30:17 lwall + * patch28: the NSIG hack didn't work right on Xenix + * * Revision 3.0.1.7 90/08/09 05:17:48 lwall * patch19: fixed double include of * patch19: $' broke on embedded nulls @@ -47,7 +50,7 @@ #include "EXTERN.h" #include "perl.h" -#ifndef NSIG +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif diff --git a/t/io.fs b/t/io.fs index 51febd6..d25dc02 100644 --- a/t/io.fs +++ b/t/io.fs @@ -1,6 +1,6 @@ #!./perl -# $Header: io.fs,v 3.0 89/10/18 15:26:20 lwall Locked $ +# $Header: io.fs,v 3.0.1.1 90/08/13 22:31:17 lwall Locked $ print "1..22\n"; @@ -61,8 +61,10 @@ if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('b'); if ($ino) {print "ok 17\n";} else {print "not ok 17\n";} -if ($atime == 500000000 && $mtime == 500000001) - {print "ok 18\n";} else {print "not ok 18 $atime $mtime\n";} +if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#) + {print "ok 18\n";} +else + {print "not ok 18 $atime $mtime\n";} if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, diff --git a/t/op.stat b/t/op.stat index f5e6164..c6fca78 100644 --- a/t/op.stat +++ b/t/op.stat @@ -1,9 +1,11 @@ #!./perl -# $Header: op.stat,v 3.0.1.3 90/02/28 18:36:51 lwall Locked $ +# $Header: op.stat,v 3.0.1.4 90/08/13 22:31:36 lwall Locked $ print "1..56\n"; +chop($cwd = `pwd`); + unlink "Op.stat.tmp"; open(foo, ">Op.stat.tmp"); @@ -23,7 +25,12 @@ sleep 2; $blksize,$blocks) = stat('Op.stat.tmp'); if ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";} -if ($mtime && $mtime != $ctime) {print "ok 4\n";} else {print "not ok 4\n";} +if (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) { + print "ok 4\n"; +} +else { + print "not ok 4\n"; +} print "#4 :$mtime: != :$ctime:\n"; `cp /dev/null Op.stat.tmp`; @@ -88,7 +95,6 @@ if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} $cnt = $uid = 0; -chop($cwd = `pwd`); die "Can't run op.stat test 35 without pwd working" unless $cwd; chdir '/usr/bin' || die "Can't cd to /usr/bin"; while (<*>) { diff --git a/toke.c b/toke.c index ec45b31..2b88b1a 100644 --- a/toke.c +++ b/toke.c @@ -1,4 +1,4 @@ -/* $Header: toke.c,v 3.0.1.8 90/08/09 05:39:58 lwall Locked $ +/* $Header: toke.c,v 3.0.1.9 90/08/13 22:37:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.9 90/08/13 22:37:25 lwall + * patch28: defined(@array) and defined(%array) didn't work right + * * Revision 3.0.1.8 90/08/09 05:39:58 lwall * patch19: added require operator * patch19: added -x switch to extract script from input trash @@ -424,7 +427,7 @@ yylex() case '%': if (expectterm) { s = scanreg(s,bufend,tokenbuf); - yylval.stabval = stabent(tokenbuf,TRUE); + yylval.stabval = hadd(stabent(tokenbuf,TRUE)); TERM(HSH); } s++; diff --git a/util.c b/util.c index ca7a6a4..0487d93 100644 --- a/util.c +++ b/util.c @@ -1,4 +1,4 @@ -/* $Header: util.c,v 3.0.1.6 90/08/09 05:44:55 lwall Locked $ +/* $Header: util.c,v 3.0.1.7 90/08/13 22:40:26 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.7 90/08/13 22:40:26 lwall + * patch28: the NSIG hack didn't work right on Xenix + * patch28: rename was busted on systems without rename system call + * * Revision 3.0.1.6 90/08/09 05:44:55 lwall * patch19: fixed double include of * patch19: various MSDOS and OS/2 patches folded in @@ -40,7 +44,7 @@ #include "EXTERN.h" #include "perl.h" -#ifndef NSIG +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif @@ -1428,13 +1432,13 @@ char *b; if (strNE(a,b)) return FALSE; if (fa == a) - strcpy(tmpbuf,".") + strcpy(tmpbuf,"."); else strncpy(tmpbuf, a, fa - a); if (stat(tmpbuf, &tmpstatbuf1) < 0) return FALSE; if (fb == b) - strcpy(tmpbuf,".") + strcpy(tmpbuf,"."); else strncpy(tmpbuf, b, fb - b); if (stat(tmpbuf, &tmpstatbuf2) < 0) diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index 118c28a..99c4bb6 100644 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -18,9 +18,12 @@ case "$mallocsrc" in esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <