perl 3.0 patch #28
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Tue Aug 14 16:01:15 AEST 1990
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 <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.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
Configure -d # not necessary if you did it at pl27
make depend # not necessary if you did it at pl27
make
make test
make install
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 3.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.1.143).
Index: patchlevel.h
Prereq: 27
1c1
< #define PATCHLEVEL 27
---
> #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 <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.7 90/08/09 02:19:56 lwall Locked $
#
# $Log: Makefile.SH,v $
# 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
--- 25,36 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $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,291 ****
touch perly.h
perl.c: perl.y
! @ echo Expect 29 shift/reduce and 59 reduce/reduce conflicts...
$(YACC) -d perl.y
mv y.tab.c perl.c
mv y.tab.h perly.h
--- 288,295 ----
touch perly.h
perl.c: perl.y
! @ 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
Index: x2p/Makefile.SH
Prereq: 3.0.1.4
*** x2p/Makefile.SH.old Mon Aug 13 22:45:25 1990
--- x2p/Makefile.SH Mon Aug 13 22:45:26 1990
***************
*** 18,26 ****
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.4 90/03/01 10:28:09 lwall Locked $
#
# $Log: Makefile.SH,v $
# Revision 3.0.1.4 90/03/01 10:28:09 lwall
# patch9: a2p didn't allow logical expressions everywhere it should
#
--- 18,29 ----
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.5 90/08/13 22:41:05 lwall Locked $
#
# $Log: Makefile.SH,v $
+ # Revision 3.0.1.5 90/08/13 22:41:05 lwall
+ # patch28: shift/reduce count was off for a2p's Makefile
+ #
# Revision 3.0.1.4 90/03/01 10:28:09 lwall
# patch9: a2p didn't allow logical expressions everywhere it should
#
***************
*** 98,104 ****
$(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
a2p.c: a2p.y
! @ echo Expect 232 shift/reduce conflicts...
$(YACC) a2p.y
mv y.tab.c a2p.c
--- 101,107 ----
$(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
a2p.c: a2p.y
! @ echo Expect 226 shift/reduce conflicts...
$(YACC) a2p.y
mv y.tab.c a2p.c
Index: array.c
Prereq: 3.0.1.1
*** array.c.old Mon Aug 13 22:41:33 1990
--- array.c Mon Aug 13 22:41:34 1990
***************
*** 1,4 ****
! /* $Header: array.c,v 3.0.1.1 89/11/17 15:02:52 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: array.c,v 3.0.1.2 90/08/13 21:52:20 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: 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,79 ****
}
}
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*);
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 <signal.h>
* patch19: pack/unpack can now do native float and double
***************
*** 49,55 ****
#include "EXTERN.h"
#include "perl.h"
! #ifndef NSIG
#include <signal.h>
#endif
--- 53,59 ----
#include "EXTERN.h"
#include "perl.h"
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#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 <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,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 <signal.h>
#endif
--- 65,71 ----
#include "EXTERN.h"
#include "perl.h"
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#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 <signal.h>
* patch19: $' broke on embedded nulls
***************
*** 47,53 ****
#include "EXTERN.h"
#include "perl.h"
! #ifndef NSIG
#include <signal.h>
#endif
--- 50,56 ----
#include "EXTERN.h"
#include "perl.h"
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#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 <signal.h>
* patch19: various MSDOS and OS/2 patches folded in
***************
*** 40,46 ****
#include "EXTERN.h"
#include "perl.h"
! #ifndef NSIG
#include <signal.h>
#endif
--- 44,50 ----
#include "EXTERN.h"
#include "perl.h"
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#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)
More information about the Comp.sources.bugs
mailing list