perl 2.0 patch #11
The Superuser
lroot at jpl-devvax.JPL.NASA.GOV
Thu Aug 4 17:34:51 AEST 1988
System: perl version 2.0
Patch #: 11
Priority: MEDIUM-RARE
Subject: in Configure, more portability for libc scanning
Subject: in Configure, default on setuid emulation is now "no"
Subject: in Configure, cleared up some difficuties in void support detection
Subject: in Configure, randbits default was sometimes too big
Subject: in Configure, manual pages can now default to manl
Subject: in Configure, you can now specify which C compiler to use
Subject: make install doesn't modify current directory any more
Subject: join of null array could leave destination string non-null
Subject: new open for read/write mode from Bruce Simons
Subject: workaround for Ultrix 1.2 end-of-file bug
Subject: unlink needed to use lstat instead of stat (if available)
Subject: fixed some possible null dereferences in debugging code
Subject: couldn't mix two ways of returning values from subroutines
Subject: "last" didn't properly terminate a "foreach"
Subject: support for incompetent 386 compiler
Subject: support for Sun compiler that can't cast double to unsigned long
Subject: support for busted compilers that can't cast relational to double
Subject: some support for crippled compilers that don't grok str_get macro
Subject: support for botched C compilers that ungrok && outside of conditionals
Subject: guarded an lstat with #ifdef SYMLINK instead of S_IFLNK, which lies
Subject: str_peek improperly reused a buffer
Subject: declared j()
Subject: fixed join('a','b')
Subject: suidperl would only run scripts setuid to something other than root
Subject: removed a spurious call to safemalloc()
Subject: new multiple subscript feature didn't work right
Subject: do $filename; got mixed up in the eval cache
Subject: deleted regchar()
Subject: fixed some pointer arithmetic that didn't work on the 286
Subject: fixed $+ to work as documented
Subject: added sanity check on $- going negative
Subject: added test for multiple subscript arrays
Subject: removed unsupported join syntax
Subject: in op.stat, noted that Xenix 386 thinks /dev/null is a tty
Subject: unterminated literal strings blew up tokener in eval
Subject: in a2p, newlines weren't allowed following comma
Subject: in a2p, numbers couldn't start with '.'
Subject: a2p was being really stupid about comparisons with literal strings
Subject: a2p tried to make a local declaration on a null argument list
Subject: in a2p, fixed possible null pointer dereference
Description:
In Configure, the scan of the libc library now supports several
new forms of nm output--particularly the new System V format.
The default on setuid emulation is now "no", since most systems
probably haven't disabled setuid scripts, or don't have #! scripts
in the first place. The void support detection has been cleaned
up some, and the randbits detection had a bug that could make it
look like your rand() returned more bits than it really does.
Last but not least, you can now specify which C compiler to use.
That's mostly for people who want to use Gnu cc.
Saying "make install" doesn't modify current directory any more.
It used to chmod +x makedir and cat the parts of the perl manual
together. This makes it hard on people who compile under one uid
and install under root like they ought.
Inside of a loop, joining a null array could leave the destination
string non-null if the last time through the loop joined a non-null
array. Got that?
Bruce Simons has donated a new feature: if you say
open(active,"+</usr/lib/news/active"); # note the "+"
you can do both reads and writes on the file. Likewise for "+>"
and "+>>".
Perl now compensates for Ultrix 1.2 systems that wrongly bump the file
pointer every time you do <> at end-of-file.
The unlink operator wouldn't let you unlink a symbolic link to
something that didn't exist because the stat() failed on it.
Now it used lstat() instead. (The lstat() is necessary to prevent
perl from unlinking directories inadvertently.)
The debugging code in cmd.c could print dereference nulls when
entering or exiting loops without labels.
You couldn't use a return statement in a subroutine, and also
return a value at the end of the subroutine without using another
return statement. Now you can. This was particularly embarrassing
because a2p went to some length to optimize away that last return,
since it's a little less efficient.
The "last" operator didn't properly exit from a "foreach", so that
you couldn't restart the loop next time. Now it does. You still
can only bomb out to the end of the foreach loop--bombing out to
an outer loop still has the same problem, which involves longjmp()
bypassing some code that needs to run. One of these months I'll
fix that.
Some incompetent 386 compilers get heartburn over some of the
pointer expressions in arg.c. There's some special code that's
enclosed in #ifdef M_I386 for such compilers.
It seems the Sun compiler can't cast double to unsigned long.
Casting to long works and preserves the sign bit. At the risk
of some lint complaints perl now does bitwise operations by
casting doubles to long and then assigning that to an unsigned
long variable. I hope it works everywhere else.
Some C compilers can't cast the result of a relational operator to
a double. Perl now uses "(expr)? 1.0 : 0.0" to get around that.
Some C compilers can't parse the str_get macro. If you define
CRIPPLED_CC you can have it as a subroutine instead, which will
be somewhat slower.
Some silly C compilers improperly optimize out of existence the left
side of an && if it isn't used inside a conditional. The STABSET
macro made use of this, so I made it use an if instead, to the
detriment of the usefulness of the STABSET macro.
There was a call to lstat() that was inside an #ifdef S_IFLNK.
Unfortunately there are machines that define S_IFLNK that don't
have lstat() or symlink(). I made it depend on SYMLINK instead.
The str_peek() macro reused a buffer that other debugging code
was also trying to use, resulting in bogus trace messages on
assignments.
The useless construct join('a','b') stumbled into some obsolete
code and blew up. It now returns 'b' as expected.
The optional suidperl is intended to emulate setuid processing on
machines where setuid shell scripts are disabled for security
reasons. Unfortunately I had the code a little too tight, and
suidperl would only run scripts setuid to anything other than root.
At my site, the passwd program is a perl script, and it didn't work
too hot not being setuid root...
The new multiple subscript feature didn't work right because I only
tested it by eyeballing the syntax tree, and I missed the fact that
it neglected to transform comma operators into a list, so the implicit
join only joined the last subscript. There's now a test in the
validation suite for it.
When I added s/foo/bar/e I put in a 1-deep cache for the last string
eval'ed. Unfortunated there was some destructive interference with
the "do $filename;" operation, which shares some of the same code.
The regchar() function was no longer used, so it's gone.
regexp.c had some code (put there by me, not Henry Spencer) that
assumed you could do pointer arithmetic between strings in different
structures. No workee on the 286, which has segments.
$+ was busted since we converted to the regexp code. Instead of
giving the last paren matched it was giving the first paren of
the last top-level alternative, because I forgot that it actually
matches parens right to left in the backtracking phase.
There was an undocumented syntax for join left over from the dark
ages. I've removed it.
Xenix 386 thinks /dev/null is a tty. This causes test 39 of op.stat
to fail. I just made it print a little reassurance for 386 users.
If you called eval on a string containing unbalanced quotes, the
tokener didn't properly produce an EOF indication, except to
blow up.
The a2p program couldn't parse newlines or comments after a comma,
nor numbers beginning with a '.'. If you had a subroutine that
took no arguments, a2p produced "local() = @_;".
Thanks: to all you nitpickers out there. Keep those cards and letters coming.
You may make perl a useful program yet.
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:
*** DO NOTHING *** Apply patch 12 before recompiling.
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 2.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.8.43).
Index: patchlevel.h
Prereq: 10
1c1
< #define PATCHLEVEL 10
---
> #define PATCHLEVEL 11
Index: Configure
Prereq: 2.0.1.2
*** Configure.old Wed Aug 3 22:54:53 1988
--- Configure Wed Aug 3 22:54:56 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 2.0.1.2 88/07/11 22:16:34 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 2.0.1.3 88/08/03 21:59:07 root Exp $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 158,166 ****
attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
attrlist="$attrlist nsc32000 sinix xenix venix posix ansi M_XENIX"
! attrlist="$attrlist $mc68k __STDC__"
pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib"
! d_newshome="../../NeWS"
defvoidused=7
: some greps do not return status, grrr.
--- 158,166 ----
attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
attrlist="$attrlist nsc32000 sinix xenix venix posix ansi M_XENIX"
! attrlist="$attrlist $mc68k __STDC__ UTS M_I8086 M_I186 M_I286 M_I386"
pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib"
! d_newshome="/usr/NeWS"
defvoidused=7
: some greps do not return status, grrr.
***************
*** 474,484 ****
fi
echo " "
$echo $n "Extracting names from $libc for later perusal...$c"
! nm $libc 2>/dev/null | sed -n -e 's/^.* T _//p' -e 's/^.* T //p' > libc.list
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
! nm $libc 2>/dev/null | sed -n -e 's/^.* D _//p' -e 's/^.* D //p' > libc.list
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
--- 474,488 ----
fi
echo " "
$echo $n "Extracting names from $libc for later perusal...$c"
! nm $libc 2>/dev/null >libc.tmp
! sed -n -e 's/^.* [AT] _//p' -e 's/^.* [AT] //p' <libc.tmp >libc.list
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
! sed -n -e 's/^.* D _//p' -e 's/^.* D //p' <libc.tmp >libc.list
! $contains '^printf$' libc.list >/dev/null 2>&1 || \
! sed -n -e 's/^_//' \
! -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p' <libc.tmp >libc.list
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
***************
*** 485,491 ****
echo " "
echo "nm didn't seem to work right."
echo "Trying ar instead..."
- rmlist="$rmlist libc.tmp"
if ar t $libc > libc.tmp; then
sed -e 's/\.o$//' < libc.tmp > libc.list
echo "Ok."
--- 489,494 ----
***************
*** 501,507 ****
fi
fi
fi
! rmlist="$rmlist libc.list"
: make some quick guesses about what we are up against
echo " "
--- 504,510 ----
fi
fi
fi
! rmlist="$rmlist libc.tmp libc.list"
: make some quick guesses about what we are up against
echo " "
***************
*** 748,759 ****
: now see if they want to do setuid emulation
case "$d_dosuid" in
! '') if bsd; then
! dflt=y
! else
! dflt=n
! fi
! ;;
*undef*) dflt=n;;
*) dflt=y;;
esac
--- 751,757 ----
: now see if they want to do setuid emulation
case "$d_dosuid" in
! '') dflt=n;;
*undef*) dflt=n;;
*) dflt=y;;
esac
***************
*** 1028,1041 ****
#else
main() {
#endif
! extern void *moo();
! void *(*goo)();
#if TRY & 2
void (*foo[10])();
#endif
#if TRY & 4
! if(*goo == moo) {
exit(0);
}
#endif
--- 1026,1039 ----
#else
main() {
#endif
! extern void moo(); /* function returning void */
! void (*goo)(); /* ptr to func returning void */
#if TRY & 2
void (*foo[10])();
#endif
#if TRY & 4
! if(goo == moo) {
exit(0);
}
#endif
***************
*** 1170,1176 ****
{
register int i;
register unsigned long tmp;
! register unsigned long max;
for (i=1000; i; i--) {
tmp = (unsigned long)rand();
--- 1168,1174 ----
{
register int i;
register unsigned long tmp;
! register unsigned long max = 0L;
for (i=1000; i; i--) {
tmp = (unsigned long)rand();
***************
*** 1268,1274 ****
: determine where manual pages go
case "$mansrc" in
'')
! dflt=`loc . /usr/man/man1 /usr/man/mann /usr/man/local/man1 /usr/man/u_man/man1 /usr/man/man1`
;;
*) dflt="$mansrc"
;;
--- 1266,1272 ----
: determine where manual pages go
case "$mansrc" in
'')
! dflt=`loc . /usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1 /usr/man/u_man/man1 /usr/man/man1`
;;
*) dflt="$mansrc"
;;
***************
*** 1569,1575 ****
references that happen to have the same name. On some such systems the
"Mcc" command may be used to force these to be resolved. On other systems
a "cc -M" command is required. (Note that the -M flag on other systems
! indicates a memory model to use!) What command will force resolution on
EOM
$echo $n "this system? [$dflt] $c"
rp="Command to resolve multiple refs? [$dflt]"
--- 1567,1574 ----
references that happen to have the same name. On some such systems the
"Mcc" command may be used to force these to be resolved. On other systems
a "cc -M" command is required. (Note that the -M flag on other systems
! indicates a memory model to use!) If you have the Gnu C compiler, you
! might wish to use that instead. What command will force resolution on
EOM
$echo $n "this system? [$dflt] $c"
rp="Command to resolve multiple refs? [$dflt]"
***************
*** 1576,1583 ****
. myread
cc="$ans"
else
! echo "Not a USG system--assuming cc can resolve multiple definitions."
! cc=cc
fi
: see if we should include -lnm
--- 1575,1588 ----
. myread
cc="$ans"
else
! case "$cc" in
! '') dflt=cc;;
! *) dflt="$cc";;
! esac
! rp="Use which C compiler? [$dflt]"
! $echo $n "$rp $c"
! . myread
! cc="$ans"
fi
: see if we should include -lnm
Index: Makefile.SH
Prereq: 2.0.1.3
*** Makefile.SH.old Wed Aug 3 22:55:03 1988
--- Makefile.SH Wed Aug 3 22:55:04 1988
***************
*** 25,33 ****
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.3 88/07/12 17:11:56 root Exp $
#
# $Log: Makefile.SH,v $
# Revision 2.0.1.3 88/07/12 17:11:56 root
# patch6: Now it's 23 shift/reduce errors
#
--- 25,37 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.4 88/08/03 22:00:44 root Exp $
#
# $Log: Makefile.SH,v $
+ # Revision 2.0.1.4 88/08/03 22:00:44 root
+ #
+ # patch11: make install doesn't modify current directory any more
+ #
# Revision 2.0.1.3 88/07/12 17:11:56 root
# patch6: Now it's 23 shift/reduce errors
#
***************
*** 97,103 ****
.c.o:
$(CC) -c $(CFLAGS) $(LARGE) $*.c
! all: $(public) $(private) $(util)
touch all
perl: perly.o $(obj) perl.o
--- 101,107 ----
.c.o:
$(CC) -c $(CFLAGS) $(LARGE) $*.c
! all: $(public) $(private) $(util) perl.man
touch all
perl: perly.o $(obj) perl.o
***************
*** 139,145 ****
perl.man: perl.man.1 perl.man.2
cat perl.man.1 perl.man.2 >perl.man
! install: perl perl.man
# won't work with csh
export PATH || exit 1
- mv $(bin)/perl $(bin)/perl.old 2>/dev/null
--- 143,149 ----
perl.man: perl.man.1 perl.man.2
cat perl.man.1 perl.man.2 >perl.man
! install: all
# won't work with csh
export PATH || exit 1
- mv $(bin)/perl $(bin)/perl.old 2>/dev/null
***************
*** 161,168 ****
cat >>Makefile <<'!NO!SUBS!'
- test $(bin) = /usr/bin || rm -f /usr/bin/perl
- test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
! chmod +x makedir
! - ./makedir $(lib)
- \
if test `pwd` != $(lib); then \
cp $(private) lib/*.pl $(lib); \
--- 165,171 ----
cat >>Makefile <<'!NO!SUBS!'
- test $(bin) = /usr/bin || rm -f /usr/bin/perl
- test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
! - sh ./makedir $(lib)
- \
if test `pwd` != $(lib); then \
cp $(private) lib/*.pl $(lib); \
Index: Wishlist
*** Wishlist.old Wed Aug 3 22:55:07 1988
--- Wishlist Wed Aug 3 22:55:08 1988
***************
*** 1,4 ****
date support
case statement
ioctl() support
! random numbers
--- 1,9 ----
date support
case statement
ioctl() support
! general expressions in formats
! round
! better format pictures
! setpgrp
! getppid
! nice
Index: x2p/a2p.y
Prereq: 2.0.1.1
*** x2p/a2p.y.old Wed Aug 3 22:57:54 1988
--- x2p/a2p.y Wed Aug 3 22:57:55 1988
***************
*** 1,7 ****
%{
! /* $Header: a2p.y,v 2.0.1.1 88/07/11 23:20:14 root Exp $
*
* $Log: a2p.y,v $
* Revision 2.0.1.1 88/07/11 23:20:14 root
* patch2: changes to support translation of 1985 awk
*
--- 1,10 ----
%{
! /* $Header: a2p.y,v 2.0.1.2 88/08/03 22:49:27 root Exp $
*
* $Log: a2p.y,v $
+ * Revision 2.0.1.2 88/08/03 22:49:27 root
+ * patch11: in a2p, newlines weren't allowed following comma
+ *
* Revision 2.0.1.1 88/07/11 23:20:14 root
* patch2: changes to support translation of 1985 awk
*
***************
*** 266,275 ****
{ $$ = Nullop; }
;
! clist : expr ',' expr
! { $$ = oper2(OCOMMA,$1,$3); }
! | clist ',' expr
! { $$ = oper2(OCOMMA,$1,$3); }
| '(' clist ')' /* these parens are invisible */
{ $$ = $2; }
;
--- 269,278 ----
{ $$ = Nullop; }
;
! clist : expr ',' maybe expr
! { $$ = oper3(OCOMMA,$1,$3,$4); }
! | clist ',' maybe expr
! { $$ = oper3(OCOMMA,$1,$3,$4); }
| '(' clist ')' /* these parens are invisible */
{ $$ = $2; }
;
Index: x2p/a2py.c
Prereq: 2.0.1.1
*** x2p/a2py.c.old Wed Aug 3 22:58:00 1988
--- x2p/a2py.c Wed Aug 3 22:58:01 1988
***************
*** 1,6 ****
! /* $Header: a2py.c,v 2.0.1.1 88/07/11 23:25:33 root Exp $
*
* $Log: a2py.c,v $
* Revision 2.0.1.1 88/07/11 23:25:33 root
* patch2: changes to support translation of 1985 awk
* patch2: now fixes any perl reserved words it finds
--- 1,9 ----
! /* $Header: a2py.c,v 2.0.1.2 88/08/03 22:50:05 root Exp $
*
* $Log: a2py.c,v $
+ * Revision 2.0.1.2 88/08/03 22:50:05 root
+ * patch11: in a2p, numbers couldn't start with '.'
+ *
* Revision 2.0.1.1 88/07/11 23:25:33 root
* patch2: changes to support translation of 1985 awk
* patch2: now fixes any perl reserved words it finds
***************
*** 370,376 ****
XTERM(tmp);
case '0': case '1': case '2': case '3': case '4':
! case '5': case '6': case '7': case '8': case '9':
s = scannum(s);
XOP(NUMBER);
case '"':
--- 373,379 ----
XTERM(tmp);
case '0': case '1': case '2': case '3': case '4':
! case '5': case '6': case '7': case '8': case '9': case '.':
s = scannum(s);
XOP(NUMBER);
case '"':
Index: arg.c
Prereq: 2.0.1.2
*** arg.c.old Wed Aug 3 22:55:15 1988
--- arg.c Wed Aug 3 22:55:17 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 2.0.1.2 88/07/12 17:13:14 root Exp $
*
* $Log: arg.c,v $
* Revision 2.0.1.2 88/07/12 17:13:14 root
* patch6: removed useless assignment
*
--- 1,13 ----
! /* $Header: arg.c,v 2.0.1.3 88/08/03 22:06:41 root Exp $
*
* $Log: arg.c,v $
+ * Revision 2.0.1.3 88/08/03 22:06:41 root
+ * patch11: support for broken 386 compiler
+ * patch11: join of null array could leave destination string non-null
+ * patch11: new open for read/write mode from Bruce Simons
+ * patch11: workaround for Ultrix 1.2 end-of-file bug
+ * patch11: unlink needed to use lstat instead of stat (if available)
+ *
* Revision 2.0.1.2 88/07/12 17:13:14 root
* patch6: removed useless assignment
*
***************
*** 146,156 ****
--- 153,173 ----
gotcha:
if (retary && curspat == spat) {
int iters, i, len;
+ #ifdef M_I386
+ int tmpint;
+ char *tmpptr;
+ #endif /* M_I386 */
iters = spat->spat_regexp->nparens;
*ptrmaxsarg = iters + sargoff;
+ #ifndef M_I386
sarg = (STR**)saferealloc((char*)(sarg - sargoff),
(iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+ #else
+ tmpint=(iters+2+cushion+sargoff)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff;
+ #endif /* M_I386 */
for (i = 1; i <= iters; i++) {
sarg[i] = str_static(&str_no);
***************
*** 402,411 ****
--- 419,437 ----
iters--;
}
if (retary) {
+ #ifndef M_I386
*ptrmaxsarg = iters + sargoff;
sarg = (STR**)saferealloc((char*)(sarg - sargoff),
(iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+ #else
+ int tmpint;
+ char *tmpptr;
+ *ptrmaxsarg = iters + sargoff;
+ tmpint=(iters+2+cushion+sargoff)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff;
+ #endif /* M_I386 */
for (i = 1; i <= iters; i++)
sarg[i] = afetch(ary,i-1);
*retary = sarg;
***************
*** 428,433 ****
--- 454,461 ----
elem = tmpary+1;
if (items-- > 0)
str_sset(str,*elem++);
+ else
+ str_set(str,"");
for (; items > 0; items--,elem++) {
str_cat(str,delim);
str_scat(str,*elem);
***************
*** 490,495 ****
--- 518,524 ----
char *myname = savestr(name);
int result;
int fd;
+ char mode[3]; /* stdio file mode ("r\0" or "r+\0") */
name = myname;
forkprocess = 1; /* assume true if no fork */
***************
*** 510,515 ****
--- 539,552 ----
stab->stab_name);
stio->fp = Nullfp;
}
+ if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
+ mode[1] = *name++;
+ mode[2] = '\0';
+ --len;
+ }
+ else {
+ mode[1] = '\0';
+ }
stio->type = *name;
if (*name == '|') {
for (name++; isspace(*name); name++) ;
***************
*** 522,530 ****
}
}
else if (*name == '>' && name[1] == '>') {
! stio->type = 'a';
for (name += 2; isspace(*name); name++) ;
! fp = fopen(name,"a");
}
else if (*name == '>' && name[1] == '&') {
for (name += 2; isspace(*name); name++) ;
--- 559,567 ----
}
}
else if (*name == '>' && name[1] == '>') {
! mode[0] = stio->type = 'a';
for (name += 2; isspace(*name); name++) ;
! fp = fopen(name, mode);
}
else if (*name == '>' && name[1] == '&') {
for (name += 2; isspace(*name); name++) ;
***************
*** 548,555 ****
fp = stdout;
stio->type = '-';
}
! else
! fp = fopen(name,"w");
}
else {
if (*name == '<') {
--- 585,594 ----
fp = stdout;
stio->type = '-';
}
! else {
! mode[0] = 'w';
! fp = fopen(name,mode);
! }
}
else {
if (*name == '<') {
***************
*** 558,565 ****
fp = stdin;
stio->type = '-';
}
! else
! fp = fopen(name,"r");
}
else if (name[len-1] == '|') {
name[--len] = '\0';
--- 597,606 ----
fp = stdin;
stio->type = '-';
}
! else {
! mode[0] = 'r';
! fp = fopen(name,mode);
! }
}
else if (name[len-1] == '|') {
name[--len] = '\0';
***************
*** 725,731 ****
while (stio->fp) {
#ifdef STDSTDIO /* (the code works without this) */
! if (stio->fp->_cnt) /* cheat a little, since */
return FALSE; /* this is the most usual case */
#endif
--- 766,772 ----
while (stio->fp) {
#ifdef STDSTDIO /* (the code works without this) */
! if (stio->fp->_cnt > 0) /* cheat a little, since */
return FALSE; /* this is the most usual case */
#endif
***************
*** 757,762 ****
--- 798,806 ----
if (!stio || !stio->fp)
goto phooey;
+ if (feof(stio->fp))
+ (void)fseek (stio->fp, 0L, 2); /* ultrix 1.2 workaround */
+
return ftell(stio->fp);
phooey:
***************
*** 780,785 ****
--- 824,832 ----
if (!stio || !stio->fp)
goto nuts;
+ if (feof(stio->fp))
+ (void)fseek (stio->fp, 0L, 2); /* ultrix 1.2 workaround */
+
return fseek(stio->fp, pos, whence) >= 0;
nuts:
***************
*** 815,822 ****
--- 862,877 ----
max = (int)str_gnum(*tmpary);
if (retary) {
+ #ifndef M_I386
sarg = (STR**)saferealloc((char*)(sarg - sargoff),
(max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+ #else
+ int tmpint;
+ char *tmpptr;
+ tmpint=(max+2+cushion+sargoff)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff;
+ #endif /* M_I386 */
for (i = 1; i <= max; i++)
sarg[i] = tmpary[i];
*retary = sarg;
***************
*** 903,908 ****
--- 958,967 ----
max = 0;
if (retary) {
+ #ifdef M_I386
+ int tmpint;
+ char *tmpptr;
+ #endif /* M_I386 */
if (max) {
apush(ary,str_nmake((double)statbuf.st_dev));
apush(ary,str_nmake((double)statbuf.st_ino));
***************
*** 924,931 ****
--- 983,996 ----
#endif
}
*ptrmaxsarg = max + sargoff;
+ #ifndef M_I386
sarg = (STR**)saferealloc((char*)(sarg - sargoff),
(max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+ #else
+ tmpint=(max+2+cushion+sargoff)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff;
+ #endif /* M_I386 */
for (i = 1; i <= max; i++)
sarg[i] = afetch(ary,i-1);
*retary = sarg;
***************
*** 1330,1336 ****
--- 1395,1405 ----
items--;
}
else { /* don't let root wipe out directories without -U */
+ #ifdef SYMLINK
+ if (lstat(s,&statbuf) < 0 ||
+ #else
if (stat(s,&statbuf) < 0 ||
+ #endif
(statbuf.st_mode & S_IFMT) == S_IFDIR )
items--;
else {
***************
*** 1526,1534 ****
--- 1595,1614 ----
apush(ary,str_make(str_get(hiterval(entry))));
}
if (retary) { /* array wanted */
+ #ifdef M_I386
+ int tmpint;
+ char *tmpptr;
+ #endif /* M_I386 */
+
*ptrmaxsarg = max + sargoff;
+ #ifndef M_I386
sarg = (STR**)saferealloc((char*)(sarg - sargoff),
(max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
+ #else
+ tmpint=(max+2+cushion+sargoff)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff;
+ #endif /* M_I386 */
for (i = 1; i <= max; i++)
sarg[i] = afetch(ary,i-1);
*retary = sarg;
***************
*** 1617,1623 ****
#ifdef STDSTDIO
if (stio->fp->_cnt <= 0) {
i = getc(stio->fp);
! ungetc(i,stio->fp);
}
if (stio->fp->_cnt <= 0) /* null file is anything */
return &str_yes;
--- 1697,1704 ----
#ifdef STDSTDIO
if (stio->fp->_cnt <= 0) {
i = getc(stio->fp);
! if (i != EOF)
! ungetc(i,stio->fp);
}
if (stio->fp->_cnt <= 0) /* null file is anything */
return &str_yes;
Index: array.c
Prereq: 2.0
*** array.c.old Wed Aug 3 22:55:24 1988
--- array.c Wed Aug 3 22:55:24 1988
***************
*** 1,6 ****
! /* $Header: array.c,v 2.0 88/06/05 00:08:17 root Exp $
*
* $Log: array.c,v $
* Revision 2.0 88/06/05 00:08:17 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: array.c,v 2.0.1.1 88/08/03 22:07:51 root Exp $
*
* $Log: array.c,v $
+ * Revision 2.0.1.1 88/08/03 22:07:51 root
+ * patch11: commented out unsupported subroutine
+ *
* Revision 2.0 88/06/05 00:08:17 root
* Baseline version 2.0.
*
***************
*** 184,189 ****
--- 187,193 ----
astore(ar,fill,Nullstr);
}
+ #ifdef NOTUSED
void
ajoin(ar,delim,str)
register ARRAY *ar;
***************
*** 211,213 ****
--- 215,218 ----
}
STABSET(str);
}
+ #endif
Index: cmd.c
Prereq: 2.0.1.1
*** cmd.c.old Wed Aug 3 22:55:28 1988
--- cmd.c Wed Aug 3 22:55:29 1988
***************
*** 1,6 ****
! /* $Header: cmd.c,v 2.0.1.1 88/07/11 22:27:13 root Exp $
*
* $Log: cmd.c,v $
* Revision 2.0.1.1 88/07/11 22:27:13 root
* patch2: $& not set right due to optimization (also added $` and $')
*
--- 1,11 ----
! /* $Header: cmd.c,v 2.0.1.2 88/08/03 22:11:09 root Exp $
*
* $Log: cmd.c,v $
+ * Revision 2.0.1.2 88/08/03 22:11:09 root
+ * patch11: fixed some possible null dereferences in debugging code
+ * patch11: couldn't mix two ways of returning values from subroutines
+ * patch11: "last" didn't properly terminate a "foreach"
+ *
* Revision 2.0.1.1 88/07/11 22:27:13 root
* patch2: $& not set right due to optimization (also added $` and $')
*
***************
*** 105,111 ****
#ifdef DEBUGGING
if (debug & 4) {
deb("(Pushing label #%d %s)\n",
! loop_ptr,cmd->c_label);
}
#endif
}
--- 110,116 ----
#ifdef DEBUGGING
if (debug & 4) {
deb("(Pushing label #%d %s)\n",
! loop_ptr, cmd->c_label ? cmd->c_label : "");
}
#endif
}
***************
*** 139,145 ****
debdelim[dlevel++] = '_';
}
#endif
! cmd_exec(cmd->ucmd.ccmd.cc_true);
}
if (!goto_targ) {
go_to = Nullch;
--- 144,150 ----
debdelim[dlevel++] = '_';
}
#endif
! retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
}
if (!goto_targ) {
go_to = Nullch;
***************
*** 155,161 ****
debdelim[dlevel++] = '_';
}
#endif
! cmd_exec(cmd->ucmd.ccmd.cc_alt);
}
if (goto_targ)
break;
--- 160,166 ----
debdelim[dlevel++] = '_';
}
#endif
! retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
}
if (goto_targ)
break;
***************
*** 169,176 ****
if (cmdflags & CF_ONCE) {
#ifdef DEBUGGING
if (debug & 4) {
deb("(Popping label #%d %s)\n",loop_ptr,
! loop_stack[loop_ptr].loop_label);
}
#endif
loop_ptr--;
--- 174,182 ----
if (cmdflags & CF_ONCE) {
#ifdef DEBUGGING
if (debug & 4) {
+ tmps = loop_stack[loop_ptr].loop_label;
deb("(Popping label #%d %s)\n",loop_ptr,
! tmps ? tmps : "" );
}
#endif
loop_ptr--;
***************
*** 506,512 ****
#ifdef DEBUGGING
if (debug & 4) {
deb("(Pushing label #%d %s)\n",
! loop_ptr,cmd->c_label);
}
#endif
}
--- 512,518 ----
#ifdef DEBUGGING
if (debug & 4) {
deb("(Pushing label #%d %s)\n",
! loop_ptr, cmd->c_label ? cmd->c_label : "");
}
#endif
}
***************
*** 538,544 ****
debdelim[dlevel++] = '_';
}
#endif
! cmd_exec(cmd->ucmd.ccmd.cc_true);
}
/* actually, this spot is rarely reached anymore since the above
* cmd_exec() returns through longjmp(). Hooray for structure.
--- 544,550 ----
debdelim[dlevel++] = '_';
}
#endif
! retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
}
/* actually, this spot is rarely reached anymore since the above
* cmd_exec() returns through longjmp(). Hooray for structure.
***************
*** 554,560 ****
debdelim[dlevel++] = '_';
}
#endif
! cmd_exec(cmd->ucmd.ccmd.cc_alt);
}
finish_while:
curspat = oldspat;
--- 560,566 ----
debdelim[dlevel++] = '_';
}
#endif
! retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
}
finish_while:
curspat = oldspat;
***************
*** 577,589 ****
if (cmdflags & CF_ONCE) {
#ifdef DEBUGGING
if (debug & 4) {
! deb("(Popping label #%d %s)\n",loop_ptr,
! loop_stack[loop_ptr].loop_label);
}
#endif
loop_ptr--;
if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) {
cmd->c_stab->stab_val = cmd->c_short;
}
}
cmd = cmd->c_next;
--- 583,597 ----
if (cmdflags & CF_ONCE) {
#ifdef DEBUGGING
if (debug & 4) {
! tmps = loop_stack[loop_ptr].loop_label;
! deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
}
#endif
loop_ptr--;
if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) {
cmd->c_stab->stab_val = cmd->c_short;
+ ar = cmd->c_expr[1].arg_ptr.arg_stab->stab_array;
+ ar->ary_index = -1;
}
}
cmd = cmd->c_next;
Index: eval.c
Prereq: 2.0.1.4
*** eval.c.old Wed Aug 3 22:55:38 1988
--- eval.c Wed Aug 3 22:55:41 1988
***************
*** 1,6 ****
! /* $Header: eval.c,v 2.0.1.4 88/07/15 01:30:08 root Exp $
*
* $Log: eval.c,v $
* Revision 2.0.1.4 88/07/15 01:30:08 root
* patch9: delete $ENV{$var} didn't delete environment variable
*
--- 1,13 ----
! /* $Header: eval.c,v 2.0.1.5 88/08/03 22:17:04 root Exp $
*
* $Log: eval.c,v $
+ * Revision 2.0.1.5 88/08/03 22:17:04 root
+ * patch11: support for incompetent 386 compiler
+ * patch11: support for Sun compiler that can't cast double to unsigned long.
+ * patch11: support for busted compilers that can't cast relational to double
+ * patch11: removed some fossilized join code
+ * patch11: guarded an lstat with #ifdef SYMLINK instead of S_IFLNK, which lies
+ *
* Revision 2.0.1.4 88/07/15 01:30:08 root
* patch9: delete $ENV{$var} didn't delete environment variable
*
***************
*** 79,87 ****
--- 86,106 ----
maxsarg = maxarg = arg->arg_len;
if (maxsarg > 3 || retary) {
if (sargoff >= 0) { /* array already exists, just append to it */
+ #ifdef M_I386
+ int tmpint;
+ char *tmpptr;
+ #endif /* M_I386 */
+
cushion = 10;
+ #ifndef M_I386
sarg = (STR **)saferealloc((char*)*retary,
(maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff;
+ #else
+ tmpint=(maxsarg+sargoff+2+cushion)*sizeof(STR*);
+ tmpptr=(char*)*retary;
+ sarg = (STR **)saferealloc(tmpptr, tmpint);
+ sarg += sargoff;
+ #endif /* M_I386 */
/* Note that sarg points into the middle of the array */
}
else {
***************
*** 333,342 ****
--- 352,373 ----
sarg[anum] = str_static(sarg[anum]);
anum++;
if (anum > maxarg) {
+ #ifdef M_I386
+ int tmpint;
+ char *tmpptr;
+ #endif /* M_I386 */
+
maxarg = anum + anum;
maxsarg = maxarg + sargoff;
+ #ifndef M_I386
sarg = (STR **)saferealloc((char*)(sarg-sargoff),
(maxsarg+2+cushion) * sizeof(STR*)) + sargoff;
+ #else
+ tmpint=(maxsarg+2+cushion)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR **)saferealloc(tmpptr, tmpint);
+ sarg += sargoff;
+ #endif /* M_I386 */
}
goto keepgoing;
}
***************
*** 456,465 ****
value = str_gnum(sarg[1]) / value;
goto donumset;
case O_MODULO:
! if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L)
fatal("Illegal modulus zero");
value = str_gnum(sarg[1]);
! value = (double)(((unsigned long)value) % tmplong);
goto donumset;
case O_ADD:
value = str_gnum(sarg[1]);
--- 487,496 ----
value = str_gnum(sarg[1]) / value;
goto donumset;
case O_MODULO:
! if ((tmplong = (long) str_gnum(sarg[2])) == 0L)
fatal("Illegal modulus zero");
value = str_gnum(sarg[1]);
! value = (double)(((long)value) % tmplong);
goto donumset;
case O_ADD:
value = str_gnum(sarg[1]);
***************
*** 472,522 ****
case O_LEFT_SHIFT:
value = str_gnum(sarg[1]);
anum = (int)str_gnum(sarg[2]);
! value = (double)(((unsigned long)value) << anum);
goto donumset;
case O_RIGHT_SHIFT:
value = str_gnum(sarg[1]);
anum = (int)str_gnum(sarg[2]);
! value = (double)(((unsigned long)value) >> anum);
goto donumset;
case O_LT:
value = str_gnum(sarg[1]);
! value = (double)(value < str_gnum(sarg[2]));
goto donumset;
case O_GT:
value = str_gnum(sarg[1]);
! value = (double)(value > str_gnum(sarg[2]));
goto donumset;
case O_LE:
value = str_gnum(sarg[1]);
! value = (double)(value <= str_gnum(sarg[2]));
goto donumset;
case O_GE:
value = str_gnum(sarg[1]);
! value = (double)(value >= str_gnum(sarg[2]));
goto donumset;
case O_EQ:
value = str_gnum(sarg[1]);
! value = (double)(value == str_gnum(sarg[2]));
goto donumset;
case O_NE:
value = str_gnum(sarg[1]);
! value = (double)(value != str_gnum(sarg[2]));
goto donumset;
case O_BIT_AND:
value = str_gnum(sarg[1]);
! value = (double)(((unsigned long)value) &
! (unsigned long)str_gnum(sarg[2]));
goto donumset;
case O_XOR:
value = str_gnum(sarg[1]);
! value = (double)(((unsigned long)value) ^
! (unsigned long)str_gnum(sarg[2]));
goto donumset;
case O_BIT_OR:
value = str_gnum(sarg[1]);
! value = (double)(((unsigned long)value) |
! (unsigned long)str_gnum(sarg[2]));
goto donumset;
case O_AND:
if (str_true(sarg[1])) {
--- 503,550 ----
case O_LEFT_SHIFT:
value = str_gnum(sarg[1]);
anum = (int)str_gnum(sarg[2]);
! value = (double)(((long)value) << anum);
goto donumset;
case O_RIGHT_SHIFT:
value = str_gnum(sarg[1]);
anum = (int)str_gnum(sarg[2]);
! value = (double)(((long)value) >> anum);
goto donumset;
case O_LT:
value = str_gnum(sarg[1]);
! value = (value < str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_GT:
value = str_gnum(sarg[1]);
! value = (value > str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_LE:
value = str_gnum(sarg[1]);
! value = (value <= str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_GE:
value = str_gnum(sarg[1]);
! value = (value >= str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_EQ:
value = str_gnum(sarg[1]);
! value = (value == str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_NE:
value = str_gnum(sarg[1]);
! value = (value != str_gnum(sarg[2])) ? 1.0 : 0.0;
goto donumset;
case O_BIT_AND:
value = str_gnum(sarg[1]);
! value = (double)(((long)value) & (long)str_gnum(sarg[2]));
goto donumset;
case O_XOR:
value = str_gnum(sarg[1]);
! value = (double)(((long)value) ^ (long)str_gnum(sarg[2]));
goto donumset;
case O_BIT_OR:
value = str_gnum(sarg[1]);
! value = (double)(((long)value) | (long)str_gnum(sarg[2]));
goto donumset;
case O_AND:
if (str_true(sarg[1])) {
***************
*** 672,679 ****
--- 700,716 ----
maxarg = ary->ary_fill;
maxsarg = maxarg + sargoff;
if (retary) { /* array wanted */
+ #ifndef M_I386
sarg = (STR **)saferealloc((char*)(sarg-sargoff),
(maxsarg+3+cushion)*sizeof(STR*)) + sargoff;
+ #else
+ int tmpint;
+ char *tmpptr;
+ tmpint=(maxsarg+3+cushion)*sizeof(STR*);
+ tmpptr=(char *)(sarg-sargoff);
+ sarg = (STR **)saferealloc(tmpptr, tmpint);
+ sarg += sargoff;
+ #endif /* M_I386 */
for (anum = 0; anum <= maxarg; anum++) {
sarg[anum+1] = str = afetch(ary,anum);
}
***************
*** 790,799 ****
str_set(str, tmps);
break;
case O_JOIN:
! if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
! do_join(arg,str_get(sarg[1]),str);
! else
! ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
break;
case O_SLT:
tmps = str_get(sarg[1]);
--- 827,833 ----
str_set(str, tmps);
break;
case O_JOIN:
! do_join(arg,str_get(sarg[1]),str);
break;
case O_SLT:
tmps = str_get(sarg[1]);
***************
*** 1075,1081 ****
if (!tmps || !*tmps)
sleep((32767<<16)+32767);
else
! sleep((unsigned)atoi(tmps));
value = (double)when;
time(&when);
value = ((double)when) - value;
--- 1109,1115 ----
if (!tmps || !*tmps)
sleep((32767<<16)+32767);
else
! sleep((unsigned int)atoi(tmps));
value = (double)when;
time(&when);
value = ((double)when) - value;
***************
*** 1335,1341 ****
break;
#endif
case O_FTLINK:
! #ifdef S_IFLNK
if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
(statbuf.st_mode & S_IFMT) == S_IFLNK )
str = &str_yes;
--- 1369,1375 ----
break;
#endif
case O_FTLINK:
! #ifdef SYMLINK
if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
(statbuf.st_mode & S_IFMT) == S_IFLNK )
str = &str_yes;
Index: t/op.each
Prereq: 2.0
*** t/op.each.old Wed Aug 3 22:57:25 1988
--- t/op.each Wed Aug 3 22:57:26 1988
***************
*** 1,13 ****
#!./perl
! # $Header: op.each,v 2.0 88/06/05 00:13:38 root Exp $
print "1..3\n";
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
! $h{'jkl'} = 'JKL';
! $h{'xyz'} = 'XYZ';
$h{'a'} = 'A';
$h{'b'} = 'B';
$h{'c'} = 'C';
--- 1,13 ----
#!./perl
! # $Header: op.each,v 2.0.1.1 88/08/03 22:44:29 root Exp $
print "1..3\n";
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
! $h{'jkl','mno'} = "JKL\034MNO";
! $h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
$h{'a'} = 'A';
$h{'b'} = 'B';
$h{'c'} = 'C';
Index: t/op.list
Prereq: 2.0.1.1
*** t/op.list.old Wed Aug 3 22:57:29 1988
--- t/op.list Wed Aug 3 22:57:30 1988
***************
*** 1,6 ****
#!./perl
! # $Header: op.list,v 2.0.1.1 88/07/11 23:08:42 root Exp $
print "1..24\n";
--- 1,6 ----
#!./perl
! # $Header: op.list,v 2.0.1.2 88/08/03 22:45:06 root Exp $
print "1..24\n";
***************
*** 7,13 ****
@foo = (1, 2, 3, 4);
if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
! $_ = join(foo,':');
if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
($a,$b,$c,$d) = (1,2,3,4);
--- 7,13 ----
@foo = (1, 2, 3, 4);
if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
! $_ = join(':', at foo);
if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
($a,$b,$c,$d) = (1,2,3,4);
Index: t/op.push
Prereq: 2.0
*** t/op.push.old Wed Aug 3 22:57:32 1988
--- t/op.push Wed Aug 3 22:57:33 1988
***************
*** 1,11 ****
#!./perl
! # $Header: op.push,v 2.0 88/06/05 00:14:23 root Exp $
print "1..2\n";
@x = (1,2,3);
push(@x, at x);
! if (join(x,':') eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
push(x,4);
! if (join(x,':') eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
--- 1,11 ----
#!./perl
! # $Header: op.push,v 2.0.1.1 88/08/03 22:45:14 root Exp $
print "1..2\n";
@x = (1,2,3);
push(@x, at x);
! if (join(':', at x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
push(x,4);
! if (join(':', at x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
Index: t/op.stat
Prereq: 2.0
*** t/op.stat.old Wed Aug 3 22:57:35 1988
--- t/op.stat Wed Aug 3 22:57:36 1988
***************
*** 1,6 ****
#!./perl
! # $Header: op.stat,v 2.0 88/06/05 00:14:43 root Exp $
print "1..56\n";
--- 1,6 ----
#!./perl
! # $Header: op.stat,v 2.0.1.1 88/08/03 22:46:11 root Exp $
print "1..56\n";
***************
*** 105,111 ****
close(tty);
if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
open(null,"/dev/null");
! if (! -t null) {print "ok 39\n";} else {print "not ok 39\n";}
close(null);
if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
--- 105,111 ----
close(tty);
if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
open(null,"/dev/null");
! if (! -t null) {print "ok 39\n";} else {print "not ok 39 except on Xenix 386\n";}
close(null);
if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
Index: perl.h
Prereq: 2.0.1.1
*** perl.h.old Wed Aug 3 22:55:48 1988
--- perl.h Wed Aug 3 22:55:48 1988
***************
*** 1,6 ****
! /* $Header: perl.h,v 2.0.1.1 88/07/11 22:34:31 root Exp $
*
* $Log: perl.h,v $
* Revision 2.0.1.1 88/07/11 22:34:31 root
* patch2: added $`, $& and $'
*
--- 1,11 ----
! /* $Header: perl.h,v 2.0.1.2 88/08/03 22:19:11 root Exp $
*
* $Log: perl.h,v $
+ * Revision 2.0.1.2 88/08/03 22:19:11 root
+ * patch11: some support for crippled compilers that don't grok str_get macro
+ * patch11: str_peek improperly reused a buffer
+ * patch11: declared j()
+ *
* Revision 2.0.1.1 88/07/11 22:34:31 root
* patch2: added $`, $& and $'
*
***************
*** 81,90 ****
#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 )))
#ifdef DEBUGGING
! #define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),(char*)buf) : "" )))
#endif
#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
EXT STR *Str;
--- 86,100 ----
#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 )))
#ifdef DEBUGGING
! #define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(tokenbuf,"num(%g)",Str->str_nval),(char*)tokenbuf) : "" )))
#endif
+ #ifdef CRIPPLED_CC
+ char *str_get();
+ #else
#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+ #endif
+
#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
EXT STR *Str;
***************
*** 115,120 ****
--- 125,131 ----
ARG *flipflip();
ARG *listish();
ARG *localize();
+ ARG *j();
ARG *l();
ARG *mod_match();
ARG *make_list();
More information about the Comp.sources.bugs
mailing list