Xref: utzoo comp.sources.bugs:2491 comp.lang.perl:2082 Path: utzoo!utgpu!news-server.csri.toronto.edu!mailrus!wuarchive!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #28 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <9132@jpl-devvax.JPL.NASA.GOV> Date: 14 Aug 90 06:01:15 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1247 System: perl version 3.0 Patch #: 28 Subject: close-on-exec problems on dup'ed file descriptors Subject: not all yaccs are the same Subject: defined(@array) and defined(%array) didn't work right Subject: the NSIG hack didn't work right on Xenix Subject: rename was busted on systems without rename system call Subject: lowercase unquoted strings caused infinite loop Subject: documented that you can't interpolate $) or $| in pattern Subject: /x{m}/ didn't work right Subject: t/io.fs had difficulties under AFS Subject: t/op.stat had difficulties under AFS Subject: shift/reduce count was off for a2p's Makefile Subject: F_FREESP wasn't implemented the way I thought Description: 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. 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 #define PATCHLEVEL 28 Index: Configure Prereq: 3.0.1.8 *** Configure.old Mon Aug 13 21:49:33 1990 --- Configure Mon Aug 13 21:49:39 1990 *************** *** 8,14 **** # 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 $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than --- 8,14 ---- # 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.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,268 **** 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" inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan' : some greps do not return status, grrr. echo "grimblepritz" >grimble --- 262,268 ---- 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 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 Index: Makefile.SH Prereq: 3.0.1.7 *** Makefile.SH.old Mon Aug 13 22:41:19 1990 --- Makefile.SH Mon Aug 13 22:41:22 1990 *************** *** 25,33 **** echo "Extracting Makefile (with variable substitutions)" cat >Makefile <Makefile <Makefile <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*); ar->ary_array = ar->ary_alloc; ar->ary_max = newmax; } --- 73,88 ---- } } else { ! 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,111 **** 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); str_magic(ar->ary_magic, stab, '#', Nullch, 0); ! ar->ary_fill = -1; ! ar->ary_max = 4; ar->ary_flags = ARF_REAL; return ar; } --- 109,118 ---- register ARRAY *ar; New(1,ar,1,ARRAY); ar->ary_magic = Str_new(7,0); + ar->ary_alloc = ar->ary_array = 0; str_magic(ar->ary_magic, stab, '#', Nullch, 0); ! ar->ary_max = ar->ary_fill = -1; ar->ary_flags = ARF_REAL; return ar; } *************** *** 136,142 **** { register int key; ! if (!ar || !(ar->ary_flags & ARF_REAL)) return; if (key = ar->ary_array - ar->ary_alloc) { ar->ary_max += key; --- 143,149 ---- { register int key; ! if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0) return; if (key = ar->ary_array - ar->ary_alloc) { ar->ary_max += key; Index: doarg.c Prereq: 3.0.1.6 *** doarg.c.old Mon Aug 13 22:41:46 1990 --- doarg.c Mon Aug 13 22:41:50 1990 *************** *** 1,4 **** ! /* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doarg.c,v 3.0.1.7 90/08/13 22:14:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,55 **** #include "EXTERN.h" #include "perl.h" ! #ifndef NSIG #include #endif --- 53,59 ---- #include "EXTERN.h" #include "perl.h" ! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif *************** *** 1155,1160 **** --- 1159,1166 ---- 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()"); *************** *** 1161,1176 **** 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) retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0; else retval = FALSE; str_numset(str,(double)retval); --- 1167,1182 ---- arg = arg[1].arg_ptr.arg_arg; type = arg->arg_type; ! 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); Index: doio.c Prereq: 3.0.1.9 *** doio.c.old Mon Aug 13 22:42:08 1990 --- doio.c Mon Aug 13 22:42:12 1990 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.9 90/08/09 02:56:19 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.10 90/08/13 22:14:29 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,72 **** --- 71,80 ---- #include #endif + #if defined(SELECT) && (defined(M_UNIX) || defined(M_XENIX)) + #include + #endif + #ifdef I_PWD #include #endif *************** *** 237,244 **** } #if defined(FCNTL) && defined(F_SETFD) fd = fileno(fp); ! if (fd >= 3) ! fcntl(fd,F_SETFD,1); #endif stio->ifp = fp; if (writing) { --- 245,251 ---- } #if defined(FCNTL) && defined(F_SETFD) fd = fileno(fp); ! fcntl(fd,F_SETFD,fd >= 3); #endif stio->ifp = fp; if (writing) { *************** *** 657,662 **** --- 664,721 ---- 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,676 **** int result = 1; STAB *tmpstab; ! #if defined(TRUNCATE) || defined(CHSIZE) || defined(F_FREESP) #ifdef TRUNCATE if ((arg[1].arg_type & A_MASK) == A_WORD) { tmpstab = arg[1].arg_ptr.arg_stab; --- 729,735 ---- int result = 1; STAB *tmpstab; ! #if defined(TRUNCATE) || defined(CHSIZE) #ifdef TRUNCATE if ((arg[1].arg_type & A_MASK) == A_WORD) { tmpstab = arg[1].arg_ptr.arg_stab; *************** *** 681,689 **** 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) || --- 740,745 ---- Index: dolist.c Prereq: 3.0.1.8 *** dolist.c.old Mon Aug 13 22:42:28 1990 --- dolist.c Mon Aug 13 22:42:34 1990 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0.1.8 90/08/09 03:15:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.9 90/08/13 22:15:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,1114 **** --- 1112,1121 ---- 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 */ Index: eval.c Prereq: 3.0.1.7 *** eval.c.old Mon Aug 13 22:42:52 1990 --- eval.c Mon Aug 13 22:42:59 1990 *************** *** 1,4 **** ! /* $Header: eval.c,v 3.0.1.7 90/08/09 03:33:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: eval.c,v 3.0.1.8 90/08/13 22:17:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * 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,66 **** #include "EXTERN.h" #include "perl.h" ! #ifndef NSIG #include #endif --- 65,71 ---- #include "EXTERN.h" #include "perl.h" ! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif *************** *** 1539,1545 **** #ifdef RENAME value = (double)(rename(tmps,tmps2) >= 0); #else ! if (same_dirent(tmps2, tmps) /* can always rename to same name */ anum = 1; else { if (euid || stat(tmps2,&statbuf) < 0 || --- 1544,1550 ---- #ifdef RENAME value = (double)(rename(tmps,tmps2) >= 0); #else ! if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { if (euid || stat(tmps2,&statbuf) < 0 || Index: hash.c Prereq: 3.0.1.4 *** hash.c.old Mon Aug 13 22:43:10 1990 --- hash.c Mon Aug 13 22:43:12 1990 *************** *** 1,4 **** ! /* $Header: hash.c,v 3.0.1.4 90/08/09 03:50:22 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: hash.c,v 3.0.1.5 90/08/13 22:18:27 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,60 **** --- 58,69 ---- 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,146 **** --- 150,158 ---- } } + 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,216 **** datum dkey; #endif ! if (!tb) return Nullstr; if (!tb->tbl_coeffsize) hash = *key + 128 * key[1] + 128 * key[klen-1]; --- 222,228 ---- datum dkey; #endif ! if (!tb || !tb->tbl_array) return Nullstr; if (!tb->tbl_coeffsize) hash = *key + 128 * key[1] + 128 * key[klen-1]; *************** *** 314,320 **** 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; --- 326,331 ---- *************** *** 352,358 **** register HENT *hent; register HENT *ohent = Null(HENT*); ! if (!tb) return; (void)hiterinit(tb); while (hent = hiternext(tb)) { /* concise but not very efficient */ --- 363,369 ---- register HENT *hent; register HENT *ohent = Null(HENT*); ! if (!tb || !tb->tbl_array) return; (void)hiterinit(tb); while (hent = hiternext(tb)) { /* concise but not very efficient */ *************** *** 438,443 **** --- 449,456 ---- return entry; } #endif + if (!tb->tbl_array) + Newz(506,tb->tbl_array, tb->tbl_max + 1, HENT*); do { if (entry) entry = entry->hent_next; Index: t/io.fs Prereq: 3.0 *** t/io.fs.old Mon Aug 13 22:44:28 1990 --- t/io.fs Mon Aug 13 22:44:29 1990 *************** *** 1,6 **** #!./perl ! # $Header: io.fs,v 3.0 89/10/18 15:26:20 lwall Locked $ print "1..22\n"; --- 1,6 ---- #!./perl ! # $Header: io.fs,v 3.0.1.1 90/08/13 22:31:17 lwall Locked $ print "1..22\n"; *************** *** 61,68 **** ($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 ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, --- 61,70 ---- ($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) || $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, Index: t/op.stat Prereq: 3.0.1.3 *** t/op.stat.old Mon Aug 13 22:44:33 1990 --- t/op.stat Mon Aug 13 22:44:35 1990 *************** *** 1,9 **** #!./perl ! # $Header: op.stat,v 3.0.1.3 90/02/28 18:36:51 lwall Locked $ print "1..56\n"; unlink "Op.stat.tmp"; open(foo, ">Op.stat.tmp"); --- 1,11 ---- #!./perl ! # $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,29 **** $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";} print "#4 :$mtime: != :$ctime:\n"; `cp /dev/null Op.stat.tmp`; --- 25,36 ---- $blksize,$blocks) = stat('Op.stat.tmp'); if ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\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,94 **** $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 (<*>) { --- 95,100 ---- Index: perl.y Prereq: 3.0.1.7 *** perl.y.old Mon Aug 13 22:43:21 1990 --- perl.y Mon Aug 13 22:43:26 1990 *************** *** 1,4 **** ! /* $Header: perl.y,v 3.0.1.7 90/08/09 04:17:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.y,v 3.0.1.8 90/08/13 22:19:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,792 **** */ bareword: WORD ! { char *s = $1; $$ = 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; ! } if (dowarn && !*s) ! warn("\"%s\" may clash with future reserved word", $1); } %% /* PROGRAM */ --- 779,794 ---- */ bareword: WORD ! { char *s; $$ = op_new(1); $$->arg_type = O_ITEM; $$[1].arg_type = A_SINGLE; $$[1].arg_ptr.arg_str = str_make($1,0); ! for (s = $1; *s && islower(*s); s++) ; if (dowarn && !*s) ! warn( ! "\"%s\" may clash with future reserved word", ! $1 ); } %% /* PROGRAM */ Index: perl_man.2 Prereq: 3.0.1.7 *** perl_man.2.old Mon Aug 13 22:43:40 1990 --- perl_man.2 Mon Aug 13 22:43:44 1990 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl_man.2,v 3.0.1.7 90/08/09 04:27:04 lwall Locked $ ''' ''' $Log: perl_man.2,v $ ''' Revision 3.0.1.7 90/08/09 04:27:04 lwall ''' patch19: added require operator ''' --- 1,10 ---- ''' Beginning of part 2 ! ''' $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,1079 **** --- 1077,1083 ---- 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 Index: perly.c Prereq: 3.0.1.6 *** perly.c.old Mon Aug 13 22:43:54 1990 --- perly.c Mon Aug 13 22:43:58 1990 *************** *** 1,4 **** ! char rcsid[] = "$Header: perly.c,v 3.0.1.6 90/08/09 04:55:50 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! 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,11 **** --- 6,14 ---- * 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,576 **** --- 574,581 ---- 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,851 **** if (instr(tokenbuf,".h ")) strcat(tokenbuf," (change .h to .ph maybe?)"); if (instr(tokenbuf,".ph ")) ! strcat(tokenbuf," (did you run makelib?)"); fatal("%s",tokenbuf); } if (gimme != G_ARRAY) --- 850,856 ---- if (instr(tokenbuf,".h ")) strcat(tokenbuf," (change .h to .ph maybe?)"); if (instr(tokenbuf,".ph ")) ! strcat(tokenbuf," (did you run h2ph?)"); fatal("%s",tokenbuf); } if (gimme != G_ARRAY) Index: regcomp.c Prereq: 3.0.1.4 *** regcomp.c.old Mon Aug 13 22:44:08 1990 --- regcomp.c Mon Aug 13 22:44:13 1990 *************** *** 7,15 **** * 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 $ * * $Log: regcomp.c,v $ * 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+$/ --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $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,479 **** --- 477,484 ---- 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"); Index: stab.c Prereq: 3.0.1.7 *** stab.c.old Mon Aug 13 22:44:21 1990 --- stab.c Mon Aug 13 22:44:24 1990 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.7 90/08/09 05:17:48 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.8 90/08/13 22:30:17 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,53 **** #include "EXTERN.h" #include "perl.h" ! #ifndef NSIG #include #endif --- 50,56 ---- #include "EXTERN.h" #include "perl.h" ! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif Index: toke.c Prereq: 3.0.1.8 *** toke.c.old Mon Aug 13 22:44:54 1990 --- toke.c Mon Aug 13 22:45:02 1990 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.8 90/08/09 05:39:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.9 90/08/13 22:37:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,430 **** case '%': if (expectterm) { s = scanreg(s,bufend,tokenbuf); ! yylval.stabval = stabent(tokenbuf,TRUE); TERM(HSH); } s++; --- 427,433 ---- case '%': if (expectterm) { s = scanreg(s,bufend,tokenbuf); ! yylval.stabval = hadd(stabent(tokenbuf,TRUE)); TERM(HSH); } s++; Index: util.c Prereq: 3.0.1.6 *** util.c.old Mon Aug 13 22:45:15 1990 --- util.c Mon Aug 13 22:45:19 1990 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0.1.6 90/08/09 05:44:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.7 90/08/13 22:40:26 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,46 **** #include "EXTERN.h" #include "perl.h" ! #ifndef NSIG #include #endif --- 44,50 ---- #include "EXTERN.h" #include "perl.h" ! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif *************** *** 1428,1440 **** if (strNE(a,b)) return FALSE; if (fa == a) ! strcpy(tmpbuf,".") else strncpy(tmpbuf, a, fa - a); if (stat(tmpbuf, &tmpstatbuf1) < 0) return FALSE; if (fb == b) ! strcpy(tmpbuf,".") else strncpy(tmpbuf, b, fb - b); if (stat(tmpbuf, &tmpstatbuf2) < 0) --- 1432,1444 ---- if (strNE(a,b)) return FALSE; if (fa == a) ! strcpy(tmpbuf,"."); else strncpy(tmpbuf, a, fa - a); if (stat(tmpbuf, &tmpstatbuf1) < 0) return FALSE; if (fb == b) ! strcpy(tmpbuf,"."); else strncpy(tmpbuf, b, fb - b); if (stat(tmpbuf, &tmpstatbuf2) < 0)