From: Larry Wall Date: Fri, 17 Nov 1989 03:02:33 +0000 (+0000) Subject: perl 3.0 patch #5 (combined patch) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0d3e774cdb279a1eadd8282d49334b9b1bfd42ed;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #5 (combined patch) Some machines have bcopy() but not bzero(), so Configure tests for them separately now. Likewise for symlink() and lstat(). Some systems have dirent.h but not readdir(). The symbols BZERO, LSTAT and READDIR are now used to differentiate. Some machines have including . Some do the opposite. Some don't even have . Configure now looks for both kinds of include, and the saga continues... Configure tested twice for the presence of -lnm because x2p/Makefile.SH had a reference to the obsolete $libnm variable. It now tests only once. Some machines have goodies stashed in /usr/include/sun, /usr/include/bsd, -lsun and -lbsd. Configure now checks those locations. Configure could sometimes add an option to a default of none, producing [none -DDEBUGGING] prompts. This is fixed. Many of the units in metaconfig used the construct if xxx=`loc...`; then On most machines the exit status of loc ends up in $?, but on a few machines, the assignment apparently sets $? to 0, since it always succeeds. Oh well... The tests for byte order had difficulties with illegal octal digits and constants that were too long, as well as not defining the union in try.c correctly. When was missing, it was assumed that the field d_namlen existed. There is now an explicit check of for the field. The tests of to see how signal() is declared needed to have signal.h run through the C preprocessor first because of POSIX ifdefs. The type returned by getgroups() was defaulting wrong on Suns and such. Configure now checks against the lint library if it exists to produce a better default. The construct foreach $elem (@array) { foreach $elem (@array) { ... } } didn't work right because the iterator for the array was stored with the array rather than with the node in the syntax tree. If you said defined $foo{'bar'} it would create the element $foo{'bar'} while returning the correct value. It now no longer creates the value. The grep() function was occasionally losing arguments or dumping core. This was because it called eval() on each argument but didn't account for the fact that eval() is capable of reallocating the stack. If you said $something ? $foo[1] : $foo[2] you ended up (usually) with $something ? $foo[0] : $foo[0] because of the way the ?: operator tries to fool the stack into thinking there's only one argument there instead of three. This only happened to constant subscripts. Interestingly enough, $abc[1] ? $foo[1] : $bar[1] would have worked, since the first argument has the same subscript. Some machines already define TRUE and FALSE, so we have to undef them to avoid warnings. Several people sent in some fixes for manual typos and indent problems. There was a reqeust to clarify the difference between $! and $@, and I added a gratuitous warning about print making an array context for its arguments, since people seem to run into that frequently. suidperl could correctly emulate a setgid script, but then it could get confused about what the actual effective gid was. Some machine or other defines sighandler(), so perl's sighandler() needed to be made static. We changed uchar to unchar for Crays, and it turns out that lots of SysV machines typedef unchar instead. Sigh. It's now un_char. If you did substitutions to chop leading components off a string, and then set the string from , under certain circumstances the input string could be corrupted because str_gets() called str_grow() without making sure to change the strings current length to be the number of characters just read, rather than the old length. op.stat occasionally failed with NFS race condition, so it now waits two seconds instead of one to guarantee that the NFS server advances its clock at least one second. IBM PC/RT compiler can't deal with UNI() and LOP() macros. If you define CRIPPLED_CC it now will recast those macros as subroutines, which runs a little slower but doesn't give the compiler heartburn. The } character can terminate either an associative array subscript or a BLOCK. These set up different expectations as to whether the next token might be a term or an operator. There was a faulty heuristic based on whether there was an intervening newline. It turns out that if } simply leaves the current expectations along, the right thing happens. The command y/abcde// didn't work because the length of the first part was not correctly copied to the second part. In s2p, line labels without a subsequent statement were done wrong, since an extra semicolon needs to be supplied. It wasn't always suppplied, and when it was supplied, it was in the wrong place. S2p also needed to remove its /tmp files better. A2p translates for (a in b) to foreach $a} (keys(%b)) on Pyramids, because index(s, '}' + 128) doesn't find a } with the top bit set. This has been fixed. --- diff --git a/Configure b/Configure index f5a7fc6..5f53877 100755 --- 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.2 89/11/11 04:05:37 lwall Locked $ +# $Header: Configure,v 3.0.1.3 89/11/17 15:01:21 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than @@ -101,6 +101,7 @@ cppstdin='' cppminus='' d_bcmp='' d_bcopy='' +d_bzero='' d_charsprf='' d_crypt='' cryptlib='' @@ -119,6 +120,7 @@ d_htonl='' d_index='' d_ioctl='' d_killpg='' +d_lstat='' d_memcmp='' d_memcpy='' d_mkdir='' @@ -149,6 +151,7 @@ d_syscall='' d_tminsys='' i_systime='' i_timetoo='' +i_systimetoo='' d_varargs='' d_vfork='' d_voidsig='' @@ -173,7 +176,6 @@ i_varargs='' i_vfork='' intsize='' libc='' -libnm='' mallocsrc='' mallocobj='' usemymalloc='' @@ -247,8 +249,8 @@ attrlist="$attrlist i186" 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 nm ndir ndbm dbm c_s" - +libswanted="net nm ndir ndbm dbm sun bsd c_s" +inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd' : some greps do not return status, grrr. echo "grimblepritz" >grimble if grep blurfldyick grimble >/dev/null 2>&1 ; then @@ -1013,17 +1015,19 @@ esac case "$ccflags" in '') case "$cc" in *gcc*) dflt='-fpcc-struct-return';; - *) dflt='none';; + *) dflt='';; esac ;; *) dflt="$ccflags";; esac -if test -d /usr/netinclude; then - case "$dflt" in - *netinclude*);; - *) dflt="$dflt -I/usr/netinclude";; - esac -fi +for thisincl in $inclwanted; do + if test -d $thisincl; then + case "$dflt" in + *$thisincl*);; + *) dflt="$dflt -I$thisincl";; + esac + fi +done case "$optimize" in -g*) case "$dflt" in @@ -1032,6 +1036,9 @@ case "$optimize" in esac ;; esac +case "$dflt" in +'') dflt=none;; +esac cat < 4) + u.l = 0x0807060504030201; + else + u.l = 0x04030201; for (i=0; i < sizeof(long); i++) printf("%c",u.c[i]+'0'); printf("\n"); @@ -1330,7 +1353,7 @@ case "$libs" in fi libnames="$libnames $try" ;; - *) libnames="$libnames $thisname" ;; + *) libnames="$libnames $thislib" ;; esac done ;; @@ -1440,6 +1463,10 @@ eval $inlibc set bcopy d_bcopy eval $inlibc +: see if bzero exists +set bzero d_bzero +eval $inlibc + : see if sprintf is declared as int or pointer to char echo " " cat >.ucbsprf.c <<'EOF' @@ -1537,7 +1564,11 @@ if $test -r /usr/include/dirent.h ; then fi else i_dirent="$undef" - d_dirnamlen="$define" + if $contains 'd_namlen' /usr/include/sys/dir.h >/dev/null 2>&1; then + d_dirnamlen="$define" + else + d_dirnamlen="$undef" + fi echo "No dirent.h found." fi @@ -1657,6 +1688,10 @@ fi set killpg d_killpg eval $inlibc +: see if lstat exists +set lstat d_lstat +eval $inlibc + : see if memcmp exists set memcmp d_memcmp eval $inlibc @@ -1671,7 +1706,8 @@ eval $inlibc : see if ndbm is available echo " " -if xxx=`loc ndbm.h x /usr/include /usr/local/include /usr/netinclude`; then +xxx=`loc ndbm.h x /usr/include /usr/local/include $inclwanted` +if test -f $xxx; then d_ndbm="$define" echo "ndbm.h found." else @@ -1681,7 +1717,8 @@ fi : see if we have the old dbm echo " " -if xxx=`loc dbm.h x /usr/include /usr/local/include /usr/netinclude`; then +xxx=`loc dbm.h x /usr/include /usr/local/include $inclwanted` +if test -f $xxx; then d_odbm="$define" echo "dbm.h found." else @@ -1914,6 +1951,11 @@ if $contains '^#.*include.*' /usr/include/sys/time.h >/dev/null 2>&1 ; else i_timetoo="$define" fi +if $contains '^#.*include.*' /usr/include/time.h >/dev/null 2>&1 ; then + i_systimetoo="$undef" +else + i_systimetoo="$define" +fi : see if this is a varargs system echo " " @@ -1931,13 +1973,15 @@ eval $inlibc : see if signal is declared as pointer to function returning int or void echo " " -if $contains 'void.*signal' /usr/include/signal.h >/dev/null 2>&1 ; then +$cppstdin $cppflags < /usr/include/signal.h >$$.tmp +if $contains 'void.*signal' $$.tmp >/dev/null 2>&1 ; then echo "You have void (*signal())() instead of int." d_voidsig="$define" else echo "You have int (*signal())() instead of void." d_voidsig="$undef" fi +rm -f $$.tmp : see if there is a wait4 set wait4 d_wait4 @@ -2014,10 +2058,15 @@ voidflags="$ans" $rm -f try.* .out : see what type gids are declared as in the kernel +echo " " case "$gidtype" in '') - if $contains 'gid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then - dflt='gid_t'; + if $contains 'getgroups.*short' /usr/lib/lint/llib-lc >/dev/null 2>&1; then + dflt='short' + elif $contains 'getgroups.*int' /usr/lib/lint/llib-lc >/dev/null 2>&1; then + dflt='int' + elif $contains 'gid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then + dflt='gid_t' else set `grep 'groups\[NGROUPS\];' /usr/include/sys/user.h 2>/dev/null` unsigned short case $1 in @@ -2030,7 +2079,6 @@ case "$gidtype" in ;; esac cont=true -echo " " echo "(The following only matters if you have getgroups().)" rp="What type are the group ids returned by getgroups()? [$dflt]" $echo $n "$rp $c" @@ -2059,7 +2107,8 @@ fi : see if this is a netinet/in.h system echo " " -if xxx=`loc netinet/in.h x /usr/include /usr/local/include /usr/netinclude`; then +xxx=`loc netinet/in.h x /usr/include /usr/local/include $inclwanted` +if test -f $xxx; then i_niin="$define" echo "netinet/in.h found." else @@ -2273,25 +2322,6 @@ Log='$Log' Header='$Header' -: see if we should include -lnm -echo " " -if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then - echo "New math library found." - libnm='-lnm' -else - ans=`loc libnm.a x $libpth` - case "$ans" in - x) - echo "No nm library found--the normal math library will have to do." - libnm='' - ;; - *) - echo "New math library found in $ans." - libnm="$ans" - ;; - esac -fi - : determine which malloc to compile in echo " " case "$usemymalloc" in @@ -2395,6 +2425,7 @@ cppstdin='$cppstdin' cppminus='$cppminus' d_bcmp='$d_bcmp' d_bcopy='$d_bcopy' +d_bzero='$d_bzero' d_charsprf='$d_charsprf' d_crypt='$d_crypt' cryptlib='$cryptlib' @@ -2413,6 +2444,7 @@ d_htonl='$d_htonl' d_index='$d_index' d_ioctl='$d_ioctl' d_killpg='$d_killpg' +d_lstat='$d_lstat' d_memcmp='$d_memcmp' d_memcpy='$d_memcpy' d_mkdir='$d_mkdir' @@ -2443,6 +2475,7 @@ d_syscall='$d_syscall' d_tminsys='$d_tminsys' i_systime='$i_systime' i_timetoo='$i_timetoo' +i_systimetoo='$i_systimetoo' d_varargs='$d_varargs' d_vfork='$d_vfork' d_voidsig='$d_voidsig' @@ -2467,7 +2500,6 @@ i_varargs='$i_varargs' i_vfork='$i_vfork' intsize='$intsize' libc='$libc' -libnm='$libnm' mallocsrc='$mallocsrc' mallocobj='$mallocobj' usemymalloc='$usemymalloc' diff --git a/array.c b/array.c index 6875d28..e801f06 100644 --- a/array.c +++ b/array.c @@ -1,4 +1,4 @@ -/* $Header: array.c,v 3.0 89/10/18 15:08:33 lwall Locked $ +/* $Header: array.c,v 3.0.1.1 89/11/17 15:02:52 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: array.c,v $ + * Revision 3.0.1.1 89/11/17 15:02:52 lwall + * patch5: nested foreach on same array didn't work + * * Revision 3.0 89/10/18 15:08:33 lwall * 3.0 baseline * @@ -102,7 +105,6 @@ STAB *stab; ar->ary_magic = Str_new(7,0); str_magic(ar->ary_magic, stab, '#', Nullch, 0); ar->ary_fill = -1; - ar->ary_index = -1; ar->ary_max = 4; ar->ary_flags = ARF_REAL; return ar; @@ -123,7 +125,6 @@ STR **strp; ar->ary_magic = Str_new(8,0); str_magic(ar->ary_magic, stab, '#', Nullch, 0); ar->ary_fill = size - 1; - ar->ary_index = -1; ar->ary_max = size - 1; ar->ary_flags = 0; return ar; diff --git a/array.h b/array.h index d489f64..1388591 100644 --- a/array.h +++ b/array.h @@ -1,4 +1,4 @@ -/* $Header: array.h,v 3.0 89/10/18 15:08:41 lwall Locked $ +/* $Header: array.h,v 3.0.1.1 89/11/17 15:03:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: array.h,v $ + * Revision 3.0.1.1 89/11/17 15:03:42 lwall + * patch5: nested foreach on same array didn't work + * * Revision 3.0 89/10/18 15:08:41 lwall * 3.0 baseline * @@ -17,7 +20,6 @@ struct atbl { STR *ary_magic; int ary_max; int ary_fill; - int ary_index; char ary_flags; }; diff --git a/cmd.c b/cmd.c index 7fc7427..c623d54 100644 --- a/cmd.c +++ b/cmd.c @@ -1,4 +1,4 @@ -/* $Header: cmd.c,v 3.0.1.2 89/11/11 04:08:56 lwall Locked $ +/* $Header: cmd.c,v 3.0.1.3 89/11/17 15:04:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.c,v $ + * Revision 3.0.1.3 89/11/17 15:04:36 lwall + * patch5: nested foreach on same array didn't work + * * Revision 3.0.1.2 89/11/11 04:08:56 lwall * patch2: non-BSD machines required two ^D's for <> * patch2: grow_dlevel() not inside #ifdef DEBUGGING @@ -528,24 +531,26 @@ until_loop: retstr = &str_chop; goto flipmaybe; case CFT_ARRAY: - ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab); - match = ar->ary_index; /* just to get register */ + match = cmd->c_short->str_u.str_useful; /* just to get register */ if (match < 0) { /* first time through here? */ + ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab); aryoptsave = savestack->ary_fill; savesptr(&stab_val(cmd->c_stab)); - saveint(&ar->ary_index); + savelong(&cmd->c_short->str_u.str_useful); } + else + ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab); if (match >= ar->ary_fill) { /* we're in LAST, probably */ retstr = &str_undef; - ar->ary_index = -1; /* this is actually redundant */ + cmd->c_short->str_u.str_useful = -1; /* actually redundant */ match = FALSE; } else { match++; retstr = stab_val(cmd->c_stab) = ar->ary_array[match]; - ar->ary_index = match; + cmd->c_short->str_u.str_useful = match; match = TRUE; } newsp = -2; diff --git a/config.h.SH b/config.h.SH index c3c8630..ad19da7 100644 --- a/config.h.SH +++ b/config.h.SH @@ -48,7 +48,7 @@ sed <config.h -e 's!^#undef!/\*#undef!' * This symbol contains an encoding of the order of bytes in a long. * Usual values (in octal) are 01234, 04321, 02143, 03412... */ -#define BYTEORDER 0$byteorder /**/ +#define BYTEORDER 0x$byteorder /**/ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke @@ -77,6 +77,12 @@ sed <config.h -e 's!^#undef!/\*#undef!' */ #$d_bcopy BCOPY /**/ +/* BZERO: + * This symbol, if defined, indicates that the bzero routine is available + * to zero blocks of memory. Otherwise you should probably use memcpy(). + */ +#$d_bzero BZERO /**/ + /* CHARSPRINTF: * This symbol is defined if this system declares "char *sprintf()" in * stdio.h. The trend seems to be to declare it as "int sprintf()". It @@ -212,6 +218,12 @@ sed <config.h -e 's!^#undef!/\*#undef!' */ #$d_killpg KILLPG /**/ +/* LSTAT: + * This symbol, if defined, indicates that the lstat() routine is + * available to do file locking. + */ +#$d_lstat LSTAT /**/ + /* MEMCMP: * This symbol, if defined, indicates that the memcmp routine is available * to compare blocks of memory. If undefined, roll your own. @@ -386,9 +398,14 @@ sed <config.h -e 's!^#undef!/\*#undef!' * This symbol is defined if exists but doesn't include * . */ +/* I_SYSTIMETOO: + * This symbol is defined if exists but isn't included + * by . + */ #$d_tminsys TMINSYS /**/ #$i_systime I_SYSTIME /**/ #$i_timetoo I_TIMETOO /**/ +#$i_systimetoo I_SYSTIMETOO /**/ /* VARARGS: * This symbol, if defined, indicates to the C program that it should diff --git a/cons.c b/cons.c index e85bc81..6d4084a 100644 --- a/cons.c +++ b/cons.c @@ -1,4 +1,4 @@ -/* $Header: cons.c,v 3.0.1.1 89/10/26 23:09:01 lwall Locked $ +/* $Header: cons.c,v 3.0.1.2 89/11/17 15:08:53 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cons.c,v $ + * Revision 3.0.1.2 89/11/17 15:08:53 lwall + * patch5: nested foreach on same array didn't work + * * Revision 3.0.1.1 89/10/26 23:09:01 lwall * patch1: numeric switch optimization was broken * patch1: unless was broken when run under the debugger @@ -1029,6 +1032,8 @@ register CMD *cmd; cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */ cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */ cmd->c_stab = eachstab; + cmd->c_short = str_new(0); /* just to save a field in struct cmd */ + cmd->c_short->str_u.str_useful = -1; return cmd; } diff --git a/consarg.c b/consarg.c index b24322e..6feeb9b 100644 --- a/consarg.c +++ b/consarg.c @@ -1,4 +1,4 @@ -/* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $ +/* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: consarg.c,v $ + * Revision 3.0.1.2 89/11/17 15:11:34 lwall + * patch5: defined $foo{'bar'} should not create element + * * Revision 3.0.1.1 89/11/11 04:14:30 lwall * patch2: '-' x 26 made warnings about undefined value * patch2: eval with no args caused strangeness @@ -634,7 +637,10 @@ register ARG *arg; } } else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM) - arg1->arg_type = O_LAELEM; + if (arg->arg_type == O_DEFINED) + arg1->arg_type = O_AELEM; + else + arg1->arg_type = O_LAELEM; else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) { arg1->arg_type = O_LARRAY; if (arg->arg_len > 1) { @@ -662,7 +668,10 @@ register ARG *arg; arg[1].arg_flags |= AF_ARYOK; } else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM) - arg1->arg_type = O_LHELEM; + if (arg->arg_type == O_DEFINED) + arg1->arg_type = O_HELEM; /* avoid creating one */ + else + arg1->arg_type = O_LHELEM; else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) { arg1->arg_type = O_LHASH; if (arg->arg_len > 1) { diff --git a/doio.c b/doio.c index a2960ad..3884035 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $Header: doio.c,v 3.0.1.2 89/11/11 04:25:51 lwall Locked $ +/* $Header: doio.c,v 3.0.1.3 89/11/17 15:13:06 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.3 89/11/17 15:13:06 lwall + * patch5: some systems have symlink() but not lstat() + * patch5: some systems have dirent.h but not readdir() + * * Revision 3.0.1.2 89/11/11 04:25:51 lwall * patch2: orthogonalized the file modes some so we can have <& +<& etc. * patch2: do_open() now detects sockets passed to process from parent @@ -510,7 +514,7 @@ int *arglast; else { str_sset(statname,ary->ary_array[sp]); statstab = Nullstab; -#ifdef SYMLINK +#ifdef LSTAT if (arg->arg_type == O_LSTAT) i = lstat(str_get(statname),&statcache); else @@ -1717,7 +1721,7 @@ STAB *stab; int gimme; int *arglast; { -#ifdef DIRENT +#if defined(DIRENT) && defined(READDIR) register ARRAY *ary = stack; register STR **st = ary->ary_array; register int sp = arglast[1]; @@ -1892,7 +1896,7 @@ int *arglast; tot--; } else { /* don't let root wipe out directories without -U */ -#ifdef SYMLINK +#ifdef LSTAT if (lstat(s,&statbuf) < 0 || #else if (stat(s,&statbuf) < 0 || diff --git a/dolist.c b/dolist.c index 05e61a3..7808151 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.3 89/11/17 15:14:45 lwall + * patch5: grep() occasionally loses arguments or dumps core + * * Revision 3.0.1.2 89/11/11 04:28:17 lwall * patch2: non-existent slice values are now undefined rather than null * @@ -719,8 +722,8 @@ int gimme; int *arglast; { STR **st = stack->ary_array; - register STR **dst = &st[arglast[1]]; - register STR **src = dst + 1; + register int dst = arglast[1]; + register int src = dst + 1; register int sp = arglast[2]; register int i = sp - arglast[1]; int oldsave = savestack->ary_fill; @@ -730,10 +733,11 @@ int *arglast; dehoist(arg,1); arg = arg[1].arg_ptr.arg_arg; while (i-- > 0) { - stab_val(defstab) = *src; + stab_val(defstab) = st[src]; (void)eval(arg,G_SCALAR,sp); + st = stack->ary_array; if (str_true(st[sp+1])) - *dst++ = *src; + st[dst++] = st[src]; src++; } restorelist(oldsave); @@ -743,7 +747,7 @@ int *arglast; st[arglast[0]+1] = str; return arglast[0]+1; } - return arglast[0] + (dst - &st[arglast[1]]); + return arglast[0] + (dst - arglast[1]); } int diff --git a/eval.c b/eval.c index 5fa73be..25a6c79 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 lwall Locked $ +/* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.2 89/11/17 15:19:34 lwall + * patch5: simplified a too-complex expression for some machine or other + * * Revision 3.0.1.1 89/11/11 04:31:51 lwall * patch2: mkdir and rmdir needed to quote argument when passed to shell * patch2: mkdir and rmdir now return better error codes @@ -557,8 +560,8 @@ register int sp; str = afetch(ary,maxarg - 1,FALSE); break; case O_AELEM: - str = afetch(stab_array(arg[1].arg_ptr.arg_stab), - ((int)str_gnum(st[2])) - arybase,FALSE); + anum = ((int)str_gnum(st[2])) - arybase; + str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); if (!str) goto say_undef; break; @@ -1739,7 +1742,7 @@ register int sp; goto say_no; #endif case O_FTLINK: -#ifdef SYMLINK +#ifdef LSTAT if (lstat(str_get(st[1]),&statcache) < 0) goto say_undef; if ((statcache.st_mode & S_IFMT) == S_IFLNK ) diff --git a/evalargs.xc b/evalargs.xc index 54b7b7b..b2fd325 100644 --- a/evalargs.xc +++ b/evalargs.xc @@ -2,9 +2,12 @@ * kit sizes from getting too big. */ -/* $Header: evalargs.xc,v 3.0.1.2 89/11/11 04:33:05 lwall Locked $ +/* $Header: evalargs.xc,v 3.0.1.3 89/11/17 15:25:07 lwall Locked $ * * $Log: evalargs.xc,v $ + * Revision 3.0.1.3 89/11/17 15:25:07 lwall + * patch5: constant numeric subscripts disappeared in ?: + * * Revision 3.0.1.2 89/11/11 04:33:05 lwall * patch2: Configure now locates csh * @@ -55,25 +58,35 @@ break; case A_LARYSTAB: ++sp; + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } str = afetch(stab_array(argptr.arg_stab), - arg[anum].arg_len - arybase, TRUE); + arg[argtype].arg_len - arybase, TRUE); #ifdef DEBUGGING if (debug & 8) { (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[anum].arg_len); + arg[argtype].arg_len); tmps = buf; } #endif goto do_crement; case A_ARYSTAB: + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } st[++sp] = afetch(stab_array(argptr.arg_stab), - arg[anum].arg_len - arybase, FALSE); + arg[argtype].arg_len - arybase, FALSE); if (!st[sp]) st[sp] = &str_undef; #ifdef DEBUGGING if (debug & 8) { (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[anum].arg_len); + arg[argtype].arg_len); tmps = buf; } #endif diff --git a/handy.h b/handy.h index 37cfef4..a19f684 100644 --- a/handy.h +++ b/handy.h @@ -1,4 +1,4 @@ -/* $Header: handy.h,v 3.0 89/10/18 15:18:24 lwall Locked $ +/* $Header: handy.h,v 3.0.1.1 89/11/17 15:25:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: handy.h,v $ + * Revision 3.0.1.1 89/11/17 15:25:55 lwall + * patch5: some machines already define TRUE and FALSE + * * Revision 3.0 89/10/18 15:18:24 lwall * 3.0 baseline * @@ -28,6 +31,13 @@ #else #define bool char #endif + +#ifdef TRUE +#undef TRUE +#endif +#ifdef FALSE +#undef FALSE +#endif #define TRUE (1) #define FALSE (0) diff --git a/patchlevel.h b/patchlevel.h index 82d4f62..51d80f3 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 4 +#define PATCHLEVEL 5 diff --git a/t/op.stat b/t/op.stat index 92f907c..064f1b8 100644 --- a/t/op.stat +++ b/t/op.stat @@ -1,6 +1,6 @@ #!./perl -# $Header: op.stat,v 3.0.1.1 89/11/11 05:02:46 lwall Locked $ +# $Header: op.stat,v 3.0.1.2 89/11/17 15:39:27 lwall Locked $ print "1..56\n"; @@ -15,8 +15,7 @@ if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";} print foo "Now is the time for all good men to come to.\n"; close(foo); -$base = time; -while (time == $base) {} +sleep 2; `rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index cbbde9a..84ab66b 100644 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -18,9 +18,12 @@ case "$mallocsrc" in esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <>Makefile <<'!NO!SUBS!'