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 <signal.h> 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.
mpeters · Aug 13, 1990 · 6eb13c3 · 6eb13c3
1 parent 62b28dd
commit 6eb13c3
Show file tree

Hide file tree

Showing 19 changed files with 203 additions and 68 deletions.
diff --git 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
@@ -25,9 +25,12 @@ esac
 
 echo "Extracting Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 3.0.1.7 90/08/09 02:19:56 lwall Locked $
+# $Header: Makefile.SH,v 3.0.1.8 90/08/13 21:50:49 lwall Locked $
 #
 # $Log:	Makefile.SH,v $
+# Revision 3.0.1.8  90/08/13  21:50:49  lwall
+# patch28: not all yaccs are the same
+# 
 # Revision 3.0.1.7  90/08/09  02:19:56  lwall
 # patch19: Configure now asks where you want to put scripts
 # patch19: Added support for linked-in C subroutines
@@ -285,7 +288,8 @@ perly.h: perl.c
 	touch perly.h
 
 perl.c: perl.y
-	@ echo Expect 29 shift/reduce and 59 reduce/reduce conflicts...
+	@ echo 'Expect either' 29 shift/reduce and 59 reduce/reduce conflicts...
+	@ echo '           or' 27 shift/reduce and 61 reduce/reduce conflicts...
 	$(YACC) -d perl.y
 	mv y.tab.c perl.c
 	mv y.tab.h perly.h

diff --git a/array.c b/array.c
@@ -1,11 +1,14 @@
-/* $Header: array.c,v 3.0.1.1 89/11/17 15:02:52 lwall Locked $
+/* $Header: array.c,v 3.0.1.2 90/08/13 21:52:20 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:	array.c,v $
+ * Revision 3.0.1.2  90/08/13  21:52:20  lwall
+ * patch28: defined(@array) and defined(%array) didn't work right
+ * 
  * Revision 3.0.1.1  89/11/17  15:02:52  lwall
  * patch5: nested foreach on same array didn't work
  * 
@@ -70,10 +73,16 @@ STR *val;
 	    }
 	}
 	else {
-	    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*);
+	    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
@@ -1,11 +1,15 @@
-/* $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
  *
  *    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 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 <signal.h>
  * 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 <signal.h>
 #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
@@ -1,11 +1,15 @@
-/* $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
  *
  *    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 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 <netdb.h>
 #endif
 
+#if defined(SELECT) && (defined(M_UNIX) || defined(M_XENIX))
+#include <sys/select.h>
+#endif
+
 #ifdef I_PWD
 #include <pwd.h>
 #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
@@ -1,11 +1,14 @@
-/* $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
  *
  *    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 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
@@ -1,11 +1,16 @@
-/* $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
  *
  *    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 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 <signal.h>
 #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 ||