perl 1.0 patch #27
The Superuser
lroot at devvax.JPL.NASA.GOV
Fri Mar 4 14:08:25 AEST 1988
System: perl version 1.0
Patch #: 27
Priority: MEDIUM
Subject: hacked around the printf bug that can't print fields >128 chars.
Subject: some close() calls weren't checking return status.
Subject: $* = 1; "ab\ncd\n" =~ /^cd/ failed from overzealous optimization
Subject: the crypt() routine needed ifdeffing in perly.c as well as arg.c
Subject: io.fs uses ./tmp rather than /tmp now
Description:
My manual page says printf can't print a field longer than 128 chars.
Since perl was using printf to format %s, it would fail on the same
input. Since long strings are usually printed with a plain old %s,
I hacked a bypass printf in the simple situation.
The automatic closes that happen when you open another file on the same
channel were not paying close enough attention to the return status.
They now print out a warning if all did not go well.
Setting $* = 1 is supposed to let patterns like /^foo/ match after
any newline in the searched string. This was not working part of the
time, due to an optimization botch.
The crypt() function does not exist on all implementations of Unix,
due to excessive US government paranoia that people will find out
what they already know. Anyway, the crypt function is ifdeffed in
arg.c, but should also have been ifdeffed in perly.c in the evalstatic()
routine.
The io.fs test used /tmp for a scratch directory, which sometime led
to conflicts with other users of the directory. The io.fs test now
create its own local tmp directory to work with.
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 [currently 9]).
After patching:
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 1.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU in Internet notation, 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.8.43). You can also get kits at
some recent patchlevel from this location.
Index: patchlevel.h
Prereq: 26
1c1
< #define PATCHLEVEL 26
---
> #define PATCHLEVEL 27
Index: Configure
Prereq: 1.0.1.9
*** Configure.old Thu Mar 3 19:38:56 1988
--- Configure Thu Mar 3 19:39:01 1988
***************
*** 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 1.0.1.9 88/03/03 16:02:26 root Exp $
#
# 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 1.0.1.10 88/03/03 19:32:23 root Exp $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 126,132 ****
attrlist="mc68000 sun gcos unix ibm gimpel interdata tss os mert pyr"
attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
! pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib" : find out where common programs are
defvoidused=7
: some greps do not return status, grrr.
--- 126,133 ----
attrlist="mc68000 sun gcos unix ibm gimpel interdata tss os mert pyr"
attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
! pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib"
! : find out where common programs are
defvoidused=7
: some greps do not return status, grrr.
Index: arg.c
Prereq: 1.0.1.14
*** arg.c.old Thu Mar 3 19:54:43 1988
--- arg.c Thu Mar 3 19:54:51 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 1.0.1.14 88/03/03 16:02:57 root Exp $
*
* $Log: arg.c,v $
* Revision 1.0.1.14 88/03/03 16:02:57 root
* patch26: use GIDTYPE for getgroups() call
*
--- 1,11 ----
! /* $Header: arg.c,v 1.0.1.15 88/03/03 19:52:14 root Exp $
*
* $Log: arg.c,v $
+ * Revision 1.0.1.15 88/03/03 19:52:14 root
+ * patch27: hacked around printf bug that chokes on fields >128 chars
+ * patch27: some close() calls weren't checking return status
+ * patch27: $* = 1; "ab\ncd\n" =~ /^cd/ failed from overzealous optimization
+ *
* Revision 1.0.1.14 88/03/03 16:02:57 root
* patch26: use GIDTYPE for getgroups() call
*
***************
*** 121,127 ****
#endif
if (!*spat->spat_compex.precomp && lastspat)
spat = lastspat;
! if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
spat->spat_first = Nullstr; /* disable optimization */
--- 126,132 ----
#endif
if (!*spat->spat_compex.precomp && lastspat)
spat = lastspat;
! if (!multiline && spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
spat->spat_first = Nullstr; /* disable optimization */
***************
*** 175,181 ****
#endif
if (!*spat->spat_compex.precomp && lastspat)
spat = lastspat;
! if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
spat->spat_first = Nullstr; /* disable optimization */
--- 180,186 ----
#endif
if (!*spat->spat_compex.precomp && lastspat)
spat = lastspat;
! if (!multiline && spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
spat->spat_first = Nullstr; /* disable optimization */
***************
*** 353,358 ****
--- 358,364 ----
int len = strlen(name);
register STIO *stio = stab->stab_io;
char *myname = savestr(name);
+ int result;
name = myname;
while (len && isspace(name[len-1]))
***************
*** 361,369 ****
stio = stab->stab_io = stio_new();
if (stio->fp) {
if (stio->type == '|')
! pclose(stio->fp);
else if (stio->type != '-')
! fclose(stio->fp);
stio->fp = Nullfp;
}
stio->type = *name;
--- 367,380 ----
stio = stab->stab_io = stio_new();
if (stio->fp) {
if (stio->type == '|')
! result = pclose(stio->fp);
else if (stio->type != '-')
! result = fclose(stio->fp);
! else
! result = 0;
! if (result == EOF)
! fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
! stab->stab_name);
stio->fp = Nullfp;
}
stio->type = *name;
***************
*** 764,770 ****
case 's':
ch = *(++t);
*t = '\0';
! sprintf(buf,s,str_get(*(sarg++)));
s = t;
*(t--) = ch;
break;
--- 775,786 ----
case 's':
ch = *(++t);
*t = '\0';
! if (strEQ(s,"%s")) { /* some printfs fail on >128 chars */
! *buf = '\0';
! str_scat(str,*(sarg++)); /* so handle simple case */
! }
! else
! sprintf(buf,s,str_get(*(sarg++)));
s = t;
*(t--) = ch;
break;
Index: t/io.fs
Prereq: 1.0.1.1
*** t/io.fs.old Thu Mar 3 19:40:05 1988
--- t/io.fs Thu Mar 3 19:40:06 1988
***************
*** 1,6 ****
#!./perl
! # $Header: io.fs,v 1.0.1.1 88/03/02 12:57:26 root Exp $
print "1..20\n";
--- 1,6 ----
#!./perl
! # $Header: io.fs,v 1.0.1.2 88/03/03 19:37:33 root Exp $
print "1..20\n";
***************
*** 7,13 ****
$wd = `pwd`;
chop($wd);
! chdir '/tmp';
`/bin/rm -rf a b c x`;
umask(022);
--- 7,14 ----
$wd = `pwd`;
chop($wd);
! `mkdir tmp`;
! chdir './tmp';
`/bin/rm -rf a b c x`;
umask(022);
Index: t/op.pat
Prereq: 1.0.1.1
*** t/op.pat.old Thu Mar 3 19:40:12 1988
--- t/op.pat Thu Mar 3 19:40:13 1988
***************
*** 1,7 ****
#!./perl
! # $Header: op.pat,v 1.0.1.1 88/02/06 00:26:35 root Exp $
! print "1..23\n";
$x = "abc\ndef\n";
--- 1,7 ----
#!./perl
! # $Header: op.pat,v 1.0.1.2 88/03/03 19:38:00 root Exp $
! print "1..24\n";
$x = "abc\ndef\n";
***************
*** 56,58 ****
--- 56,61 ----
if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+
+ $* = 1; # test 3 only tested the optimized version--this one is for real
+ if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
Index: perly.c
Prereq: 1.0.1.8
*** perly.c.old Thu Mar 3 19:39:47 1988
--- perly.c Thu Mar 3 19:39:54 1988
***************
*** 1,6 ****
! char rcsid[] = "$Header: perly.c,v 1.0.1.8 88/03/02 12:45:28 root Exp $";
/*
* $Log: perly.c,v $
* Revision 1.0.1.8 88/03/02 12:45:28 root
* patch24: added new filetest and symlink operations
* patch24: made assume_* unique in 7 chars
--- 1,9 ----
! char rcsid[] = "$Header: perly.c,v 1.0.1.9 88/03/03 19:36:31 root Exp $";
/*
* $Log: perly.c,v $
+ * Revision 1.0.1.9 88/03/03 19:36:31 root
+ * patch27: the crypt() routine needed ifdeffing in this file as well as arg.c
+ *
* Revision 1.0.1.8 88/03/02 12:45:28 root
* patch24: added new filetest and symlink operations
* patch24: made assume_* unique in 7 chars
***************
*** 2169,2176 ****
--- 2172,2184 ----
str_numset(str,(double)(strNE(tmps,str_get(s2))));
break;
case O_CRYPT:
+ #ifdef CRYPT
tmps = str_get(s1);
str_set(str,crypt(tmps,str_get(s2)));
+ #else
+ fatal(
+ "The crypt() function is unimplemented due to excessive paranoia.");
+ #endif
break;
case O_EXP:
str_numset(str,exp(str_gnum(s1)));
More information about the Comp.sources.bugs
mailing list